diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index 3d8d436d3..246b00080 100755 --- a/.dev/compare_branches.R +++ b/.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,7 +80,7 @@ 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" ), @@ -83,24 +88,28 @@ param_list <- list( "--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) diff --git a/NEWS.md b/NEWS.md index 7dbff86de..aa7492377 100644 --- a/NEWS.md +++ b/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 diff --git a/R/yoda_test_linter.R b/R/yoda_test_linter.R index 5beb5ec9c..1c0b7da1c 100644 --- a/R/yoda_test_linter.R +++ b/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,12 +21,19 @@ 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) @@ -34,10 +41,18 @@ yoda_test_linter <- function() { 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" )) }) diff --git a/tests/testthat/test-yoda_test_linter.R b/tests/testthat/test-yoda_test_linter.R index 4ec1bedcf..abfbc3e6a 100644 --- a/tests/testthat/test-yoda_test_linter.R +++ b/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