From e84ab51952d6d1572bee981d318c401ba0a1a65f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 6 Dec 2023 15:55:14 +0800 Subject: [PATCH] Clean-up: be consistent in action-reason structure to lint messages (#2385) * Batch of message consistency checks * Update R/class_equals_linter.R Co-authored-by: Indrajeet Patil * Update R/is_numeric_linter.R Co-authored-by: Indrajeet Patil * finish first pass * progress fixing tests * a near-complete pass * done tests? * fix expect_lint exxample * delint * NEWS * correct spelling mistakes * Update R/class_equals_linter.R Co-authored-by: AshesITR * Update NEWS.md Co-authored-by: AshesITR * simplify replacement/duplicate ifelse() * grammar * calls with () * condense * fixes * condense, set patrick dependency * consistency in file name * checks= is required here * fix lint message * condense * review changes * revert * commas feedback * implicit integers feedback * one more revert * drop "the equivalent" * restore after fix already in main --------- Co-authored-by: Indrajeet Patil Co-authored-by: AshesITR --- DESCRIPTION | 2 +- NEWS.md | 3 +- R/assignment_linter.R | 2 +- R/backport_linter.R | 5 +- R/brace_linter.R | 2 +- R/class_equals_linter.R | 2 +- R/commas_linter.R | 4 +- R/comment_linters.R | 4 +- R/condition_call_linter.R | 41 ++++------- R/conjunct_test_linter.R | 6 +- R/cyclocomp_linter.R | 4 +- R/duplicate_argument_linter.R | 2 +- R/expect_lint.R | 10 +-- R/fixed_regex_linter.R | 20 +++--- R/if_not_else_linter.R | 5 +- R/implicit_integer_linter.R | 2 +- R/is_numeric_linter.R | 4 +- R/namespace_linter.R | 2 +- R/nzchar_linter.R | 4 +- R/one_call_pipe_linter.R | 2 +- R/paren_body_linter.R | 2 +- R/pipe_consistency_linter.R | 3 +- R/pipe_continuation_linter.R | 2 +- R/pipe_return_linter.R | 5 +- R/return_linter.R | 2 +- R/semicolon_linter.R | 4 +- R/seq_linter.R | 8 +-- R/stopifnot_all_linter.R | 4 +- R/strings_as_factors_linter.R | 8 +-- R/terminal_close_linter.R | 5 +- R/trailing_blank_lines_linter.R | 4 +- R/trailing_whitespace_linter.R | 2 +- R/undesirable_function_linter.R | 2 +- R/undesirable_operator_linter.R | 2 +- R/unnecessary_concatenation_linter.R | 13 ++-- R/unreachable_code_linter.R | 8 +-- R/unused_import_linter.R | 2 +- R/yoda_test_linter.R | 2 +- man/expect_lint.Rd | 10 +-- man/return_linter.Rd | 2 +- tests/testthat/test-assignment_linter.R | 19 +++--- tests/testthat/test-brace_linter.R | 2 +- tests/testthat/test-class_equals_linter.R | 8 +-- tests/testthat/test-commas_linter.R | 8 +-- tests/testthat/test-commented_code_linter.R | 6 +- tests/testthat/test-condition_call_linter.R | 4 +- tests/testthat/test-conjunct_test_linter.R | 22 +++--- tests/testthat/test-cyclocomp_linter.R | 4 +- .../testthat/test-duplicate_argument_linter.R | 6 +- tests/testthat/test-fixed_regex_linter.R | 12 ++-- tests/testthat/test-if_not_else_linter.R | 6 +- tests/testthat/test-implicit_integer_linter.R | 6 +- tests/testthat/test-is_numeric_linter.R | 24 ++++--- tests/testthat/test-knitr_formats.R | 4 +- tests/testthat/test-namespace_linter.R | 10 +-- tests/testthat/test-nzchar_linter.R | 14 ++-- tests/testthat/test-one_call_pipe_linter.R | 14 ++-- tests/testthat/test-paren_body_linter.R | 23 ++++--- ...inter.R => test-pipe_consistency_linter.R} | 10 +-- .../testthat/test-pipe_continuation_linter.R | 10 +-- tests/testthat/test-pipe_return_linter.R | 2 +- tests/testthat/test-semicolon_linter.R | 4 +- tests/testthat/test-seq_linter.R | 68 +++++++++---------- .../testthat/test-strings_as_factors_linter.R | 8 +-- tests/testthat/test-todo_comment_linter.R | 2 +- .../test-trailing_blank_lines_linter.R | 38 ++++------- .../test-trailing_whitespace_linter.R | 18 +++-- .../test-undesirable_function_linter.R | 4 +- .../test-undesirable_operator_linter.R | 16 ++--- .../test-unnecessary_concatenation_linter.R | 57 +++++++--------- tests/testthat/test-unreachable_code_linter.R | 30 ++++---- tests/testthat/test-unused_import_linter.R | 4 +- tests/testthat/test-yoda_test_linter.R | 41 +++++------ 73 files changed, 333 insertions(+), 387 deletions(-) rename tests/testthat/{test-pipe-consistency-linter.R => test-pipe_consistency_linter.R} (88%) diff --git a/DESCRIPTION b/DESCRIPTION index 792453586..7c0021678 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,7 +39,7 @@ Suggests: cli, httr (>= 1.2.1), jsonlite, - patrick, + patrick (>= 0.2.0), rlang, rmarkdown, rstudioapi (>= 0.2), diff --git a/NEWS.md b/NEWS.md index 87aa39592..1424a10bb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,11 +11,12 @@ + Linters `closed_curly_linter()`, `open_curly_linter()`, `paren_brace_linter()`, and `semicolon_terminator_linter()`. + Helper `with_defaults()`. * `all_linters()` has signature `all_linters(..., packages)` rather than `all_linters(packages, ...)` (#2332, @MichaelChirico). This forces `packages=` to be supplied by name and will break users who rely on supplying `packages=` positionally, of which we found none searching GitHub. +* Adjusted various lint messages for consistency in readability (#1330, @MichaelChirico). In general, we favor lint messages to be phrased like "Action, reason" to but the "what" piece of the message front-and-center. This may be a breaking change for code that tests the specific phrasing of lints. ## Bug fixes * `object_name_linter()` no longer errors when user-supplied `regexes=` have capture groups (#2188, @MichaelChirico). -* `.lintr` config validation correctly accepts regular exressions which only compile under `perl = TRUE` (#2375, @MichaelChirico). These have always been valid (since `rex::re_matches()`, which powers the lint exclusion logic, also uses this setting), but the new up-front validation in v3.1.1 incorrectly used `perl = FALSE`. +* `.lintr` config validation correctly accepts regular expressions which only compile under `perl = TRUE` (#2375, @MichaelChirico). These have always been valid (since `rex::re_matches()`, which powers the lint exclusion logic, also uses this setting), but the new up-front validation in v3.1.1 incorrectly used `perl = FALSE`. ## Changes to default linters diff --git a/R/assignment_linter.R b/R/assignment_linter.R index 6bbe83d41..ce2698119 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -111,7 +111,7 @@ assignment_linter <- function(allow_cascading_assign = TRUE, operator <- xml_text(bad_expr) lint_message_fmt <- rep("Use <-, not %s, for assignment.", length(operator)) lint_message_fmt[operator %in% c("<<-", "->>")] <- - "%s can have hard-to-predict behavior; prefer assigning to a specific environment instead (with assign() or <-)." + "Replace %s by assigning to a specific environment (with assign() or <-) to avoid hard-to-predict behavior." lint_message_fmt[operator == "%<>%"] <- "Avoid the assignment pipe %s; prefer using <- and %%>%% separately." diff --git a/R/backport_linter.R b/R/backport_linter.R index 22230bd1b..7a37d80ff 100644 --- a/R/backport_linter.R +++ b/R/backport_linter.R @@ -58,10 +58,7 @@ backport_linter <- function(r_version = getRversion(), except = character()) { needs_backport <- !is.na(bad_versions) lint_message <- sprintf( - paste( - "%s (R %s) is not available for dependency R >= %s.", - "Use the `except` argument of `backport_linter()` to configure available backports." - ), + "%s (R %s) is not available for dependency R >= %s.", all_names[needs_backport], bad_versions[needs_backport], r_version diff --git a/R/brace_linter.R b/R/brace_linter.R index 1c0337a24..417be0684 100644 --- a/R/brace_linter.R +++ b/R/brace_linter.R @@ -194,7 +194,7 @@ brace_linter <- function(allow_single_line = FALSE) { xml_nodes_to_lints( xml_find_all(xml, xp_function_brace), source_expression = source_expression, - lint_message = "Any function spanning multiple lines should use curly braces." + lint_message = "Use curly braces for any function spanning multiple lines." ) ) diff --git a/R/class_equals_linter.R b/R/class_equals_linter.R index 5ee712cf1..a210be31a 100644 --- a/R/class_equals_linter.R +++ b/R/class_equals_linter.R @@ -52,7 +52,7 @@ class_equals_linter <- function() { operator <- xml_find_chr(bad_expr, "string(*[2])") lint_message <- sprintf( - "Instead of comparing class(x) with %s, use inherits(x, 'class-name') or is. or is(x, 'class')", + "Use inherits(x, 'class-name'), is. or is(x, 'class') instead of comparing class(x) with %s.", operator ) xml_nodes_to_lints( diff --git a/R/commas_linter.R b/R/commas_linter.R index e7b9feda7..af4226cee 100644 --- a/R/commas_linter.R +++ b/R/commas_linter.R @@ -84,7 +84,7 @@ commas_linter <- function(allow_trailing = FALSE) { before_lints <- xml_nodes_to_lints( xml_find_all(xml, xpath_before), source_expression = source_expression, - lint_message = "Commas should never have a space before.", + lint_message = "Remove spaces before a comma.", range_start_xpath = "number(./preceding-sibling::*[1]/@col2 + 1)", # start after preceding expression range_end_xpath = "number(./@col1 - 1)" # end before comma ) @@ -92,7 +92,7 @@ commas_linter <- function(allow_trailing = FALSE) { after_lints <- xml_nodes_to_lints( xml_find_all(xml, xpath_after), source_expression = source_expression, - lint_message = "Commas should always have a space after.", + lint_message = "Put a space after a comma.", range_start_xpath = "number(./@col2 + 1)", # start and end after comma range_end_xpath = "number(./@col2 + 1)" ) diff --git a/R/comment_linters.R b/R/comment_linters.R index 26c107ffc..e444a9b32 100644 --- a/R/comment_linters.R +++ b/R/comment_linters.R @@ -91,7 +91,7 @@ commented_code_linter <- function() { lint_list <- xml_nodes_to_lints( all_comment_nodes[is_parsable], source_expression = source_expression, - lint_message = "Commented code should be removed." + lint_message = "Remove commented code." ) # Location info needs updating @@ -175,7 +175,7 @@ todo_comment_linter <- function(todo = c("todo", "fixme")) { line_number = token[["line1"]], column_number = token[["col1"]], type = "style", - message = "TODO comments should be removed.", + message = "Remove TODO comments.", line = source_expression[["lines"]][[as.character(token[["line1"]])]], ranges = list(c(token[["col1"]], token[["col2"]])) ) diff --git a/R/condition_call_linter.R b/R/condition_call_linter.R index 1a618d8ba..b30ff24ae 100644 --- a/R/condition_call_linter.R +++ b/R/condition_call_linter.R @@ -58,58 +58,41 @@ condition_call_linter <- function(display_call = FALSE) { call_xpath <- glue::glue(" following-sibling::SYMBOL_SUB[text() = 'call.'] - /following-sibling::expr[1] - /NUM_CONST[text() = '{!display_call}'] + /following-sibling::expr[1] + /NUM_CONST[text() = '{!display_call}'] ") - no_call_xpath <- " - parent::expr[ - count(SYMBOL_SUB[text() = 'call.']) = 0 - ] - " + no_call_xpath <- "parent::expr[not(SYMBOL_SUB[text() = 'call.'])]" if (is.na(display_call)) { - frag <- no_call_xpath + call_cond <- no_call_xpath + msg_fmt <- "Provide an explicit value for `call.` in %s()." } else if (display_call) { - frag <- call_xpath + call_cond <- call_xpath + msg_fmt <- "Use %s(.) to display the call in an error message." } else { # call. = TRUE can be expressed in two way: # - either explicitly with call. = TRUE # - or by implicitly relying on the default - frag <- xp_or(call_xpath, no_call_xpath) + call_cond <- xp_or(call_xpath, no_call_xpath) + msg_fmt <- "Use %s(., call. = FALSE) not to display the call in an error message." } xpath <- glue::glue(" //SYMBOL_FUNCTION_CALL[text() = 'stop' or text() = 'warning'] - /parent::expr[{frag}] - /parent::expr + /parent::expr[{call_cond}] + /parent::expr ") Linter(linter_level = "expression", function(source_expression) { - xml <- source_expression$xml_parsed_content if (is.null(xml)) return(list()) bad_expr <- xml_find_all(xml, xpath) - if (is.na(display_call)) { - msg <- glue::glue( - "Provide an explicit value for call. in {xp_call_name(bad_expr)}()." - ) - } else if (display_call) { - msg <- glue::glue( - "Use {xp_call_name(bad_expr)}(.) to display call in error message." - ) - } else { - msg <- glue::glue( - "Use {xp_call_name(bad_expr)}(., call. = FALSE)", - " to not display call in error message." - ) - } - xml_nodes_to_lints( bad_expr, source_expression = source_expression, - lint_message = msg, + lint_message = sprintf(msg_fmt, xp_call_name(bad_expr)), type = "warning" ) }) diff --git a/R/conjunct_test_linter.R b/R/conjunct_test_linter.R index 92f3d51a8..b85804adc 100644 --- a/R/conjunct_test_linter.R +++ b/R/conjunct_test_linter.R @@ -127,13 +127,13 @@ conjunct_test_linter <- function(allow_named_stopifnot = TRUE, operator <- xml_find_chr(test_expr, "string(expr/*[self::AND2 or self::OR2])") replacement_fmt <- ifelse( matched_fun %in% c("expect_true", "expect_false"), - "write multiple expectations like %1$s(A) and %1$s(B)", - "write multiple conditions like %s(A, B)." + "Write multiple expectations like %1$s(A) and %1$s(B)", + "Write multiple conditions like %s(A, B)" ) lint_message <- paste( - sprintf("Instead of %s(A %s B),", matched_fun, operator), # as.character() needed for 0-lint case where ifelse(logical(0)) returns logical(0) sprintf(as.character(replacement_fmt), matched_fun), + sprintf("instead of %s(A %s B).", matched_fun, operator), "The latter will produce better error messages in the case of failure." ) lints <- xml_nodes_to_lints( diff --git a/R/cyclocomp_linter.R b/R/cyclocomp_linter.R index 7288ff07c..c5563646f 100644 --- a/R/cyclocomp_linter.R +++ b/R/cyclocomp_linter.R @@ -36,8 +36,8 @@ cyclocomp_linter <- function(complexity_limit = 15L) { column_number = source_expression[["column"]][1L], type = "style", message = sprintf( - "Functions should have cyclomatic complexity of less than %d, this has %d.", - complexity_limit, complexity + "Reduce the cyclomatic complexity of this function from %d to at most %d.", + complexity, complexity_limit ), ranges = list(rep(col1, 2L)), line = source_expression$lines[1L] diff --git a/R/duplicate_argument_linter.R b/R/duplicate_argument_linter.R index edcb673ab..ca579b82e 100644 --- a/R/duplicate_argument_linter.R +++ b/R/duplicate_argument_linter.R @@ -58,7 +58,7 @@ duplicate_argument_linter <- function(except = c("mutate", "transmute")) { xml_nodes_to_lints( unlist(all_arg_nodes, recursive = FALSE)[unlist(is_duplicated)], source_expression = source_expression, - lint_message = "Duplicate arguments in function call.", + lint_message = "Avoid duplicate arguments in function calls.", type = "warning" ) }) diff --git a/R/expect_lint.R b/R/expect_lint.R index 5aabe7856..2cc8e1f9e 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -25,16 +25,16 @@ #' expect_lint("a", NULL, trailing_blank_lines_linter()) #' #' # one expected lint -#' expect_lint("a\n", "superfluous", trailing_blank_lines_linter()) -#' expect_lint("a\n", list(message = "superfluous", line_number = 2), trailing_blank_lines_linter()) +#' expect_lint("a\n", "trailing blank", trailing_blank_lines_linter()) +#' expect_lint("a\n", list(message = "trailing blank", line_number = 2), trailing_blank_lines_linter()) #' #' # several expected lints -#' expect_lint("a\n\n", list("superfluous", "superfluous"), trailing_blank_lines_linter()) +#' expect_lint("a\n\n", list("trailing blank", "trailing blank"), trailing_blank_lines_linter()) #' expect_lint( #' "a\n\n", #' list( -#' list(message = "superfluous", line_number = 2), -#' list(message = "superfluous", line_number = 3) +#' list(message = "trailing blank", line_number = 2), +#' list(message = "trailing blank", line_number = 3) #' ), #' trailing_blank_lines_linter() #' ) diff --git a/R/fixed_regex_linter.R b/R/fixed_regex_linter.R index d124a3a18..5c456683c 100644 --- a/R/fixed_regex_linter.R +++ b/R/fixed_regex_linter.R @@ -145,25 +145,27 @@ fixed_regex_linter <- function(allow_unescaped = FALSE) { patterns <- xml_find_all(xml, xpath) pattern_strings <- get_r_string(patterns) + is_static <- is_not_regex(pattern_strings, allow_unescaped) + patterns <- patterns[is_static] + pattern_strings <- pattern_strings[is_static] - fixed_equivalent <- encodeString(get_fixed_string(pattern_strings[is_static]), quote = '"', justify = "none") - call_name <- xml_find_chr(patterns[is_static], "string(preceding-sibling::expr[last()]/SYMBOL_FUNCTION_CALL)") + fixed_equivalent <- encodeString(get_fixed_string(pattern_strings), quote = '"', justify = "none") + call_name <- xml_find_chr(patterns, "string(preceding-sibling::expr[last()]/SYMBOL_FUNCTION_CALL)") is_stringr <- startsWith(call_name, "str_") - replacement <- ifelse( + replacement_suggestion <- ifelse( is_stringr, - sprintf("stringr::fixed(%s)", fixed_equivalent), - fixed_equivalent + sprintf("stringr::fixed(%s) as the pattern", fixed_equivalent), + sprintf("%s with fixed = TRUE", fixed_equivalent) ) msg <- paste( - "This regular expression is static, i.e., its matches can be expressed as a fixed substring expression, which", - "is faster to compute. Here, you can use", - replacement, ifelse(is_stringr, "as the pattern.", "with fixed = TRUE.") + "Use", replacement_suggestion, "here. This regular expression is static, i.e.,", + "its matches can be expressed as a fixed substring expression, which is faster to compute." ) xml_nodes_to_lints( - patterns[is_static], + patterns, source_expression = source_expression, lint_message = msg, type = "warning" diff --git a/R/if_not_else_linter.R b/R/if_not_else_linter.R index 731ca4625..58ffa214b 100644 --- a/R/if_not_else_linter.R +++ b/R/if_not_else_linter.R @@ -91,10 +91,7 @@ if_not_else_linter <- function(exceptions = c("is.null", "is.na", "missing")) { if_lints <- xml_nodes_to_lints( if_expr, source_expression = source_expression, - lint_message = paste( - "In a simple if/else statement,", - "prefer `if (A) x else y` to the less-readable `if (!A) y else x`." - ), + lint_message = "Prefer `if (A) x else y` to the less-readable `if (!A) y else x` in a simple if/else statement.", type = "warning" ) diff --git a/R/implicit_integer_linter.R b/R/implicit_integer_linter.R index 354120e6a..5dae749a8 100644 --- a/R/implicit_integer_linter.R +++ b/R/implicit_integer_linter.R @@ -60,7 +60,7 @@ implicit_integer_linter <- function(allow_colon = FALSE) { xml_nodes_to_lints( numbers[is_implicit_integer(xml_text(numbers))], source_expression = source_expression, - lint_message = "Integers should not be implicit. Use the form 1L for integers or 1.0 for doubles.", + lint_message = "Avoid implicit integers. Use e.g. 1L for integers or 1.0 for doubles.", type = "style", column_number_xpath = "number(./@col2 + 1)", # mark at end range_end_xpath = "number(./@col2 + 1)" # end after number for easy fixing (enter "L" or ".0") diff --git a/R/is_numeric_linter.R b/R/is_numeric_linter.R index e75ba5472..c9d22103d 100644 --- a/R/is_numeric_linter.R +++ b/R/is_numeric_linter.R @@ -78,7 +78,7 @@ is_numeric_linter <- function() { or_expr, source_expression = source_expression, lint_message = paste( - "is.numeric(x) is the same as is.numeric(x) || is.integer(x).", + "Use `is.numeric(x)` instead of the equivalent `is.numeric(x) || is.integer(x)`.", "Use is.double(x) to test for objects stored as 64-bit floating point." ), type = "warning" @@ -97,7 +97,7 @@ is_numeric_linter <- function() { class_expr, source_expression = source_expression, lint_message = paste( - 'is.numeric(x) is the same as class(x) %in% c("integer", "numeric").', + 'Use is.numeric(x) instead of class(x) %in% c("integer", "numeric").', "Use is.double(x) to test for objects stored as 64-bit floating point." ), type = "warning" diff --git a/R/namespace_linter.R b/R/namespace_linter.R index e0bc85eb5..d709e6b38 100644 --- a/R/namespace_linter.R +++ b/R/namespace_linter.R @@ -157,7 +157,7 @@ build_ns_get_int_lints <- function(packages, symbols, symbol_nodes, namespaces, symbol_nodes[exported], source_expression = source_expression, lint_message = - sprintf("'%1$s' is exported from {%2$s}. Use %2$s::%1$s instead.", symbols[exported], packages[exported]), + sprintf("Don't use `:::` to access %s, which is exported from %s.", symbols[exported], packages[exported]), type = "warning" ) diff --git a/R/nzchar_linter.R b/R/nzchar_linter.R index b9e36b89f..f15b4d88f 100644 --- a/R/nzchar_linter.R +++ b/R/nzchar_linter.R @@ -101,7 +101,7 @@ nzchar_linter <- function() { comparison_expr, source_expression = source_expression, lint_message = paste( - 'Instead of comparing strings to "", use nzchar().', + 'Use nzchar() instead of comparing strings to "".', "Note that if x is a factor, you'll have use ", 'as.character() to replicate an implicit conversion that happens in x == "".', keepna_note @@ -114,7 +114,7 @@ nzchar_linter <- function() { nchar_expr, source_expression = source_expression, lint_message = paste( - "Instead of comparing nchar(x) to 0, use nzchar().", + "Use nzchar() instead of comparing nchar(x) to 0.", keepna_note ), type = "warning" diff --git a/R/one_call_pipe_linter.R b/R/one_call_pipe_linter.R index f780ce02b..ab27e5172 100644 --- a/R/one_call_pipe_linter.R +++ b/R/one_call_pipe_linter.R @@ -75,7 +75,7 @@ one_call_pipe_linter <- function() { xml_nodes_to_lints( bad_expr, source_expression = source_expression, - lint_message = paste0("Expressions with only a single call shouldn't use pipe ", pipe, "."), + lint_message = paste0("Avoid pipe ", pipe, " for expressions with only a single call."), type = "warning" ) }) diff --git a/R/paren_body_linter.R b/R/paren_body_linter.R index eb44a8087..b8ec09e40 100644 --- a/R/paren_body_linter.R +++ b/R/paren_body_linter.R @@ -47,6 +47,6 @@ paren_body_linter <- make_linter_from_xpath( ] /following-sibling::expr ", - lint_message = "There should be a space between a right parenthesis and a body expression.", + lint_message = "Put a space between a right parenthesis and a body expression.", type = "style" ) diff --git a/R/pipe_consistency_linter.R b/R/pipe_consistency_linter.R index d463f584a..85b429aa4 100644 --- a/R/pipe_consistency_linter.R +++ b/R/pipe_consistency_linter.R @@ -53,8 +53,7 @@ pipe_consistency_linter <- function(pipe = c("auto", "%>%", "|>")) { xml = c(match_magrittr, match_native), source_expression = source_expression, lint_message = glue( - "Found {n_magrittr} instances of %>% and {n_native} instances of |>. ", - "Stick to one pipe operator." + "Stick to one pipe operator; found {n_magrittr} instances of %>% and {n_native} instances of |>." ), type = "style" ) diff --git a/R/pipe_continuation_linter.R b/R/pipe_continuation_linter.R index 0c03cf46c..aabe58f77 100644 --- a/R/pipe_continuation_linter.R +++ b/R/pipe_continuation_linter.R @@ -78,7 +78,7 @@ pipe_continuation_linter <- function() { pipe_exprs, source_expression = source_expression, lint_message = sprintf( - "`%s` should always have a space before it and a new line after it, unless the full pipeline fits on one line.", + "Put a space before `%s` and a new line after it, unless the full pipeline fits on one line.", pipe_text ), type = "style" diff --git a/R/pipe_return_linter.R b/R/pipe_return_linter.R index fd73da8ae..57b5bcafe 100644 --- a/R/pipe_return_linter.R +++ b/R/pipe_return_linter.R @@ -32,8 +32,7 @@ pipe_return_linter <- make_linter_from_xpath( /following-sibling::expr[expr/SYMBOL_FUNCTION_CALL[text() = 'return']] ", lint_message = paste( - "Using return() as the final step of a magrittr pipeline", - "is an anti-pattern. Instead, assign the output of the pipeline to", - "a well-named object and return that." + "Avoid return() as the final step of a magrittr pipeline. ", + "Instead, assign the output of the pipeline to a well-named object and return that." ) ) diff --git a/R/return_linter.R b/R/return_linter.R index 4e3731cba..758a26be8 100644 --- a/R/return_linter.R +++ b/R/return_linter.R @@ -3,7 +3,7 @@ #' This linter checks functions' [return()] expressions. #' #' @param return_style Character string naming the return style. `"implicit"`, -#' the default, enforeces the Tidyverse guide recommendation to leave terminal +#' the default, enforces the Tidyverse guide recommendation to leave terminal #' returns implicit. `"explicit"` style requires that `return()` always be #' explicitly supplied. #' @param allow_implicit_else Logical, default `TRUE`. If `FALSE`, functions with a terminal diff --git a/R/semicolon_linter.R b/R/semicolon_linter.R index 66b893e6d..4feca5b95 100644 --- a/R/semicolon_linter.R +++ b/R/semicolon_linter.R @@ -60,8 +60,8 @@ #' - #' @export semicolon_linter <- function(allow_compound = FALSE, allow_trailing = FALSE) { - msg_trailing <- "Trailing semicolons are not needed." - msg_compound <- "Compound semicolons are discouraged. Replace them by a newline." + msg_trailing <- "Remove trailing semicolons." + msg_compound <- "Replace compound semicolons by a newline." if (allow_compound && allow_trailing) { stop( diff --git a/R/seq_linter.R b/R/seq_linter.R index 462c0889a..a2e08523c 100644 --- a/R/seq_linter.R +++ b/R/seq_linter.R @@ -104,12 +104,12 @@ seq_linter <- function() { lint_message <- ifelse( grepl("seq", dot_expr1, fixed = TRUE), sprintf( - "%s(%s) is likely to be wrong in the empty edge case. Use %s instead.", - dot_expr1, dot_expr2, replacement + "Use %s instead of %s(%s), which is likely to be wrong in the empty edge case.", + replacement, dot_expr1, dot_expr2 ), sprintf( - "%s:%s is likely to be wrong in the empty edge case. Use %s instead.", - dot_expr1, dot_expr2, replacement + "Use %s instead of %s:%s, which is likely to be wrong in the empty edge case.", + replacement, dot_expr1, dot_expr2 ) ) diff --git a/R/stopifnot_all_linter.R b/R/stopifnot_all_linter.R index f081cc0c0..7ec01ea3e 100644 --- a/R/stopifnot_all_linter.R +++ b/R/stopifnot_all_linter.R @@ -37,7 +37,7 @@ stopifnot_all_linter <- make_linter_from_xpath( /expr[expr/SYMBOL_FUNCTION_CALL[text() = 'all']] ", lint_message = paste( - "Calling stopifnot(all(x)) is redundant. stopifnot(x) runs all()", - "'under the hood' and provides a better error message in case of failure." + "Use stopifnot(x) instead of stopifnot(all(x)).", + "stopifnot(x) runs all() 'under the hood' and provides a better error message in case of failure." ) ) diff --git a/R/strings_as_factors_linter.R b/R/strings_as_factors_linter.R index e4cf535fd..97522182c 100644 --- a/R/strings_as_factors_linter.R +++ b/R/strings_as_factors_linter.R @@ -91,12 +91,8 @@ strings_as_factors_linter <- function() { xml_nodes_to_lints( bad_expr, source_expression = source_expression, - lint_message = paste( - "This code relies on the default value of stringsAsFactors,", - "which changed in version R 4.0. Please supply an explicit value for", - "stringsAsFactors for this code to work with versions of R both before", - "and after this switch." - ), + lint_message = + "Supply an explicit value for stringsAsFactors for this code to work before and after R version 4.0.", type = "warning" ) }) diff --git a/R/terminal_close_linter.R b/R/terminal_close_linter.R index 4b8a3ede3..20b86ac64 100644 --- a/R/terminal_close_linter.R +++ b/R/terminal_close_linter.R @@ -49,8 +49,5 @@ terminal_close_linter <- make_linter_from_xpath( ] ] ", - lint_message = paste( - "Use on.exit(close(x)) to close connections instead of", - "running it as the last call in a function." - ) + lint_message = "Use on.exit(close(x)) to close connections instead of running it as the last call in a function." ) diff --git a/R/trailing_blank_lines_linter.R b/R/trailing_blank_lines_linter.R index 3479a8b58..101d778aa 100644 --- a/R/trailing_blank_lines_linter.R +++ b/R/trailing_blank_lines_linter.R @@ -38,7 +38,7 @@ trailing_blank_lines_linter <- function() { line_number = line_number, column_number = 1L, type = "style", - message = "Trailing blank lines are superfluous.", + message = "Remove trailing blank lines.", line = source_expression$file_lines[[line_number]] ) } @@ -53,7 +53,7 @@ trailing_blank_lines_linter <- function() { line_number = length(source_expression$file_lines), column_number = (nchar(last_line) %||% 0L) + 1L, type = "style", - message = "Missing terminal newline.", + message = "Add a terminal newline.", line = last_line ) } diff --git a/R/trailing_whitespace_linter.R b/R/trailing_whitespace_linter.R index fec39dcba..ba1e5ef25 100644 --- a/R/trailing_whitespace_linter.R +++ b/R/trailing_whitespace_linter.R @@ -71,7 +71,7 @@ trailing_whitespace_linter <- function(allow_empty_lines = FALSE, allow_in_strin line_number = line, column_number = res$start[[line]], type = "style", - message = "Trailing whitespace is superfluous.", + message = "Remove trailing whitespace.", line = source_expression$file_lines[[line]], ranges = list(c(res$start[[line]], res$end[[line]])) ) diff --git a/R/undesirable_function_linter.R b/R/undesirable_function_linter.R index d157b3963..3b4f225bc 100644 --- a/R/undesirable_function_linter.R +++ b/R/undesirable_function_linter.R @@ -91,7 +91,7 @@ undesirable_function_linter <- function(fun = default_undesirable_functions, msgs <- vapply( stats::setNames(nm = unique(fun_names)), function(fun_name) { - msg <- sprintf('Function "%s" is undesirable.', fun_name) + msg <- sprintf('Avoid undesirable function "%s".', fun_name) alternative <- fun[[fun_name]] if (!is.na(alternative)) { msg <- paste(msg, sprintf("As an alternative, %s.", alternative)) diff --git a/R/undesirable_operator_linter.R b/R/undesirable_operator_linter.R index e25ab27f1..483149119 100644 --- a/R/undesirable_operator_linter.R +++ b/R/undesirable_operator_linter.R @@ -73,7 +73,7 @@ undesirable_operator_linter <- function(op = default_undesirable_operators) { bad_op <- xml_find_all(xml, xpath) operator <- xml_text(bad_op) - lint_message <- sprintf("Operator `%s` is undesirable.", operator) + lint_message <- sprintf("Avoid undesirable operator `%s`.", operator) alternative <- op[operator] has_alternative <- !is.na(alternative) lint_message[has_alternative] <- paste(lint_message[has_alternative], alternative[has_alternative]) diff --git a/R/unnecessary_concatenation_linter.R b/R/unnecessary_concatenation_linter.R index 3571e5faf..05a4f51ae 100644 --- a/R/unnecessary_concatenation_linter.R +++ b/R/unnecessary_concatenation_linter.R @@ -57,13 +57,10 @@ unnecessary_concatenation_linter <- function(allow_single_expression = TRUE) { # length(allow_single_expression) == 1L ) - msg_empty <- paste( - "Unneeded concatenation without arguments.", - 'Replace the "c" call by NULL or, whenever possible,', - "vector() seeded with the correct type and/or length." - ) + msg_empty <- + "Replace unnecessary c() by NULL or, whenever possible, vector() seeded with the correct type and/or length." - msg_const <- 'Unneeded concatenation of a constant. Remove the "c" call.' + msg_const <- "Remove unnecessary c() of a constant." non_constant_cond <- "SYMBOL or (expr and not(OP-COLON and count(expr[SYMBOL or expr]) != 2))" @@ -85,8 +82,8 @@ unnecessary_concatenation_linter <- function(allow_single_expression = TRUE) { # path_to_non_constant <- glue("./expr[2][ {non_constant_cond} ]") msg_const_expr <- paste( - 'Unneeded concatenation of a simple expression. Remove the "c" call,', - 'replacing with "as.vector" if using "c" to string attributes, e.g. in converting an array to a vector.' + "Remove unnecessary c() of a constant expression.", + "Replace with as.vector() if c() is used to strip attributes, e.g. in converting an array to a vector." ) } call_xpath <- glue(" diff --git a/R/unreachable_code_linter.R b/R/unreachable_code_linter.R index ccd2140ca..32ed5e696 100644 --- a/R/unreachable_code_linter.R +++ b/R/unreachable_code_linter.R @@ -147,7 +147,7 @@ unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclud lints_return_stop <- xml_nodes_to_lints( drop_valid_comments(expr_return_stop, allow_comment_regex), source_expression = source_expression, - lint_message = "Code and comments coming after a return() or stop() should be removed.", + lint_message = "Remove code and comments coming after return() or stop().", type = "warning" ) @@ -156,7 +156,7 @@ unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclud lints_next_break <- xml_nodes_to_lints( drop_valid_comments(expr_next_break, allow_comment_regex), source_expression = source_expression, - lint_message = "Code and comments coming after a `next` or `break` should be removed.", + lint_message = "Remove code and comments coming after `next` or `break`.", type = "warning" ) @@ -165,7 +165,7 @@ unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclud lints_if_while <- xml_nodes_to_lints( expr_if_while, source_expression = source_expression, - lint_message = "Code inside a conditional loop with a deterministically false condition should be removed.", + lint_message = "Remove code inside a conditional loop with a deterministically false condition.", type = "warning" ) @@ -174,7 +174,7 @@ unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclud lints_else <- xml_nodes_to_lints( expr_else, source_expression = source_expression, - lint_message = "Code inside an else block after a deterministically true if condition should be removed.", + lint_message = "Remove code inside an else block after a deterministically true condition.", type = "warning" ) diff --git a/R/unused_import_linter.R b/R/unused_import_linter.R index 707e85626..504fb2bcc 100644 --- a/R/unused_import_linter.R +++ b/R/unused_import_linter.R @@ -129,7 +129,7 @@ unused_import_linter <- function(allow_ns_usage = FALSE, lint_message <- ifelse( is_ns_used[is_unused][unused_packages], paste0( - "Package '", unused_packages, "' is only used by namespace. ", + "Don't attach package '", unused_packages, "', which is only used by namespace. ", "Check that it is installed using loadNamespace() instead." ), paste0("Package '", unused_packages, "' is attached but never used.") diff --git a/R/yoda_test_linter.R b/R/yoda_test_linter.R index 442a77f64..bff26a46e 100644 --- a/R/yoda_test_linter.R +++ b/R/yoda_test_linter.R @@ -66,7 +66,7 @@ yoda_test_linter <- function() { lint_message <- ifelse( is.na(second_const), paste( - "Tests should compare objects in the order 'actual', 'expected', not the reverse.", + "Compare objects in tests 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) ), sprintf("Avoid storing placeholder tests like %s(1, 1)", matched_call) diff --git a/man/expect_lint.Rd b/man/expect_lint.Rd index 2832f9990..8b7a22fc1 100644 --- a/man/expect_lint.Rd +++ b/man/expect_lint.Rd @@ -40,16 +40,16 @@ This is an expectation function to test that the lints produced by \code{lint} s expect_lint("a", NULL, trailing_blank_lines_linter()) # one expected lint -expect_lint("a\n", "superfluous", trailing_blank_lines_linter()) -expect_lint("a\n", list(message = "superfluous", line_number = 2), trailing_blank_lines_linter()) +expect_lint("a\n", "trailing blank", trailing_blank_lines_linter()) +expect_lint("a\n", list(message = "trailing blank", line_number = 2), trailing_blank_lines_linter()) # several expected lints -expect_lint("a\n\n", list("superfluous", "superfluous"), trailing_blank_lines_linter()) +expect_lint("a\n\n", list("trailing blank", "trailing blank"), trailing_blank_lines_linter()) expect_lint( "a\n\n", list( - list(message = "superfluous", line_number = 2), - list(message = "superfluous", line_number = 3) + list(message = "trailing blank", line_number = 2), + list(message = "trailing blank", line_number = 3) ), trailing_blank_lines_linter() ) diff --git a/man/return_linter.Rd b/man/return_linter.Rd index f6bdfaf20..f18f2d8c1 100644 --- a/man/return_linter.Rd +++ b/man/return_linter.Rd @@ -13,7 +13,7 @@ return_linter( } \arguments{ \item{return_style}{Character string naming the return style. \code{"implicit"}, -the default, enforeces the Tidyverse guide recommendation to leave terminal +the default, enforces the Tidyverse guide recommendation to leave terminal returns implicit. \code{"explicit"} style requires that \code{return()} always be explicitly supplied.} diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index f46067348..6bf192b0c 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -27,14 +27,17 @@ test_that("assignment_linter blocks disallowed usages", { }) test_that("arguments handle <<- and ->/->> correctly", { - expect_lint("1 -> blah", rex::rex("Use <-, not ->, for assignment."), assignment_linter()) - expect_lint("1 ->> blah", rex::rex("->> can have hard-to-predict behavior;"), assignment_linter()) + linter <- assignment_linter() + lint_msg_right <- rex::rex("Replace ->> by assigning to a specific environment") + + expect_lint("1 -> blah", rex::rex("Use <-, not ->, for assignment."), linter) + expect_lint("1 ->> blah", lint_msg_right, linter) # <<- is only blocked optionally - expect_lint("1 <<- blah", NULL, assignment_linter()) + expect_lint("1 <<- blah", NULL, linter) expect_lint( "1 <<- blah", - rex::rex("<<- can have hard-to-predict behavior;"), + rex::rex("Replace <<- by assigning to a specific environment"), assignment_linter(allow_cascading_assign = FALSE) ) @@ -44,7 +47,7 @@ test_that("arguments handle <<- and ->/->> correctly", { # blocked under cascading assign but not under right assign --> blocked expect_lint( "1 ->> blah", - rex::rex("->> can have hard-to-predict behavior;"), + lint_msg_right, assignment_linter(allow_cascading_assign = FALSE, allow_right_assign = TRUE) ) }) @@ -66,7 +69,7 @@ test_that("arguments handle trailing assignment operators correctly", { ) expect_lint( "x <<-\ny", - rex::rex("<<- can have hard-to-predict behavior"), + rex::rex("Replace <<- by assigning to a specific environment"), assignment_linter(allow_trailing = FALSE, allow_cascading_assign = FALSE) ) @@ -176,8 +179,8 @@ test_that("multiple lints throw correct messages", { expect_lint( "{ x <<- 1; y ->> 2; z -> 3; x %<>% as.character() }", list( - list(message = "<<- can have hard-to-predict behavior"), - list(message = "->> can have hard-to-predict behavior"), + list(message = "Replace <<- by assigning to a specific environment"), + list(message = "Replace ->> by assigning to a specific environment"), list(message = "Use <-, not ->"), list(message = "Avoid the assignment pipe %<>%") ), diff --git a/tests/testthat/test-brace_linter.R b/tests/testthat/test-brace_linter.R index e3adc1a59..3727e4c96 100644 --- a/tests/testthat/test-brace_linter.R +++ b/tests/testthat/test-brace_linter.R @@ -315,7 +315,7 @@ test_that("brace_linter lints function expressions correctly", { ") expect_lint( lines, - rex::rex("Any function spanning multiple lines should use curly braces."), + rex::rex("Use curly braces for any function spanning multiple lines."), linter ) }) diff --git a/tests/testthat/test-class_equals_linter.R b/tests/testthat/test-class_equals_linter.R index d85c58008..9487a4c6c 100644 --- a/tests/testthat/test-class_equals_linter.R +++ b/tests/testthat/test-class_equals_linter.R @@ -11,7 +11,7 @@ test_that("class_equals_linter skips allowed usages", { test_that("class_equals_linter blocks simple disallowed usages", { linter <- class_equals_linter() - lint_msg <- rex::rex("Instead of comparing class(x) with ==") + lint_msg <- rex::rex("Use inherits(x, 'class-name'), is. or is(x, 'class')") expect_lint("if (class(x) == 'character') stop('no')", lint_msg, linter) expect_lint("is_regression <- class(x) == 'lm'", lint_msg, linter) @@ -20,7 +20,7 @@ test_that("class_equals_linter blocks simple disallowed usages", { test_that("class_equals_linter blocks usage of %in% for checking class", { linter <- class_equals_linter() - lint_msg <- rex::rex("Instead of comparing class(x) with %in%") + lint_msg <- rex::rex("Use inherits(x, 'class-name'), is. or is(x, 'class')") expect_lint("if ('character' %in% class(x)) stop('no')", lint_msg, linter) expect_lint("if (class(x) %in% 'character') stop('no')", lint_msg, linter) @@ -29,7 +29,7 @@ test_that("class_equals_linter blocks usage of %in% for checking class", { test_that("class_equals_linter blocks class(x) != 'klass'", { expect_lint( "if (class(x) != 'character') TRUE", - rex::rex("Instead of comparing class(x) with !="), + rex::rex("Use inherits(x, 'class-name'), is. or is(x, 'class')"), class_equals_linter() ) }) @@ -43,7 +43,7 @@ test_that("class_equals_linter skips usage for subsetting", { # but not further nesting expect_lint( "x[if (class(x) == 'foo') 1 else 2]", - rex::rex("Instead of comparing class(x) with =="), + rex::rex("Use inherits(x, 'class-name'), is. or is(x, 'class')"), linter ) }) diff --git a/tests/testthat/test-commas_linter.R b/tests/testthat/test-commas_linter.R index eaceb651f..423a32cc9 100644 --- a/tests/testthat/test-commas_linter.R +++ b/tests/testthat/test-commas_linter.R @@ -1,7 +1,7 @@ test_that("returns the correct linting (with default parameters)", { linter <- commas_linter() - msg_after <- rex::rex("Commas should always have a space after.") - msg_before <- rex::rex("Commas should never have a space before.") + msg_after <- rex::rex("Put a space after a comma.") + msg_before <- rex::rex("Remove spaces before a comma.") expect_lint("blah", NULL, linter) expect_lint("fun(1, 1)", NULL, linter) @@ -52,8 +52,8 @@ test_that("returns the correct linting (with default parameters)", { test_that("returns the correct linting (with 'allow_trailing' set)", { linter <- commas_linter(allow_trailing = TRUE) - msg_after <- rex::rex("Commas should always have a space after.") - msg_before <- rex::rex("Commas should never have a space before.") + msg_after <- rex::rex("Put a space after a comma.") + msg_before <- rex::rex("Remove spaces before a comma.") expect_lint("blah", NULL, linter) expect_lint("fun(1, 1)", NULL, linter) diff --git a/tests/testthat/test-commented_code_linter.R b/tests/testthat/test-commented_code_linter.R index 0d034e819..d7ff74651 100644 --- a/tests/testthat/test-commented_code_linter.R +++ b/tests/testthat/test-commented_code_linter.R @@ -20,7 +20,7 @@ test_that("commented_code_linter skips allowed usages", { }) test_that("commented_code_linter blocks disallowed usages", { - lint_msg <- rex::rex("Commented code should be removed.") + lint_msg <- rex::rex("Remove commented code.") linter <- commented_code_linter() expect_lint("# blah <- 1", lint_msg, linter) @@ -80,7 +80,7 @@ test_that("commented_code_linter blocks disallowed usages", { test_that("commented_code_linter can detect operators in comments and lint correctly", { linter <- commented_code_linter() - lint_msg <- rex::rex("Commented code should be removed.") + lint_msg <- rex::rex("Remove commented code.") test_ops <- c( "+", "=", "==", "!=", "<=", ">=", "<-", "<<-", "<", ">", "->", @@ -100,7 +100,7 @@ test_that("commented_code_linter can detect operators in comments and lint corre expect_lint( "# 1:3 |> sum()", - rex::rex("Commented code should be removed."), + rex::rex("Remove commented code."), commented_code_linter() ) }) diff --git a/tests/testthat/test-condition_call_linter.R b/tests/testthat/test-condition_call_linter.R index 6ef37aa0c..f0a595149 100644 --- a/tests/testthat/test-condition_call_linter.R +++ b/tests/testthat/test-condition_call_linter.R @@ -20,13 +20,13 @@ patrick::with_parameters_test_that( "condition_call_linter blocks disallowed usages", { linter <- condition_call_linter() - lint_message <- rex::rex(call_name, anything, "to not display call") + lint_message <- rex::rex(call_name, anything, "not to display the call") expect_lint(paste0(call_name, "('test')"), lint_message, linter) expect_lint(paste0(call_name, "('test', call. = TRUE)"), lint_message, linter) linter <- condition_call_linter(display_call = TRUE) - lint_message <- rex::rex(call_name, anything, "to display call") + lint_message <- rex::rex(call_name, anything, "to display the call") expect_lint(paste0(call_name, "('test', call. = FALSE)"), lint_message, linter) diff --git a/tests/testthat/test-conjunct_test_linter.R b/tests/testthat/test-conjunct_test_linter.R index 918d8685e..355de5788 100644 --- a/tests/testthat/test-conjunct_test_linter.R +++ b/tests/testthat/test-conjunct_test_linter.R @@ -19,22 +19,18 @@ test_that("conjunct_test_linter skips allowed usages of expect_true", { }) test_that("conjunct_test_linter blocks && conditions with expect_true()", { - expect_lint( - "expect_true(x && y)", - rex::rex("Instead of expect_true(A && B), write multiple expectations"), - conjunct_test_linter() - ) + linter <- conjunct_test_linter() + lint_msg <- + rex::rex("Write multiple expectations like expect_true(A) and expect_true(B) instead of expect_true(A && B)") - expect_lint( - "expect_true(x && y && z)", - rex::rex("Instead of expect_true(A && B), write multiple expectations"), - conjunct_test_linter() - ) + expect_lint("expect_true(x && y)", lint_msg, linter) + expect_lint("expect_true(x && y && z)", lint_msg, linter) }) test_that("conjunct_test_linter blocks || conditions with expect_false()", { linter <- conjunct_test_linter() - lint_msg <- rex::rex("Instead of expect_false(A || B), write multiple expectations") + lint_msg <- + rex::rex("Write multiple expectations like expect_false(A) and expect_false(B) instead of expect_false(A || B)") expect_lint("expect_false(x || y)", lint_msg, linter) expect_lint("expect_false(x || y || z)", lint_msg, linter) @@ -59,7 +55,7 @@ test_that("conjunct_test_linter skips allowed stopifnot() and assert_that() usag test_that("conjunct_test_linter blocks simple disallowed usages of stopifnot() and assert_that()", { linter <- conjunct_test_linter() - lint_msg <- function(fun) rex::rex("Instead of ", fun, "(A && B), write multiple conditions") + lint_msg <- function(fun) rex::rex("Write multiple conditions like ", fun, "(A, B) instead of ", fun, "(A && B)") expect_lint("stopifnot(x && y)", lint_msg("stopifnot"), linter) expect_lint("stopifnot(x && y && z)", lint_msg("stopifnot"), linter) @@ -78,7 +74,7 @@ test_that("conjunct_test_linter's allow_named_stopifnot argument works", { ) expect_lint( "stopifnot('x is a logical scalar' = length(x) == 1 && is.logical(x) && !is.na(x))", - rex::rex("Instead of stopifnot(A && B), write multiple conditions"), + rex::rex("Write multiple conditions like stopifnot(A, B)"), conjunct_test_linter(allow_named_stopifnot = FALSE) ) }) diff --git a/tests/testthat/test-cyclocomp_linter.R b/tests/testthat/test-cyclocomp_linter.R index 9162c75c7..3c298c659 100644 --- a/tests/testthat/test-cyclocomp_linter.R +++ b/tests/testthat/test-cyclocomp_linter.R @@ -1,7 +1,7 @@ test_that("returns the correct linting", { cc_linter_1 <- cyclocomp_linter(1L) cc_linter_2 <- cyclocomp_linter(2L) - lint_msg <- rex::rex("Functions should have cyclomatic complexity") + lint_msg <- rex::rex("Reduce the cyclomatic complexity of this function") expect_lint("if (TRUE) 1 else 2", NULL, cc_linter_2) expect_lint("if (TRUE) 1 else 2", lint_msg, cc_linter_1) @@ -40,7 +40,7 @@ test_that("returns the correct linting", { expect_lint(complex_lines, lint_msg, cc_linter_2) expect_lint( complex_lines, - "should have cyclomatic complexity of less than 2, this has 10", + rex::rex("Reduce the cyclomatic complexity of this function from 10 to at most 2."), cc_linter_2 ) expect_lint(complex_lines, NULL, cyclocomp_linter(10L)) diff --git a/tests/testthat/test-duplicate_argument_linter.R b/tests/testthat/test-duplicate_argument_linter.R index 4c6bba76d..05a5e51cb 100644 --- a/tests/testthat/test-duplicate_argument_linter.R +++ b/tests/testthat/test-duplicate_argument_linter.R @@ -11,7 +11,7 @@ test_that("duplicate_argument_linter doesn't block allowed usages", { test_that("duplicate_argument_linter blocks disallowed usages", { linter <- duplicate_argument_linter() - lint_msg <- rex::rex("Duplicate arguments in function call.") + lint_msg <- rex::rex("Avoid duplicate arguments in function calls.") expect_lint("fun(arg = 1, arg = 2)", lint_msg, linter) expect_lint("fun(arg = 1, 'arg' = 2)", lint_msg, linter) @@ -51,13 +51,13 @@ test_that("duplicate_argument_linter respects except argument", { "fun(` ` = 1, ` ` = 2)", - list(message = rex::rex("Duplicate arguments in function call.")), + rex::rex("Avoid duplicate arguments in function calls."), duplicate_argument_linter(except = character()) ) expect_lint( "function(arg = 1, arg = 1) {}", - list(message = rex::rex("Repeated formal argument 'arg'.")), + rex::rex("Repeated formal argument 'arg'."), duplicate_argument_linter(except = character()) ) }) diff --git a/tests/testthat/test-fixed_regex_linter.R b/tests/testthat/test-fixed_regex_linter.R index 0fb6a8fb2..6e60bf2d2 100644 --- a/tests/testthat/test-fixed_regex_linter.R +++ b/tests/testthat/test-fixed_regex_linter.R @@ -245,8 +245,8 @@ test_that("fixed replacements vectorize and recognize str_detect", { ) "), list( - rex::rex('Here, you can use "abcdefg" with fixed = TRUE'), - rex::rex('Here, you can use "a..b\\n" with fixed = TRUE') + rex::rex('Use "abcdefg" with fixed = TRUE'), + rex::rex('Use "a..b\\n" with fixed = TRUE') ), linter ) @@ -254,7 +254,7 @@ test_that("fixed replacements vectorize and recognize str_detect", { # stringr hint works expect_lint( "str_detect(x, 'abc')", - rex::rex('Here, you can use stringr::fixed("abc") as the pattern'), + rex::rex('Use stringr::fixed("abc") as the pattern'), linter ) }) @@ -267,7 +267,7 @@ test_that("fixed replacement is correct with UTF-8", { expect_lint( "grepl('[\\U{1D4D7}]', x)", - rex::rex('Here, you can use "\U1D4D7" with fixed = TRUE'), + rex::rex('Use "\U1D4D7" with fixed = TRUE'), fixed_regex_linter() ) }) @@ -311,7 +311,7 @@ patrick::with_parameters_test_that("fixed replacements are correct", { ) expect_lint( sprintf("grepl('%s', x)", regex_expr), - rex::rex(sprintf('Here, you can use "%s" with fixed = TRUE', fixed_expr)), + rex::rex(sprintf('Use "%s" with fixed = TRUE', fixed_expr)), fixed_regex_linter() ) }, .cases = tibble::tribble( @@ -354,7 +354,7 @@ test_that("'unescaped' regex can optionally be skipped", { expect_lint("grepl('a', x)", NULL, linter) expect_lint("str_detect(x, 'a')", NULL, linter) - expect_lint("grepl('[$]', x)", rex::rex('Here, you can use "$"'), linter) + expect_lint("grepl('[$]', x)", rex::rex('Use "$" with fixed = TRUE'), linter) }) local({ diff --git a/tests/testthat/test-if_not_else_linter.R b/tests/testthat/test-if_not_else_linter.R index 27f0b1df2..35d8aac18 100644 --- a/tests/testthat/test-if_not_else_linter.R +++ b/tests/testthat/test-if_not_else_linter.R @@ -20,7 +20,7 @@ test_that("if_not_else_linter skips allowed usages", { test_that("if_not_else_linter blocks simple disallowed usages", { linter <- if_not_else_linter() - lint_msg <- rex::rex("In a simple if/else statement, prefer `if (A) x else y`") + lint_msg <- rex::rex("Prefer `if (A) x else y`") expect_lint("if (!A) x else y", lint_msg, linter) expect_lint("if (!A) x else if (!B) y else z", lint_msg, linter) @@ -65,7 +65,7 @@ test_that("multiple lints are generated correctly", { if_else(!A, x, y) }"), list( - "In a simple if/else statement", + rex::rex("Prefer `if (A) x else y`"), "Prefer `ifelse", "Prefer `fifelse", "Prefer `if_else" @@ -77,7 +77,7 @@ test_that("multiple lints are generated correctly", { test_that("exceptions= argument works", { expect_lint( "if (!is.null(x)) x else y", - "In a simple if/else statement", + rex::rex("Prefer `if (A) x else y`"), if_not_else_linter(exceptions = character()) ) diff --git a/tests/testthat/test-implicit_integer_linter.R b/tests/testthat/test-implicit_integer_linter.R index cd0bebec0..1aa57d146 100644 --- a/tests/testthat/test-implicit_integer_linter.R +++ b/tests/testthat/test-implicit_integer_linter.R @@ -48,15 +48,15 @@ local({ linter <- implicit_integer_linter() patrick::with_parameters_test_that( "single numerical constants are properly identified ", - expect_lint(num_value_str, if (should_lint) "Integers should not be implicit", linter), + expect_lint(num_value_str, if (should_lint) "Avoid implicit integers", linter), .cases = cases ) }) # styler: on test_that("linter returns the correct linting", { - lint_msg <- "Integers should not be implicit. Use the form 1L for integers or 1.0 for doubles." linter <- implicit_integer_linter() + lint_msg <- rex::rex("Avoid implicit integers. Use e.g. 1L for integers or 1.0 for doubles.") expect_lint("x <<- 1L", NULL, linter) expect_lint("1.0/-Inf -> y", NULL, linter) @@ -90,7 +90,7 @@ patrick::with_parameters_test_that( "numbers in a:b input are optionally not linted", expect_lint( paste0(left, ":", right), - if (n_lints > 0L) rep(list("Integers should not be implicit"), n_lints), + if (n_lints > 0L) rep(list("Avoid implicit integers"), n_lints), implicit_integer_linter(allow_colon = allow_colon) ), .cases = tibble::tribble( diff --git a/tests/testthat/test-is_numeric_linter.R b/tests/testthat/test-is_numeric_linter.R index 95b2d6957..e5c8faacb 100644 --- a/tests/testthat/test-is_numeric_linter.R +++ b/tests/testthat/test-is_numeric_linter.R @@ -1,22 +1,26 @@ test_that("is_numeric_linter skips allowed usages involving ||", { - expect_lint("is.numeric(x) || is.integer(y)", NULL, is_numeric_linter()) + linter <- is_numeric_linter() + + expect_lint("is.numeric(x) || is.integer(y)", NULL, linter) # x is used, but not identically - expect_lint("is.numeric(x) || is.integer(foo(x))", NULL, is_numeric_linter()) + expect_lint("is.numeric(x) || is.integer(foo(x))", NULL, linter) # not totally crazy, e.g. if input accepts a vector or a list - expect_lint("is.numeric(x) || is.integer(x[[1]])", NULL, is_numeric_linter()) + expect_lint("is.numeric(x) || is.integer(x[[1]])", NULL, linter) }) test_that("is_numeric_linter skips allowed usages involving %in%", { + linter <- is_numeric_linter() + # false positives for class(x) %in% c('integer', 'numeric') style - expect_lint("class(x) %in% 1:10", NULL, is_numeric_linter()) - expect_lint("class(x) %in% 'numeric'", NULL, is_numeric_linter()) - expect_lint("class(x) %in% c('numeric', 'integer', 'factor')", NULL, is_numeric_linter()) - expect_lint("class(x) %in% c('numeric', 'integer', y)", NULL, is_numeric_linter()) + expect_lint("class(x) %in% 1:10", NULL, linter) + expect_lint("class(x) %in% 'numeric'", NULL, linter) + expect_lint("class(x) %in% c('numeric', 'integer', 'factor')", NULL, linter) + expect_lint("class(x) %in% c('numeric', 'integer', y)", NULL, linter) }) test_that("is_numeric_linter blocks disallowed usages involving ||", { linter <- is_numeric_linter() - lint_msg <- rex::rex("same as is.numeric(x) || is.integer(x)") + lint_msg <- rex::rex("Use `is.numeric(x)` instead of the equivalent `is.numeric(x) || is.integer(x)`.") expect_lint("is.numeric(x) || is.integer(x)", lint_msg, linter) @@ -44,7 +48,7 @@ test_that("is_numeric_linter blocks disallowed usages involving ||", { test_that("is_numeric_linter blocks disallowed usages involving %in%", { linter <- is_numeric_linter() - lint_msg <- rex::rex('same as class(x) %in% c("integer", "numeric")') + lint_msg <- rex::rex('Use is.numeric(x) instead of class(x) %in% c("integer", "numeric")') expect_lint("class(x) %in% c('integer', 'numeric')", lint_msg, linter) expect_lint('class(x) %in% c("numeric", "integer")', lint_msg, linter) @@ -54,7 +58,7 @@ test_that("raw strings are handled properly when testing in class", { skip_if_not_r_version("4.0.0") linter <- is_numeric_linter() - lint_msg <- rex::rex('same as class(x) %in% c("integer", "numeric")') + lint_msg <- rex::rex('Use is.numeric(x) instead of class(x) %in% c("integer", "numeric")') expect_lint("class(x) %in% c(R'(numeric)', 'integer', 'factor')", NULL, linter) expect_lint("class(x) %in% c('numeric', R'--(integer)--', y)", NULL, linter) diff --git a/tests/testthat/test-knitr_formats.R b/tests/testthat/test-knitr_formats.R index 7ae3f63f7..1634199bd 100644 --- a/tests/testthat/test-knitr_formats.R +++ b/tests/testthat/test-knitr_formats.R @@ -2,8 +2,8 @@ regexes <- list( assign = rex::rex("Use <-, not =, for assignment."), local_var = rex::rex("local variable"), quotes = rex::rex("Only use double-quotes."), - trailing = rex::rex("Trailing blank lines are superfluous."), - trailws = rex::rex("Trailing whitespace is superfluous."), + trailing = rex::rex("Remove trailing blank lines."), + trailws = rex::rex("Remove trailing whitespace."), indent = rex::rex("Indentation should be") ) diff --git a/tests/testthat/test-namespace_linter.R b/tests/testthat/test-namespace_linter.R index fd3686fc8..9eb45cdc7 100644 --- a/tests/testthat/test-namespace_linter.R +++ b/tests/testthat/test-namespace_linter.R @@ -40,31 +40,31 @@ test_that("namespace_linter blocks disallowed usages", { expect_lint( "statts::sd(c(1,2,3))", - list(message = rex::rex("Package 'statts' is not installed.")), + rex::rex("Package 'statts' is not installed."), linter ) expect_lint( "stats::ssd(c(1,2,3))", - list(message = rex::rex("'ssd' is not exported from {stats}")), + rex::rex("'ssd' is not exported from {stats}"), linter ) expect_lint( "stats:::sd(c(1,2,3))", - list(message = rex::rex("'sd' is exported from {stats}. Use stats::sd instead.")), + rex::rex("Don't use `:::` to access sd, which is exported from stats."), linter ) expect_lint( "statts:::sd(c(1,2,3))", - list(message = rex::rex("Package 'statts' is not installed.")), + rex::rex("Package 'statts' is not installed."), linter ) expect_lint( "stats:::sdd(c(1,2,3))", - list(message = rex::rex("'sdd' does not exist in {stats}")), + rex::rex("'sdd' does not exist in {stats}"), linter ) diff --git a/tests/testthat/test-nzchar_linter.R b/tests/testthat/test-nzchar_linter.R index 4a3c65dca..1e6eb9260 100644 --- a/tests/testthat/test-nzchar_linter.R +++ b/tests/testthat/test-nzchar_linter.R @@ -25,15 +25,15 @@ test_that("nzchar_linter skips as appropriate for other nchar args", { # nzchar also has keepNA argument so a drop-in switch is easy expect_lint( "nchar(x, keepNA=TRUE) == 0", - rex::rex("Instead of comparing nchar(x) to 0"), + rex::rex("Use nzchar() instead of comparing nchar(x) to 0"), linter ) }) test_that("nzchar_linter blocks simple disallowed usages", { linter <- nzchar_linter() - lint_msg_quote <- rex::rex('Instead of comparing strings to "", use nzchar()') - lint_msg_nchar <- rex::rex("Instead of comparing nchar(x) to 0") + lint_msg_quote <- rex::rex('Use nzchar() instead of comparing strings to ""') + lint_msg_nchar <- rex::rex("Use nzchar() instead of comparing nchar(x) to 0") expect_lint("which(x == '')", lint_msg_quote, linter) expect_lint("any(nchar(x) >= 0)", lint_msg_nchar, linter) @@ -43,8 +43,8 @@ test_that("nzchar_linter blocks simple disallowed usages", { test_that("nzchar_linter skips comparison to '' in if/while statements", { linter <- nzchar_linter() - lint_msg_quote <- rex::rex('Instead of comparing strings to "", use nzchar()') - lint_msg_nchar <- rex::rex("Instead of comparing nchar(x) to 0") + lint_msg_quote <- rex::rex('Use nzchar() instead of comparing strings to ""') + lint_msg_nchar <- rex::rex("Use nzchar() instead of comparing nchar(x) to 0") # still lint nchar() comparisons expect_lint("if (nchar(x) > 0) TRUE", lint_msg_nchar, linter) @@ -66,8 +66,8 @@ test_that("multiple lints are generated correctly", { nchar(b) != 0 }"), list( - list(rex::rex('Instead of comparing strings to ""'), line_number = 2L), - list(rex::rex("Instead of comparing nchar(x) to 0"), line_number = 3L) + list(rex::rex('Use nzchar() instead of comparing strings to ""'), line_number = 2L), + list(rex::rex("Use nzchar() instead of comparing nchar(x) to 0."), line_number = 3L) ), nzchar_linter() ) diff --git a/tests/testthat/test-one_call_pipe_linter.R b/tests/testthat/test-one_call_pipe_linter.R index a24f3380b..5cd772c91 100644 --- a/tests/testthat/test-one_call_pipe_linter.R +++ b/tests/testthat/test-one_call_pipe_linter.R @@ -14,7 +14,7 @@ test_that("one_call_pipe_linter skips allowed usages", { test_that("one_call_pipe_linter blocks simple disallowed usages", { linter <- one_call_pipe_linter() - lint_msg <- rex::rex("Expressions with only a single call shouldn't use pipe %>%.") + lint_msg <- rex::rex("Avoid pipe %>% for expressions with only a single call.") expect_lint("x %>% foo()", lint_msg, linter) @@ -29,7 +29,7 @@ test_that("one_call_pipe_linter blocks simple disallowed usages", { test_that("one_call_pipe_linter skips data.table chains", { linter <- one_call_pipe_linter() - lint_msg <- rex::rex("Expressions with only a single call shouldn't use pipe %>%.") + lint_msg <- rex::rex("Avoid pipe %>% for expressions with only a single call.") expect_lint("DT[x > 5, sum(y), by = keys] %>% .[, .SD[1], by = key1]", NULL, linter) @@ -44,11 +44,11 @@ test_that("one_call_pipe_linter skips data.table chains", { test_that("one_call_pipe_linter treats all pipes equally", { linter <- one_call_pipe_linter() - lint_msg_part <- "Expressions with only a single call shouldn't use pipe " + lint_msg_part <- " for expressions with only a single call." expect_lint("foo %>% bar() %$% col", NULL, linter) - expect_lint("x %T>% foo()", rex::rex(lint_msg_part, "%T>%."), linter) - expect_lint("x %$%\n foo", rex::rex(lint_msg_part, "%$%."), linter) + expect_lint("x %T>% foo()", rex::rex("%T>%", lint_msg_part), linter) + expect_lint("x %$%\n foo", rex::rex("%$%", lint_msg_part), linter) expect_lint( 'data %>% filter(type == "console") %$% obscured_id %>% unique()', NULL, @@ -80,7 +80,7 @@ test_that("Native pipes are handled as well", { expect_lint( "x |> foo()", - rex::rex("Expressions with only a single call shouldn't use pipe |>."), + rex::rex("Avoid pipe |> for expressions with only a single call."), linter ) @@ -105,7 +105,7 @@ test_that("one_call_pipe_linter skips data.table chains with native pipe", { skip_if_not_r_version("4.3.0") linter <- one_call_pipe_linter() - lint_msg <- rex::rex("Expressions with only a single call shouldn't use pipe |>.") + lint_msg <- rex::rex("Avoid pipe |> for expressions with only a single call.") expect_lint("DT[x > 5, sum(y), by = keys] |> _[, .SD[1], by = key1]", NULL, linter) diff --git a/tests/testthat/test-paren_body_linter.R b/tests/testthat/test-paren_body_linter.R index 64e2522b3..dac02cae4 100644 --- a/tests/testthat/test-paren_body_linter.R +++ b/tests/testthat/test-paren_body_linter.R @@ -1,6 +1,6 @@ testthat::test_that("paren_body_linter returns correct lints", { linter <- paren_body_linter() - lint_msg <- "There should be a space between a right parenthesis and a body expression." + lint_msg <- rex::rex("Put a space between a right parenthesis and a body expression.") # No space after the closing parenthesis prompts a lint expect_lint("function()test", lint_msg, linter) @@ -49,29 +49,32 @@ testthat::test_that("paren_body_linter returns correct lints", { }) test_that("multi-line versions are caught", { + linter <- paren_body_linter() + lint_msg <- rex::rex("Put a space between a right parenthesis and a body expression.") + expect_lint( trim_some(" function(var )x "), - rex::rex("There should be a space between a right parenthesis and a body expression."), - paren_body_linter() + lint_msg, + linter ) expect_lint( trim_some(" if (cond )x "), - rex::rex("There should be a space between a right parenthesis and a body expression."), - paren_body_linter() + lint_msg, + linter ) expect_lint( trim_some(" while (cond )x "), - rex::rex("There should be a space between a right parenthesis and a body expression."), - paren_body_linter() + lint_msg, + linter ) skip_if_not_r_version("4.1.0") @@ -80,15 +83,15 @@ test_that("multi-line versions are caught", { \\(var )x "), - rex::rex("There should be a space between a right parenthesis and a body expression."), - paren_body_linter() + lint_msg, + linter ) }) test_that("function shorthand is handled", { skip_if_not_r_version("4.1.0") linter <- paren_body_linter() - lint_msg <- rex::rex("There should be a space between a right parenthesis and a body expression.") + lint_msg <- rex::rex("Put a space between a right parenthesis and a body expression.") expect_lint("\\()test", lint_msg, linter) }) diff --git a/tests/testthat/test-pipe-consistency-linter.R b/tests/testthat/test-pipe_consistency_linter.R similarity index 88% rename from tests/testthat/test-pipe-consistency-linter.R rename to tests/testthat/test-pipe_consistency_linter.R index 2406e9831..4a236b156 100644 --- a/tests/testthat/test-pipe-consistency-linter.R +++ b/tests/testthat/test-pipe_consistency_linter.R @@ -21,7 +21,7 @@ test_that("pipe_consistency skips allowed usage", { test_that("pipe_consistency lints inconsistent usage", { skip_if_not_r_version("4.1.0") linter <- pipe_consistency_linter() - expected_msg <- rex("Found 1 instances of %>% and 1 instances of |>. Stick to one pipe operator.") + expected_msg <- rex::rex("Stick to one pipe operator; found 1 instances of %>% and 1 instances of |>.") expect_lint( "1:3 |> mean() %>% as.character()", @@ -54,7 +54,7 @@ test_that("pipe_consistency lints inconsistent usage", { linter ) - expected_msg_multi <- rex("Found 1 instances of %>% and 2 instances of |>. Stick to one pipe operator.") + expected_msg_multi <- rex::rex("Stick to one pipe operator; found 1 instances of %>% and 2 instances of |>.") expect_lint( "1:3 |> sort() |> mean() %>% as.character()", list( @@ -71,7 +71,7 @@ test_that("pipe_consistency_linter works with |> argument", { skip_if_not_r_version("4.1.0") linter <- pipe_consistency_linter(pipe = "|>") - expected_message <- rex("Use the |> pipe operator instead of the %>% pipe operator.") + expected_message <- rex::rex("Use the |> pipe operator instead of the %>% pipe operator.") expect_lint( trim_some(" @@ -117,7 +117,7 @@ test_that("pipe_consistency_linter works with %>% argument", { skip_if_not_r_version("4.1.0") linter <- pipe_consistency_linter(pipe = "%>%") - expected_message <- rex("Use the %>% pipe operator instead of the |> pipe operator.") + expected_message <- rex::rex("Use the %>% pipe operator instead of the |> pipe operator.") expect_lint( "1:3 |> mean() |> as.character()", @@ -154,7 +154,7 @@ test_that("pipe_consistency_linter works with %>% argument", { test_that("pipe_consistency_linter works with other magrittr pipes", { skip_if_not_r_version("4.1.0") linter <- pipe_consistency_linter() - expected_message <- rex("Found 1 instances of %>% and 1 instances of |>. Stick to one pipe operator.") + expected_message <- rex::rex("Stick to one pipe operator; found 1 instances of %>% and 1 instances of |>.") expect_lint("1:3 %>% mean() %T% print()", NULL, linter) expect_lint( diff --git a/tests/testthat/test-pipe_continuation_linter.R b/tests/testthat/test-pipe_continuation_linter.R index 5f8fd4869..528f0c011 100644 --- a/tests/testthat/test-pipe_continuation_linter.R +++ b/tests/testthat/test-pipe_continuation_linter.R @@ -1,6 +1,6 @@ test_that("pipe-continuation correctly handles stand-alone expressions", { linter <- pipe_continuation_linter() - lint_msg <- rex::rex("`%>%` should always have a space before it and a new line after it,") + lint_msg <- rex::rex("Put a space before `%>%` and a new line after it,") # Expressions without pipes are ignored expect_lint("blah", NULL, linter) @@ -41,7 +41,7 @@ test_that("pipe-continuation correctly handles stand-alone expressions", { test_that("pipe-continuation linter correctly handles nesting", { linter <- pipe_continuation_linter() - lint_msg <- rex::rex("`%>%` should always have a space before it and a new line after it,") + lint_msg <- rex::rex("Put a space before `%>%` and a new line after it,") expect_lint( trim_some(" @@ -81,8 +81,8 @@ test_that("pipe-continuation linter handles native pipe", { skip_if_not_r_version("4.1.0") linter <- pipe_continuation_linter() - lint_msg_native <- rex::rex("`|>` should always have a space before it and a new line after it,") - lint_msg_magrittr <- rex::rex("`%>%` should always have a space before it and a new line after it,") + lint_msg_native <- rex::rex("Put a space before `|>` and a new line after it,") + lint_msg_magrittr <- rex::rex("Put a space before `%>%` and a new line after it,") expect_lint("foo |> bar() |> baz()", NULL, linter) expect_lint( @@ -201,7 +201,7 @@ local({ "Various pipes are linted correctly", expect_lint( sprintf("a %s b() %s\n c()", pipe1, pipe2), - rex::rex(sprintf("`%s` should always have a space before it", pipe2)), + rex::rex(sprintf("Put a space before `%s` and a new line after it", pipe2)), linter ), .cases = cases diff --git a/tests/testthat/test-pipe_return_linter.R b/tests/testthat/test-pipe_return_linter.R index 0c395d48b..417ab4f98 100644 --- a/tests/testthat/test-pipe_return_linter.R +++ b/tests/testthat/test-pipe_return_linter.R @@ -41,7 +41,7 @@ test_that("pipe_return_linter blocks simple disallowed usages", { ") expect_lint( lines, - rex::rex("Using return() as the final step of a magrittr pipeline"), + rex::rex("Avoid return() as the final step of a magrittr pipeline"), pipe_return_linter() ) }) diff --git a/tests/testthat/test-semicolon_linter.R b/tests/testthat/test-semicolon_linter.R index ea809df37..6cb5dd538 100644 --- a/tests/testthat/test-semicolon_linter.R +++ b/tests/testthat/test-semicolon_linter.R @@ -1,7 +1,7 @@ test_that("Lint all semicolons", { linter <- semicolon_linter() - trail_msg <- "Trailing semicolons are not needed." - comp_msg <- "Compound semicolons are discouraged. Replace them by a newline." + trail_msg <- rex::rex("Remove trailing semicolons.") + comp_msg <- rex::rex("Replace compound semicolons by a newline.") # No semicolon expect_lint("", NULL, linter) diff --git a/tests/testthat/test-seq_linter.R b/tests/testthat/test-seq_linter.R index f7a3446e9..d63ad2430 100644 --- a/tests/testthat/test-seq_linter.R +++ b/tests/testthat/test-seq_linter.R @@ -1,44 +1,44 @@ test_that("other : expressions are fine", { linter <- seq_linter() - expect_lint("function() { 1:10 }", NULL, linter) - expect_lint("function(x) { 2:length(x) }", NULL, linter) - expect_lint("function(x) { 1:(length(x) || 1) }", NULL, linter) + expect_lint("1:10", NULL, linter) + expect_lint("2:length(x)", NULL, linter) + expect_lint("1:(length(x) || 1)", NULL, linter) }) test_that("seq_len(...) or seq_along(...) expressions are fine", { linter <- seq_linter() - expect_lint("function(x) { seq_len(x) }", NULL, linter) - expect_lint("function(x) { seq_along(x) }", NULL, linter) + expect_lint("seq_len(x)", NULL, linter) + expect_lint("seq_along(x)", NULL, linter) - expect_lint("function(x) { seq(2, length(x)) }", NULL, linter) - expect_lint("function(x) { seq(length(x), 2) }", NULL, linter) + expect_lint("seq(2, length(x))", NULL, linter) + expect_lint("seq(length(x), 2)", NULL, linter) }) test_that("finds seq(...) expressions", { linter <- seq_linter() expect_lint( - "function(x) { seq(length(x)) }", - rex::rex("seq(length(...))", anything, "Use seq_along(...)"), + "seq(length(x))", + rex::rex("Use seq_along(...) instead of seq(length(...))"), linter ) expect_lint( - "function(x) { seq(nrow(x)) }", - rex::rex("seq(nrow(...))", anything, "Use seq_len(nrow(...))"), + "seq(nrow(x))", + rex::rex("Use seq_len(nrow(...)) instead of seq(nrow(...))"), linter ) expect_lint( - "function(x) { rev(seq(length(x))) }", - rex::rex("seq(length(...))", anything, "Use seq_along(...)"), + "rev(seq(length(x)))", + rex::rex("Use seq_along(...) instead of seq(length(...))"), linter ) expect_lint( - "function(x) { rev(seq(nrow(x))) }", - rex::rex("seq(nrow(...))", anything, "Use seq_len(nrow(...))"), + "rev(seq(nrow(x)))", + rex::rex("Use seq_len(nrow(...)) instead of seq(nrow(...))"), linter ) }) @@ -48,55 +48,55 @@ test_that("finds 1:length(...) expressions", { expect_lint( "function(x) { 1:length(x) }", - rex::rex("length(...)", anything, "Use seq_along"), + rex::rex("Use seq_along(...) instead of 1:length(...)"), linter ) expect_lint( "function(x) { 1:nrow(x) }", - rex::rex("nrow(...)", anything, "Use seq_len"), + rex::rex("Use seq_len(nrow(...)) instead of 1:nrow(...)"), linter ) expect_lint( "function(x) { 1:ncol(x) }", - rex::rex("ncol(...)", anything, "Use seq_len"), + rex::rex("Use seq_len(ncol(...)) instead of 1:ncol(...)"), linter ) expect_lint( "function(x) { 1:NROW(x) }", - rex::rex("NROW(...)", anything, "Use seq_len"), + rex::rex("Use seq_len(NROW(...)) instead of 1:NROW(...)"), linter ) expect_lint( "function(x) { 1:NCOL(x) }", - rex::rex("NCOL(...)", anything, "Use seq_len"), + rex::rex("Use seq_len(NCOL(...)) instead of 1:NCOL(...)"), linter ) expect_lint( "function(x) { 1:dim(x)[1L] }", - rex::rex("dim(...)", anything, "Use seq_len"), + rex::rex("Use seq_len(dim(...)[1L]) instead of 1:dim(...)[1L]"), linter ) expect_lint( "function(x) { 1L:dim(x)[[1]] }", - rex::rex("dim(...)", anything, "Use seq_len"), + rex::rex("Use seq_len", anything, "dim(...)"), linter ) expect_lint( "function(x) { mutate(x, .id = 1:n()) }", - rex::rex("n() is", anything, "Use seq_len"), + rex::rex("Use seq_len(n()) instead of 1:n(),"), linter ) expect_lint( "function(x) { x[, .id := 1:.N] }", - rex::rex(".N is", anything, "Use seq_len"), + rex::rex("Use seq_len(.N) instead of 1:.N,"), linter ) }) @@ -104,7 +104,7 @@ test_that("finds 1:length(...) expressions", { test_that("1L is also bad", { expect_lint( "function(x) { 1L:length(x) }", - rex::rex("1L:length(...)", anything, "Use seq_along"), + rex::rex("seq_along", anything, "1L:length(...)"), seq_linter() ) }) @@ -116,7 +116,7 @@ test_that("reverse seq is ok", { expect_lint( "function(x) { length(x):1 }", - rex::rex("length(...):1", anything, "Use rev(seq_along(...))"), + rex::rex("rev(seq_along(...))", anything, "length(...):1"), seq_linter() ) }) @@ -125,8 +125,8 @@ test_that("Message vectorization works for multiple lints", { expect_lint( "c(1:length(x), 1:nrow(y))", list( - rex::rex("1:length(...)", anything, "seq_along(...)"), - rex::rex("1:nrow(...)", anything, "seq_len(nrow(...))") + rex::rex("seq_along(...)", anything, "1:length(...)"), + rex::rex("seq_len(nrow(...))", anything, "1:nrow(...)") ), seq_linter() ) @@ -134,8 +134,8 @@ test_that("Message vectorization works for multiple lints", { expect_lint( "c(seq(length(x)), 1:nrow(y))", list( - rex::rex("seq(length(...))", anything, "seq_along(...)"), - rex::rex("1:nrow(...)", anything, "seq_len(nrow(...))") + rex::rex("seq_along(...)", anything, "seq(length(...))"), + rex::rex("seq_len(nrow(...))", anything, "1:nrow(...)") ), seq_linter() ) @@ -143,8 +143,8 @@ test_that("Message vectorization works for multiple lints", { expect_lint( "c(seq(length(x)), seq(nrow(y)))", list( - rex::rex("seq(length(...))", anything, "seq_along(...)"), - rex::rex("seq(nrow(...))", anything, "seq_len(nrow(...))") + rex::rex("seq_along(...)", anything, "seq(length(...))"), + rex::rex("seq_len(nrow(...))", anything, "seq(nrow(...))") ), seq_linter() ) @@ -152,8 +152,8 @@ test_that("Message vectorization works for multiple lints", { expect_lint( "c(1:NROW(x), seq(NCOL(y)))", list( - rex::rex("1:NROW(...)", anything, "seq_len(NROW(...)"), - rex::rex("seq(NCOL(...))", anything, "seq_len(NCOL(...))") + rex::rex("seq_len(NROW(...))", anything, "1:NROW(...)"), + rex::rex("seq_len(NCOL(...))", anything, "seq(NCOL(...))") ), seq_linter() ) diff --git a/tests/testthat/test-strings_as_factors_linter.R b/tests/testthat/test-strings_as_factors_linter.R index 725f98776..4c91a2910 100644 --- a/tests/testthat/test-strings_as_factors_linter.R +++ b/tests/testthat/test-strings_as_factors_linter.R @@ -21,7 +21,7 @@ test_that("strings_as_factors_linter skips allowed usages", { test_that("strings_as_factors_linter blocks simple disallowed usages", { linter <- strings_as_factors_linter() - lint_msg <- "This code relies on the default value of stringsAsFactors" + lint_msg <- "Supply an explicit value for stringsAsFactors for this code" expect_lint("data.frame('a')", lint_msg, linter) expect_lint("data.frame(c('a', 'b'))", lint_msg, linter) @@ -38,7 +38,7 @@ test_that("strings_as_factors_linter blocks simple disallowed usages", { test_that("strings_as_factors_linters catches rep(char) usages", { linter <- strings_as_factors_linter() - lint_msg <- "This code relies on the default value of stringsAsFactors" + lint_msg <- "Supply an explicit value for stringsAsFactors for this code" expect_lint("data.frame(rep('a', 10L))", lint_msg, linter) expect_lint("data.frame(rep(c('a', 'b'), 10L))", lint_msg, linter) @@ -52,7 +52,7 @@ test_that("strings_as_factors_linters catches rep(char) usages", { test_that("strings_as_factors_linter catches character(), as.character() usages", { linter <- strings_as_factors_linter() - lint_msg <- "This code relies on the default value of stringsAsFactors" + lint_msg <- "Supply an explicit value for stringsAsFactors for this code" expect_lint("data.frame(a = character())", lint_msg, linter) expect_lint("data.frame(a = character(1L))", lint_msg, linter) @@ -64,7 +64,7 @@ test_that("strings_as_factors_linter catches character(), as.character() usages" test_that("strings_as_factors_linter catches more functions with string output", { linter <- strings_as_factors_linter() - lint_msg <- "This code relies on the default value of stringsAsFactors" + lint_msg <- "Supply an explicit value for stringsAsFactors for this code" expect_lint("data.frame(a = paste(1, 2, 3))", lint_msg, linter) expect_lint("data.frame(a = sprintf('%d', 1:10))", lint_msg, linter) diff --git a/tests/testthat/test-todo_comment_linter.R b/tests/testthat/test-todo_comment_linter.R index 2d8abf520..5a8c8e98f 100644 --- a/tests/testthat/test-todo_comment_linter.R +++ b/tests/testthat/test-todo_comment_linter.R @@ -1,6 +1,6 @@ test_that("returns the correct linting", { linter <- todo_comment_linter(todo = c("todo", "fixme")) - lint_msg <- "TODO comments should be removed." + lint_msg <- rex::rex("Remove TODO comments.") expect_lint("a <- \"you#need#to#fixme\"", NULL, linter) expect_lint("# something todo", NULL, linter) diff --git a/tests/testthat/test-trailing_blank_lines_linter.R b/tests/testthat/test-trailing_blank_lines_linter.R index 7ec9229ca..5b6f89511 100644 --- a/tests/testthat/test-trailing_blank_lines_linter.R +++ b/tests/testthat/test-trailing_blank_lines_linter.R @@ -12,7 +12,7 @@ test_that("trailing_blank_lines_linter doesn't block allowed usages", { test_that("trailing_blank_lines_linter detects disallowed usages", { linter <- trailing_blank_lines_linter() - lint_msg <- rex::rex("Trailing blank lines are superfluous.") + lint_msg <- rex::rex("Remove trailing blank lines.") expect_lint("blah <- 1\n", lint_msg, linter) expect_lint("blah <- 1\n ", lint_msg, linter) @@ -27,7 +27,7 @@ test_that("trailing_blank_lines_linter detects disallowed usages", { expect_lint( file = tmp2, checks = list( - message = rex::rex("Missing terminal newline."), + message = rex::rex("Add a terminal newline."), line_number = 1L, column_number = 10L ), @@ -37,6 +37,7 @@ test_that("trailing_blank_lines_linter detects disallowed usages", { test_that("trailing_blank_lines_linter detects missing terminal newlines in Rmd/qmd docs", { linter <- trailing_blank_lines_linter() + lint_msg <- rex::rex("Add a terminal newline") tmp3 <- withr::local_tempfile(fileext = ".Rmd") cat( @@ -56,12 +57,8 @@ test_that("trailing_blank_lines_linter detects missing terminal newlines in Rmd/ ) expect_lint( file = tmp3, - checks = list( - message = rex::rex("Missing terminal newline."), - line_number = 10L, - # We can't get 4 here because the line is NA-masked in get_source_expressions(), so no line length info exists. - column_number = 1L - ), + # We can't get 4 here because the line is NA-masked in get_source_expressions(), so no line length info exists. + checks = list(lint_msg, line_number = 10L, column_number = 1L), linters = linter ) @@ -79,12 +76,8 @@ test_that("trailing_blank_lines_linter detects missing terminal newlines in Rmd/ ) expect_lint( file = tmp4, - checks = list( - message = rex::rex("Missing terminal newline."), - line_number = 5L, - # We can't get 4 here because the line is NA-masked in get_source_expressions(), so no line length info exists. - column_number = 1L - ), + # We can't get 4 here because the line is NA-masked in get_source_expressions(), so no line length info exists. + checks = list(lint_msg, line_number = 5L, column_number = 1L), linters = linter ) @@ -107,18 +100,15 @@ test_that("trailing_blank_lines_linter detects missing terminal newlines in Rmd/ ) expect_lint( file = tmp5, - checks = list( - message = rex::rex("Missing terminal newline."), - line_number = 10L, - # We can't get 4 here because the line is NA-masked in get_source_expressions(), so no line length info exists. - column_number = 1L - ), + # We can't get 4 here because the line is NA-masked in get_source_expressions(), so no line length info exists. + checks = list(lint_msg, line_number = 10L, column_number = 1L), linters = linter ) }) test_that("blank lines in knitr chunks produce lints", { linter <- trailing_blank_lines_linter() + lint_msg <- rex::rex("Remove trailing blank lines.") tmp6 <- withr::local_tempfile( fileext = ".Rmd", @@ -137,7 +127,7 @@ test_that("blank lines in knitr chunks produce lints", { expect_lint( file = tmp6, - checks = list(message = rex::rex("Trailing blank lines are superfluous."), line_number = 7L, column_number = 1L), + checks = list(lint_msg, line_number = 7L, column_number = 1L), linters = linter ) @@ -161,9 +151,9 @@ test_that("blank lines in knitr chunks produce lints", { expect_lint( file = tmp7, checks = list( - list(message = rex::rex("Trailing blank lines are superfluous."), line_number = 7L, column_number = 1L), - list(message = rex::rex("Trailing blank lines are superfluous."), line_number = 8L, column_number = 1L), - list(message = rex::rex("Trailing blank lines are superfluous."), line_number = 9L, column_number = 1L) + list(lint_msg, line_number = 7L, column_number = 1L), + list(lint_msg, line_number = 8L, column_number = 1L), + list(lint_msg, line_number = 9L, column_number = 1L) ), linters = linter ) diff --git a/tests/testthat/test-trailing_whitespace_linter.R b/tests/testthat/test-trailing_whitespace_linter.R index e9159d87a..329f5a24f 100644 --- a/tests/testthat/test-trailing_whitespace_linter.R +++ b/tests/testthat/test-trailing_whitespace_linter.R @@ -1,39 +1,37 @@ test_that("returns the correct linting", { linter <- trailing_whitespace_linter() + lint_msg <- rex::rex("Remove trailing whitespace.") expect_lint("blah", NULL, linter) expect_lint( "blah <- 1 ", - list(message = rex::rex("Trailing whitespace is superfluous."), column_number = 10L), + list(message = lint_msg, column_number = 10L), linter ) - expect_lint( - "blah <- 1 \n'hi'", - rex::rex("Trailing whitespace is superfluous."), - linter - ) + expect_lint("blah <- 1 \n'hi'", lint_msg, linter) expect_lint( "blah <- 1\n'hi'\na <- 2 ", - list(message = rex::rex("Trailing whitespace is superfluous."), line_number = 3L), + list(message = lint_msg, line_number = 3L), linter ) }) test_that("also handles completely empty lines per allow_empty_lines argument", { linter <- trailing_whitespace_linter() + lint_msg <- rex::rex("Remove trailing whitespace.") expect_lint( "blah <- 1\n \n'hi'\na <- 2", - list(message = rex::rex("Trailing whitespace is superfluous."), line_number = 2L), + list(message = lint_msg, line_number = 2L), linter ) expect_lint( "blah <- 1 ", - list(message = rex::rex("Trailing whitespace is superfluous."), column_number = 10L), + list(message = lint_msg, column_number = 10L), trailing_whitespace_linter(allow_empty_lines = TRUE) ) @@ -46,7 +44,7 @@ test_that("also handles completely empty lines per allow_empty_lines argument", test_that("also handles trailing whitespace in string constants", { linter <- trailing_whitespace_linter() - lint_msg <- rex::rex("Trailing whitespace is superfluous.") + lint_msg <- rex::rex("Remove trailing whitespace.") expect_lint("blah <- ' \n \n'", NULL, linter) # Don't exclude past the end of string diff --git a/tests/testthat/test-undesirable_function_linter.R b/tests/testthat/test-undesirable_function_linter.R index 6597904ea..c12cbf21b 100644 --- a/tests/testthat/test-undesirable_function_linter.R +++ b/tests/testthat/test-undesirable_function_linter.R @@ -1,7 +1,7 @@ test_that("linter returns correct linting", { linter <- undesirable_function_linter(fun = c(return = NA, log10 = "use log()")) - msg_return <- "Function \"return\" is undesirable.$" - msg_log10 <- "Function \"log10\" is undesirable. As an alternative, use log\\(\\)." + msg_return <- rex::rex('Avoid undesirable function "return".', end) + msg_log10 <- rex::rex('Avoid undesirable function "log10". As an alternative, use log().') expect_lint("x <- options()", NULL, linter) expect_lint("cat(\"Try to return\")", NULL, linter) diff --git a/tests/testthat/test-undesirable_operator_linter.R b/tests/testthat/test-undesirable_operator_linter.R index 9e98d40b1..35aa6c20b 100644 --- a/tests/testthat/test-undesirable_operator_linter.R +++ b/tests/testthat/test-undesirable_operator_linter.R @@ -1,7 +1,7 @@ test_that("linter returns correct linting", { linter <- undesirable_operator_linter(op = c("$" = "As an alternative, use the `[[` accessor.", "<<-" = NA)) - msg_assign <- rex::escape("Operator `<<-` is undesirable.") - msg_dollar <- rex::escape("Operator `$` is undesirable. As an alternative, use the `[[` accessor.") + msg_assign <- rex::escape("Avoid undesirable operator `<<-`.") + msg_dollar <- rex::escape("Avoid undesirable operator `$`. As an alternative, use the `[[` accessor.") expect_lint("x <- foo:::getObj()", NULL, linter) expect_lint("cat(\"10$\")", NULL, linter) @@ -20,20 +20,20 @@ test_that("linter returns correct linting", { test_that("undesirable_operator_linter handles '=' consistently", { linter <- undesirable_operator_linter(op = c("=" = "As an alternative, use '<-'")) - expect_lint("a = 2L", rex::rex("Operator `=` is undesirable."), linter) + expect_lint("a = 2L", rex::rex("Avoid undesirable operator `=`."), linter) expect_lint("lm(data = mtcars)", NULL, linter) expect_lint("function(a = 1) { }", NULL, linter) }) test_that("undesirable_operator_linter handles infixes correctly", { linter <- undesirable_operator_linter(list("%oo%" = NA)) - expect_lint("a %oo% b", rex::rex("Operator `%oo%` is undesirable"), linter) + expect_lint("a %oo% b", rex::rex("Avoid undesirable operator `%oo%`."), linter) expect_lint("a %00% b", NULL, linter) # somewhat special case: %% is in infix_metadata expect_lint( "foo(x %% y, x %/% y)", - rex::rex("Operator `%%` is undesirable"), + rex::rex("Avoid undesirable operator `%%`."), undesirable_operator_linter(list("%%" = NA)) ) }) @@ -42,9 +42,9 @@ test_that("undesirable_operator_linter vectorizes messages", { expect_lint( "x <<- c(pkg:::foo, bar %oo% baz)", list( - rex::rex("`<<-` is undesirable. It assigns"), - rex::rex("`:::` is undesirable. It accesses"), - rex::rex("`%oo%` is undesirable.", end) + rex::rex("Avoid undesirable operator `<<-`. It assigns"), + rex::rex("Avoid undesirable operator `:::`. It accesses"), + rex::rex("Avoid undesirable operator `%oo%`.", end) ), undesirable_operator_linter(modify_defaults(default_undesirable_operators, "%oo%" = NA)) ) diff --git a/tests/testthat/test-unnecessary_concatenation_linter.R b/tests/testthat/test-unnecessary_concatenation_linter.R index ba1e10078..e7af5f46b 100644 --- a/tests/testthat/test-unnecessary_concatenation_linter.R +++ b/tests/testthat/test-unnecessary_concatenation_linter.R @@ -12,8 +12,8 @@ test_that("unnecessary_concatenation_linter skips allowed usages", { test_that("unnecessary_concatenation_linter blocks disallowed usages", { linter <- unnecessary_concatenation_linter() - msg_c <- rex::escape('Unneeded concatenation of a constant. Remove the "c" call.') - msg_e <- rex::escape('Unneeded concatenation without arguments. Replace the "c" call by NULL') + msg_c <- rex::rex("Remove unnecessary c() of a constant.") + msg_e <- rex::rex("Replace unnecessary c() by NULL or, whenever possible, vector()") expect_lint( "c()", @@ -48,20 +48,15 @@ test_that("unnecessary_concatenation_linter blocks disallowed usages", { local({ pipes <- pipes(exclude = "%$%") linter <- unnecessary_concatenation_linter() + const_msg <- rex::rex("Remove unnecessary c() of a constant.") + no_arg_msg <- rex::rex("Replace unnecessary c() by NULL or, whenever possible, vector()") + patrick::with_parameters_test_that( "Correctly handles concatenation within magrittr pipes", { expect_lint(sprintf('"a" %s c("b")', pipe), NULL, linter) - expect_lint( - sprintf('"a" %s c()', pipe), - "Unneeded concatenation of a constant", - linter - ) - expect_lint( - sprintf('"a" %s list("b", c())', pipe), - "Unneeded concatenation without arguments", - linter - ) + expect_lint(sprintf('"a" %s c()', pipe), const_msg, linter) + expect_lint(sprintf('"a" %s list("b", c())', pipe), no_arg_msg, linter) }, pipe = pipes, .test_name = names(pipes) @@ -69,37 +64,35 @@ local({ }) test_that("symbolic expressions are allowed, except by request", { - expect_lint("c(alpha / 2)", NULL, unnecessary_concatenation_linter()) - expect_lint("c(paste0('.', 1:2))", NULL, unnecessary_concatenation_linter()) - expect_lint("c(DF[cond > 1, col])", NULL, unnecessary_concatenation_linter()) + linter <- unnecessary_concatenation_linter() + linter_strict <- unnecessary_concatenation_linter(allow_single_expression = FALSE) + message <- rex::rex("Remove unnecessary c() of a constant expression.") + + expect_lint("c(alpha / 2)", NULL, linter) + expect_lint("c(paste0('.', 1:2))", NULL, linter) + expect_lint("c(DF[cond > 1, col])", NULL, linter) # allow_single_expression = FALSE turns both into lints - linter <- unnecessary_concatenation_linter(allow_single_expression = FALSE) - message <- "Unneeded concatenation of a simple expression" - expect_lint("c(alpha / 2)", message, linter) - expect_lint("c(paste0('.', 1:2))", message, linter) - expect_lint("c(DF[cond > 1, col])", message, linter) + expect_lint("c(alpha / 2)", message, linter_strict) + expect_lint("c(paste0('.', 1:2))", message, linter_strict) + expect_lint("c(DF[cond > 1, col])", message, linter_strict) }) test_that("sequences with : are linted whenever a constant is involved", { linter <- unnecessary_concatenation_linter() - expect_lint("c(1:10)", "Unneeded concatenation of a constant", linter) - expect_lint("c(1:sum(x))", "Unneeded concatenation of a constant", linter) + linter_strict <- unnecessary_concatenation_linter(allow_single_expression = FALSE) + const_msg <- rex::rex("Remove unnecessary c() of a constant.") + expr_msg <- rex::rex("Remove unnecessary c() of a constant expression.") + + expect_lint("c(1:10)", const_msg, linter) + expect_lint("c(1:sum(x))", const_msg, linter) # this is slightly different if a,b are factors, in which case : does # something like interaction expect_lint("c(a:b)", NULL, linter) + expect_lint("c(a:b)", expr_msg, linter_strict) expect_lint("c(a:foo(b))", NULL, linter) - expect_lint( - "c(a:b)", - "Unneeded concatenation of a simple expression", - unnecessary_concatenation_linter(allow_single_expression = FALSE) - ) - expect_lint( - "c(a:foo(b))", - "Unneeded concatenation of a simple expression", - unnecessary_concatenation_linter(allow_single_expression = FALSE) - ) + expect_lint("c(a:foo(b))", expr_msg, linter_strict) }) test_that("c(...) does not lint under !allow_single_expression", { diff --git a/tests/testthat/test-unreachable_code_linter.R b/tests/testthat/test-unreachable_code_linter.R index 346a80513..57dd6b1a0 100644 --- a/tests/testthat/test-unreachable_code_linter.R +++ b/tests/testthat/test-unreachable_code_linter.R @@ -9,7 +9,7 @@ test_that("unreachable_code_linter works in simple function", { test_that("unreachable_code_linter works in sub expressions", { linter <- unreachable_code_linter() - msg <- rex::rex("Code and comments coming after a return() or stop()") + msg <- rex::rex("Remove code and comments coming after return() or stop()") lines <- trim_some(" foo <- function(bar) { @@ -106,7 +106,7 @@ test_that("unreachable_code_linter works in sub expressions", { test_that("unreachable_code_linter works with next and break in sub expressions", { linter <- unreachable_code_linter() - msg <- rex::rex("Code and comments coming after a `next` or `break`") + msg <- rex::rex("Remove code and comments coming after `next` or `break`") lines <- trim_some(" foo <- function(bar) { @@ -247,7 +247,7 @@ test_that("unreachable_code_linter identifies simple unreachable code", { lines, list( line_number = 3L, - message = rex::rex("Code and comments coming after a return() or stop()") + message = rex::rex("Remove code and comments coming after return() or stop()") ), unreachable_code_linter() ) @@ -263,13 +263,13 @@ test_that("unreachable_code_linter finds unreachable comments", { ") expect_lint( lines, - rex::rex("Code and comments coming after a return() or stop()"), + rex::rex("Remove code and comments coming after return() or stop()"), unreachable_code_linter() ) }) test_that("unreachable_code_linter finds expressions in the same line", { - msg <- rex::rex("Code and comments coming after a return() or stop()") + msg <- rex::rex("Remove code and comments coming after return() or stop()") linter <- unreachable_code_linter() lines <- trim_some(" @@ -297,7 +297,7 @@ test_that("unreachable_code_linter finds expressions in the same line", { }) test_that("unreachable_code_linter finds expressions and comments after comment in return line", { - msg <- rex::rex("Code and comments coming after a return() or stop()") + msg <- rex::rex("Remove code and comments coming after return() or stop()") linter <- unreachable_code_linter() lines <- trim_some(" @@ -326,7 +326,7 @@ test_that("unreachable_code_linter finds a double return", { ") expect_lint( lines, - rex::rex("Code and comments coming after a return() or stop()"), + rex::rex("Remove code and comments coming after return() or stop()"), unreachable_code_linter() ) }) @@ -341,7 +341,7 @@ test_that("unreachable_code_linter finds code after stop()", { ") expect_lint( lines, - rex::rex("Code and comments coming after a return() or stop()"), + rex::rex("Remove code and comments coming after return() or stop()"), unreachable_code_linter() ) }) @@ -412,7 +412,7 @@ test_that("unreachable_code_linter ignores terminal nolint end comments", { test_that("unreachable_code_linter identifies unreachable code in conditional loops", { linter <- unreachable_code_linter() - msg <- rex::rex("Code inside a conditional loop with a deterministically false condition should be removed.") + msg <- rex::rex("Remove code inside a conditional loop with a deterministically false condition.") lines <- trim_some(" foo <- function(bar) { @@ -493,7 +493,7 @@ test_that("unreachable_code_linter identifies unreachable code in conditional lo test_that("unreachable_code_linter identifies unreachable code in conditional loops", { linter <- unreachable_code_linter() - msg <- rex::rex("Code inside an else block after a deterministically true if condition should be removed.") + msg <- rex::rex("Remove code inside an else block after a deterministically true condition.") lines <- trim_some(" foo <- function(bar) { @@ -530,8 +530,8 @@ test_that("unreachable_code_linter identifies unreachable code in conditional lo test_that("unreachable_code_linter identifies unreachable code in mixed conditional loops", { linter <- unreachable_code_linter() - false_msg <- rex::rex("Code inside a conditional loop with a deterministically false condition should be removed.") - true_msg <- rex::rex("Code inside an else block after a deterministically true if condition should be removed.") + false_msg <- rex::rex("Remove code inside a conditional loop with a deterministically false condition.") + true_msg <- rex::rex("Remove code inside an else block after a deterministically true condition.") expect_lint( trim_some(" @@ -554,7 +554,7 @@ test_that("unreachable_code_linter identifies unreachable code in mixed conditio list(false_msg, line_number = 2L), list(false_msg, line_number = 5L), list(true_msg, line_number = 10L), - list(rex::rex("Code and comments coming after a return() or stop() should be removed."), line_number = 13L) + list(rex::rex("Remove code and comments coming after return() or stop()."), line_number = 13L) ), linter ) @@ -564,7 +564,7 @@ test_that("unreachable_code_linter identifies unreachable code in mixed conditio list( list(false_msg, line_number = 1L, ranges = list(c(1L, 49L))), list( - rex::rex("Code inside an else block after a deterministically true if condition should be removed."), + rex::rex("Remove code inside an else block after a deterministically true condition."), line_number = 1L, ranges = list(c(45L, 49L)) ) @@ -585,7 +585,7 @@ test_that("function shorthand is handled", { "), list( line_number = 3L, - message = rex::rex("Code and comments coming after a return() or stop()") + message = rex::rex("Remove code and comments coming after return() or stop()") ), unreachable_code_linter() ) diff --git a/tests/testthat/test-unused_import_linter.R b/tests/testthat/test-unused_import_linter.R index bb48a2cca..4db47fe81 100644 --- a/tests/testthat/test-unused_import_linter.R +++ b/tests/testthat/test-unused_import_linter.R @@ -18,7 +18,7 @@ test_that("unused_import_linter lints as expected", { expect_lint("library(dplyr, character.only = TRUE)\n1 + 1", NULL, linter) lint_msg <- rex::rex("Package 'dplyr' is attached but never used") - msg_ns <- rex::rex("Package 'dplyr' is only used by namespace") + msg_ns <- rex::rex("Don't attach package 'dplyr', which is only used by namespace.") expect_lint("library(dplyr)\n1 + 1", lint_msg, linter) expect_lint("require(dplyr)\n1 + 1", lint_msg, linter) @@ -43,7 +43,7 @@ test_that("unused_import_linter handles message vectorization", { "), list( rex::rex("Package 'crayon' is attached but never used."), - rex::rex("Package 'xmlparsedata' is only used by namespace") + rex::rex("Don't attach package 'xmlparsedata', which is only used by namespace") ), unused_import_linter() ) diff --git a/tests/testthat/test-yoda_test_linter.R b/tests/testthat/test-yoda_test_linter.R index 2cd48fc03..a49b966d5 100644 --- a/tests/testthat/test-yoda_test_linter.R +++ b/tests/testthat/test-yoda_test_linter.R @@ -1,40 +1,31 @@ test_that("yoda_test_linter skips allowed usages", { - expect_lint("expect_equal(x, 2)", NULL, yoda_test_linter()) + linter <- yoda_test_linter() + + expect_lint("expect_equal(x, 2)", NULL, linter) # namespace qualification doesn't matter - expect_lint("testthat::expect_identical(x, 'a')", NULL, yoda_test_linter()) + expect_lint("testthat::expect_identical(x, 'a')", NULL, linter) # two variables can't be distinguished which is expected/actual (without # playing quixotic games trying to parse that out from variable names) - expect_lint("expect_equal(x, y)", NULL, yoda_test_linter()) + expect_lint("expect_equal(x, y)", NULL, linter) }) test_that("yoda_test_linter blocks simple disallowed usages", { - expect_lint( - "expect_equal(2, x)", - rex::rex("Tests should compare objects in the order 'actual', 'expected'"), - yoda_test_linter() - ) - expect_lint( - "testthat::expect_identical('a', x)", - rex::rex("Tests should compare objects in the order 'actual', 'expected'"), - yoda_test_linter() - ) - expect_lint( - "expect_setequal(2, x)", - rex::rex("Tests should compare objects in the order 'actual', 'expected'"), - yoda_test_linter() - ) + linter <- yoda_test_linter() + lint_msg <- rex::rex("Compare objects in tests in the order 'actual', 'expected', not the reverse.") + + expect_lint("expect_equal(2, x)", lint_msg, linter) + expect_lint("testthat::expect_identical('a', x)", lint_msg, linter) + expect_lint("expect_setequal(2, x)", lint_msg, linter) # complex literals are slightly odd - expect_lint( - "expect_equal(2 + 1i, x)", - rex::rex("Tests should compare objects in the order 'actual', 'expected'"), - yoda_test_linter() - ) + expect_lint("expect_equal(2 + 1i, x)", lint_msg, linter) }) test_that("yoda_test_linter ignores strings in $ expressions", { + linter <- yoda_test_linter() + # 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()) - expect_lint('expect_equal(x@"key", 2)', NULL, yoda_test_linter()) + expect_lint('expect_equal(x$"key", 2)', NULL, linter) + expect_lint('expect_equal(x@"key", 2)', NULL, linter) }) # if we only inspect the first argument & ignore context, get false positives