Merge branch 'master' into feature/brace_linter

.dev/compare_branches.R

@@ -13,9 +13,14 @@
 #     ./dev/compare_branches --pkg_dir=/path/to/cran --sample_size=50 ...
 #   The script outputs a CSV with the lint results for the script options to --outfile.
 #   To compare the results of a PR to that at current HEAD, you could e.g. run
-#     ./dev/compare_branches --branch=my-feature-branch --outfile=new.csv ...
-#     ./dev/compare_branches --branch=master --outfile=old.csv ...
-#   And then compare the results found in new.csv & old.csv.
+#     ./dev/compare_branches --branch=my-feature-branch ...
+#   And then compare the results found in the new CSV file in .dev
+
+# TODO
+#  - make sure this works for comparing tags to facilitate release testing
+#  - handle the case when working directory is not the lintr directory
+#  - support an interface for ad hoc download of packages to support running
+#    the script without needing a CRAN mirror more easily/friendly
 
 # TODO
 #  - make sure this works for comparing tags to facilitate release testing
@@ -75,32 +80,36 @@ param_list <- list(
   optparse::make_option(
     "--branch",
     default = if (interactive()) {
-      readline("Name a branch to compare to the base branch (or skip to enter a PR#): ")
+      readline("Name a branch to compare to the base branch (or skip to enter a PR# or to run only on base_branch): ")
     },
     help = "Run the comparison for base vs. this branch"
   ),
   optparse::make_option(
     "--pr",
     default = if (interactive()) {
       # NB: optparse handles integer conversion
-      readline("Name a PR # to compare to the base branch (skip if you've entered a branch): ")
+      readline("Name a PR # to compare to the base branch (skip if you've entered a branch or to run only on base_branch): ")
     },
     type = "integer",
     help = "Run the comparison for base vs. this PR"
   ),
   optparse::make_option(
-    "--packages",
-    default = if (interactive()) {
-      readline("Provide a comma-separated list of packages (skip to provide a directory): ")
+    "--pkg_dir",
+    default = if (nzchar(cran_mirror <- Sys.getenv("CRAN_MIRROR"))) {
+      dir <- file.path(cran_mirror, "src", "contrib")
+      message("Using the CRAN miror found at Sys.getenv('CRAN_MIRROR'): ", dir)
+      dir
+    } else if (interactive()) {
+      readline("Provide a directory where to select packages (skip to select the current directory): ")
     },
-    help = "Run the comparison using these packages (comma-separated)"
+    help = "Run the comparison using all packages in this directory"
   ),
   optparse::make_option(
-    "--pkg_dir",
+    "--packages",
     default = if (interactive()) {
-      readline("Provide a directory where to select packages (skip if already provided as a list): ")
+      readline("Provide a comma-separated list of packages (skip to include all directories for sampling): ")
     },
-    help = "Run the comparison using all packages in this directory"
+    help = "Run the comparison using these packages (comma-separated)"
   ),
   optparse::make_option(
     "--sample_size",
@@ -141,22 +150,29 @@ if (is.null(base_branch) || is.na(base_branch) || !nzchar(base_branch)) {
 
 # prioritize "branch"
 is_branch <- FALSE
+has_target <- TRUE
 if (!is.null(params$branch)) {
   branch <- params$branch
   is_branch <- TRUE
 } else if (!is.null(params$pr)) {
   pr <- params$pr
 } else {
-  stop("Please supply a branch (--branch) or a PR number (--pr)")
+  has_target <- FALSE
 }
 
-# prioritize packages
+if (is.null(params$pkg_dir)) {
+  # TODO: I think we need to enable running the script outside
+  #   the lintr directory in order for this to work. the intention is
+  #   to be able to run compare_branches --packages=p1,p2 --linters=l1,l2
+  #   and it looks in the executing directory for p1,p2.
+  stop("pkg_dir is required")
+  params$pkg_dir <- "."
+}
+packages <- list.files(normalizePath(params$pkg_dir), full.names = TRUE)
 if (!is.null(params$packages)) {
-  packages <- strsplit(params$packages, ",", fixed = TRUE)[[1L]]
-} else if (!is.null(params$pkg_dir)) {
-  packages <- list.files(normalizePath(params$pkg_dir), full.names = TRUE)
-} else {
-  stop("Please supply a comma-separated list of packages (--packages) or a directory of packages (--pkg_dir)")
+  # strip version numbers
+  package_names <- gsub("_.*", "", basename(packages))
+  packages <- packages[package_names %in% strsplit(params$packages, ",", fixed = TRUE)[[1L]]]
 }
 # filter to (1) package directories or (2) package tar.gz files
 packages <- packages[
@@ -337,13 +353,17 @@ run_workflow <- function(what, packages, linter_names, branch, number) {
   }
 }
 
-message("Comparing the output of the following linters: ", toString(linter_names))
-if (is_branch) {
-  message("Comparing branch ", branch, " to ", base_branch)
-  target <- branch
+if (has_target) {
+  message("Comparing the output of the following linters: ", toString(linter_names))
+  if (is_branch) {
+    message("Comparing branch ", branch, " to ", base_branch)
+    target <- branch
+  } else {
+    message("Comparing PR#", pr, " to ", base_branch)
+    target <- pr
+  }
 } else {
-  message("Comparing PR#", pr, " to ", base_branch)
-  target <- pr
+  message("Running the following linters: ", toString(linter_names))
 }
 if (length(packages) > 50L) {
   message(
@@ -369,10 +389,12 @@ if (dir.exists(file.path(params$outdir, ".partial"))) {
 #  (2) (central) packages (only unzip the package once per branch)
 #  (3) (innermost) linters (once the package is installed, easy to cycle through linters)
 run_workflow("branch", packages, linter_names, branch = base_branch)
-if (is_branch) {
-  run_workflow("branch", packages, linter_names, branch = target)
-} else {
-  run_workflow("pr", packages, linter_names, number = target)
+if (has_target) {
+  if (is_branch) {
+    run_workflow("branch", packages, linter_names, branch = target)
+  } else {
+    run_workflow("pr", packages, linter_names, number = target)
+  }
 }
 
 setwd(old_wd)
@@ -385,11 +407,15 @@ load_partial_results <- function(target, is_branch) {
   purrr::map_df(files, readr::read_csv, show_col_types = FALSE, .id = "package")
 }
 
-lints <- dplyr::bind_rows(
-  base = load_partial_results(base_branch, TRUE),
-  branch = load_partial_results(target, is_branch),
-  .id = "source"
-)
+if (has_target) {
+  lints <- dplyr::bind_rows(
+    base = load_partial_results(base_branch, TRUE),
+    branch = load_partial_results(target, is_branch),
+    .id = "source"
+  )
+} else {
+  lints <- load_partial_results(base_branch, TRUE)
+}
 unlink(file.path(params$outdir, ".partial"), recursive = TRUE)
 data.table::fwrite(lints, params$outfile, row.names = FALSE)
 

NEWS.md

@@ -114,6 +114,9 @@ function calls. (#850, #851, @renkun-ken)
    + `expect_named_linter()` Require usage of `expect_named(x, n)` over `expect_equal(names(x), n)` and similar
    * `expect_length_linter()` Require usage of `expect_length(x, n)` over `expect_equal(length(x), n)` and similar
    * `yoda_test_linter()` Require usage of `expect_identical(x, 1L)` over `expect_equal(1L, x)` and similar
+     + Extended for #979 to improve the lint message displayed for placeholder tests like `expect_equal(1, 1)`
+     + Extended for #1066 to exclude tests at the ends of pipelines like `foo() %>% expect_equal(2)`
+     + Extended for #1067 to exclude `$` extractions like `expect_equal(x$"key", 2)`
    * `expect_identical_linter()` Require usage of `expect_identical()` by default, and `expect_equal()` only by exception
    * `expect_comparison_linter()` Require usage of `expect_gt(x, y)` over `expect_true(x > y)` and similar
    * `if_else_match_braces_linter()` Require balanced usage of `{}` in `if`/`else` conditions

R/yoda_test_linter.R

@@ -12,7 +12,7 @@
 #' @export
 yoda_test_linter <- function() {
   Linter(function(source_file) {
-    if (length(source_file$parsed_content) == 0L) {
+    if (length(source_file$xml_parsed_content) == 0L) {
       return(list())
     }
 
@@ -21,23 +21,38 @@ yoda_test_linter <- function() {
     # catch the following types of literal in the first argument:
     #   (1) numeric literal (e.g. TRUE, 1L, 1.0, NA) [NUM_CONST]
     #   (2) string literal (e.g. 'str' or "str")     [STR_CONST]
+    #       (but _not_ x$"key", #1067)
     #   (3) arithmetic literal (e.g. 1+1 or 0+1i)    [OP-PLUS or OP-MINUS...]
     # TODO(#963): fully generalize this & re-use elsewhere
-    xpath <- "//expr[
+    const_condition <- "
+      NUM_CONST
+      or (STR_CONST and not(OP-DOLLAR))
+      or ((OP-PLUS or OP-MINUS) and count(expr[NUM_CONST]) = 2)
+    "
+    xpath <- glue::glue("//expr[
       expr[SYMBOL_FUNCTION_CALL[text() = 'expect_equal' or text() = 'expect_identical' or text() = 'expect_setequal']]
-      and expr[2][NUM_CONST or STR_CONST or ((OP-PLUS or OP-MINUS) and count(expr[NUM_CONST]) = 2)]
-    ]"
+      and expr[2][ {const_condition} ]
+      and not(preceding-sibling::*[self::PIPE or self::SPECIAL[text() = '%>%']])
+    ]")
 
     bad_expr <- xml2::xml_find_all(xml, xpath)
 
     return(lapply(
       bad_expr,
       xml_nodes_to_lint,
       source_file = source_file,
-      lint_message = paste(
-        "Tests should compare objects in the order 'actual', 'expected', not the reverse.",
-        "For example, do expect_identical(foo(x), 2L) instead of expect_identical(2L, foo(x))."
-      ),
+      lint_message = function(expr) {
+        matched_call <- xml2::xml_text(xml2::xml_find_first(expr, "expr/SYMBOL_FUNCTION_CALL"))
+        second_const <- xml2::xml_find_first(expr, glue::glue("expr[position() = 3 and ({const_condition})]"))
+        if (is.na(second_const)) {
+          paste(
+            "Tests should compare objects in the order 'actual', 'expected', not the reverse.",
+            sprintf("For example, do %1$s(foo(x), 2L) instead of %1$s(2L, foo(x)).", matched_call)
+          )
+        } else {
+          sprintf("Avoid storing placeholder tests like %s(1, 1)", matched_call)
+        }
+      },
       type = "warning"
     ))
   })

tests/testthat/test-yoda_test_linter.R

@@ -31,6 +31,26 @@ test_that("yoda_test_linter blocks simple disallowed usages", {
   )
 })
 
+test_that("yoda_test_linter ignores strings in $ expressions", {
+  # the "key" here shows up at the same level of the parse tree as plain "key" normally would
+  expect_lint('expect_equal(x$"key", 2)', NULL, yoda_test_linter())
+})
+
+# if we only inspect the first argument & ignore context, get false positives
+test_that("yoda_test_linter ignores usage in pipelines", {
+  expect_lint("foo() %>% expect_identical(2)", NULL, yoda_test_linter())
+  skip_if_not_installed("base", "4.1.0")
+  expect_lint("bar() |> expect_equal('a')", NULL, yoda_test_linter())
+})
+
+test_that("yoda_test_linter throws a special message for placeholder tests", {
+  expect_lint(
+    "expect_equal(1, 1)",
+    rex::rex("Avoid storing placeholder tests like expect_equal(1, 1)"),
+    yoda_test_linter()
+  )
+})
+
 # TODO(michaelchirico): Should this be extended to RUnit tests? It seems yes,
 #   but the argument names in RUnit (inherited from base all.equal()) are a bit
 #   confusing, e.g. `checkEqual(target=, current=)`. From the name, one might