diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index c08976976..3494d4549 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -34,6 +34,30 @@ writeLines( ), expect_lint_file ) + +# Ensure the fuzzed contents are always visible to facilitate backing out which fuzzed content is at issue +contents <- readLines(expect_lint_file) +wrong_number_def_idx <- grep('wrong_number_fmt <- "got %d lints instead of %d%s"', contents, fixed = TRUE) +wrong_number_use_idx <- grep("sprintf(wrong_number_fmt,", contents, fixed = TRUE) +if ( + length(wrong_number_def_idx) != 1L || + length(wrong_number_use_idx) == 0L || + # these lines should be self-contained & have no comments + !all(endsWith(contents[wrong_number_use_idx], ")")) || + inherits(tryCatch(parse(text = contents[wrong_number_use_idx]), error = identity), "error") +) { + stop(sprintf( + "Please update this workflow -- need wrong_number_fmt to be easily replaced in file '%s'.", + expect_lint_file + )) +} + +contents[wrong_number_def_idx] <- + 'wrong_number_fmt <- "got %d lints instead of %d%s\\nFile contents:\\n%s"' +contents[wrong_number_use_idx] <- + gsub("\\)$", ", readChar(file, file.size(file)))", contents[wrong_number_use_idx]) +writeLines(contents, expect_lint_file) + # Not useful in CI but good when running locally. withr::defer({ writeLines(original, expect_lint_file) @@ -116,7 +140,8 @@ failures <- reporter$failures$as_list() valid_failure <- vapply( failures, function(failure) { - if (grepl("(column_number|ranges|line) .* did not match", failure$message)) { + # line_number is for the comment injection fuzzer, which adds newlines. + if (grepl("(column_number|ranges|line|line_number) .* did not match", failure$message)) { return(TRUE) } FALSE diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index d13dd57b8..6862e768c 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -9,7 +9,7 @@ maybe_fuzz_content <- function(file, lines) { file.copy(file, new_file, copy.mode = FALSE) } - apply_fuzzers(new_file, list(function_lambda_fuzzer, pipe_fuzzer, dollar_at_fuzzer)) + apply_fuzzers(new_file, list(function_lambda_fuzzer, pipe_fuzzer, dollar_at_fuzzer, comment_injection_fuzzer)) new_file } @@ -59,6 +59,34 @@ dollar_at_fuzzer <- simple_swap_fuzzer( replacements = c("$", "@") ) +comment_injection_fuzzer <- function(pd, lines) { + # injecting comment before a call often structurally breaks parsing + # (SYMBOL_FUNCTION_CALL-->SYMBOL), so avoid + terminal_token_idx <- which(pd$terminal & !pd$token %in% c("COMMENT", "SYMBOL_FUNCTION_CALL", "SLOT")) + # formula is messy because it's very easy to break parsing, but not easy to exclude the right + # elements from the pd data.frame (easier with XPath ancestor axis). Just skip for now. + if (any(pd$token == "'~'")) { + return(invisible()) + } + injection_count <- sample(0:length(terminal_token_idx), 1L) + + if (injection_count == 0L) { + return(invisible()) + } + + terminal_token_idx <- sort(sample(terminal_token_idx, injection_count)) + + for (ii in rev(terminal_token_idx)) { + line <- lines[pd$line2[ii]] + lines[pd$line2[ii]] <- paste0( + substr(line, 1L, pd$col2[ii]), + " # INJECTED COMMENT\n", + substr(line, pd$col2[ii] + 1L, nchar(line)) + ) + } + lines +} + # we could also consider just passing any test where no fuzzing takes place, # i.e. letting the other GHA handle whether unfuzzed tests pass as expected. apply_fuzzers <- function(f, fuzzers) { diff --git a/NEWS.md b/NEWS.md index 7bd7fb234..17cb1d16c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -48,6 +48,38 @@ * `object_usage_linter()` lints missing packages that may cause false positives (#2872, @AshesITR) * New argument `include_s4_slots` for the `xml_find_function_calls()` entry in the `get_source_expressions()` to govern whether calls of the form `s4Obj@fun()` are included in the result (#2820, @MichaelChirico). * `sprintf_linter()` lints `sprintf()` and `gettextf()` calls when a constant string is passed to `fmt` (#2894, @Bisaloo). +* General handling of logic around where comments can appear in code has been improved (#2822, @MichaelChirico). In many cases, this is a tiny robustness fix for weird edge cases unlikely to be found in practice, but in others, this improves practical linter precision (reduced false positives and/or false negatives). The affected linters (with annotations for changes noteworthy enough to have gotten a dedicated bug) are: + + `brace_linter()` + + `coalesce_linter()` + + `comparison_negation_linter()` #2826 + + `conjunct_test_linter()` #2827 + + `empty_assignment_linter()` + + `expect_comparison_linter()` + + `fixed_regex_linter()` #2827 + + `if_switch_linter()` + + `ifelse_censor_linter()` #2826 + + `implicit_assignment_linter()` + + `length_test_linter()` + + `literal_coercion_linter()` #2824 + + `matrix_apply_linter()` #2825 + + `nzchar_linter()` #2826 + + `object_length_linter()` #2827 + + `object_name_linter()` #2827 + + `object_usage_linter()` + + `outer_negation_linter()` #2827 + + `redundant_equals_linter()` + + `regex_subset_linter()` + + `seq_linter()` + + `sort_linter()` + + `sprintf_linter()` #2827 + + `string_boundary_linter()` + + `strings_as_factors_linter()` + + `unnecessary_concatenation_linter()` #2827 + + `unnecessary_lambda_linter()` #2827 + + `unnecessary_nesting_linter()` #2827 + + `unnecessary_placeholder_linter()` + + `unreachable_code_linter()` #2827 + + `vector_logic_linter()` #2826 ### New linters diff --git a/R/brace_linter.R b/R/brace_linter.R index e20f974f8..7d2c1a892 100644 --- a/R/brace_linter.R +++ b/R/brace_linter.R @@ -134,7 +134,7 @@ brace_linter <- function(allow_single_line = FALSE, { xp_cond_closed } and ( (@line1 = preceding-sibling::*[1][not(self::OP-LEFT-BRACE)]/@line2) - or (@line1 = parent::expr/following-sibling::*[1][not(self::ELSE)]/@line1) + or (@line1 = parent::expr/following-sibling::*[not(self::COMMENT)][1][not(self::ELSE)]/@line1) ) ]") diff --git a/R/coalesce_linter.R b/R/coalesce_linter.R index befa1636b..2cb0f5333 100644 --- a/R/coalesce_linter.R +++ b/R/coalesce_linter.R @@ -46,7 +46,7 @@ coalesce_linter <- function() { braced_expr_cond <- "expr[1][OP-LEFT-BRACE and count(*) = 3]/expr" xpath <- glue(" - parent::expr[ + expr[expr[ preceding-sibling::IF and ( expr[2] = following-sibling::ELSE/following-sibling::expr @@ -54,25 +54,25 @@ coalesce_linter <- function() { or expr[2][LEFT_ASSIGN]/expr[1] = following-sibling::ELSE/following-sibling::expr or expr[2][LEFT_ASSIGN]/expr[1] = following-sibling::ELSE/following-sibling::{braced_expr_cond} ) - ] - /parent::expr + ]] | - parent::expr[ - preceding-sibling::OP-EXCLAMATION - and parent::expr/preceding-sibling::IF + self::*[expr[ + preceding-sibling::IF + and OP-EXCLAMATION and ( - expr[2] = parent::expr/following-sibling::expr[1] - or expr[2] = parent::expr/following-sibling::{braced_expr_cond} - or expr[2][LEFT_ASSIGN]/expr[1] = parent::expr/following-sibling::expr[1] - or expr[2][LEFT_ASSIGN]/expr[1] = parent::expr/following-sibling::{braced_expr_cond} + expr/expr[2] = following-sibling::expr[1] + or expr/expr[2] = following-sibling::{braced_expr_cond} + or expr/expr[2][LEFT_ASSIGN]/expr[1] = following-sibling::expr[1] + or expr/expr[2][LEFT_ASSIGN]/expr[1] = following-sibling::{braced_expr_cond} ) - ] - /parent::expr - /parent::expr + ]] ") Linter(linter_level = "expression", function(source_expression) { - null_calls <- source_expression$xml_find_function_calls("is.null") + null_calls <- xml_parent(xml_parent(xml_parent( + source_expression$xml_find_function_calls("is.null") + ))) + null_calls <- strip_comments_from_subtree(null_calls) bad_expr <- xml_find_all(null_calls, xpath) is_negation <- !is.na(xml_find_first(bad_expr, "expr/OP-EXCLAMATION")) observed <- ifelse(is_negation, "if (!is.null(x)) x else y", "if (is.null(x)) y else x") diff --git a/R/empty_assignment_linter.R b/R/empty_assignment_linter.R index 2ea602763..e5bd8aecf 100644 --- a/R/empty_assignment_linter.R +++ b/R/empty_assignment_linter.R @@ -33,7 +33,7 @@ empty_assignment_linter <- make_linter_from_xpath( # for some reason, the parent in the `=` case is , not , hence parent::expr xpath = " - //OP-LEFT-BRACE[following-sibling::*[1][self::OP-RIGHT-BRACE]] + //OP-LEFT-BRACE[following-sibling::*[not(self::COMMENT)][1][self::OP-RIGHT-BRACE]] /parent::expr[ preceding-sibling::LEFT_ASSIGN or preceding-sibling::EQ_ASSIGN diff --git a/R/expect_comparison_linter.R b/R/expect_comparison_linter.R index 6f8b35577..fdd8b1911 100644 --- a/R/expect_comparison_linter.R +++ b/R/expect_comparison_linter.R @@ -65,7 +65,7 @@ expect_comparison_linter <- function() { xml_calls <- source_expression$xml_find_function_calls("expect_true") bad_expr <- xml_find_all(xml_calls, xpath) - comparator <- xml_find_chr(bad_expr, "string(expr[2]/*[2])") + comparator <- xml_find_chr(bad_expr, "string(expr[2]/*[not(self::COMMENT)][2])") expectation <- comparator_expectation_map[comparator] lint_message <- sprintf("%s(x, y) is better than expect_true(x %s y).", expectation, comparator) xml_nodes_to_lints(bad_expr, source_expression, lint_message = lint_message, type = "warning") diff --git a/R/if_switch_linter.R b/R/if_switch_linter.R index eaaa66d57..3cd4e6653 100644 --- a/R/if_switch_linter.R +++ b/R/if_switch_linter.R @@ -191,8 +191,6 @@ if_switch_linter <- function(max_branch_lines = 0L, max_branch_expressions = 0L) # NB: IF AND {...} AND ELSE/... implies >= 3 equality conditions are present # .//expr/IF/...: the expr in `==` that's _not_ the STR_CONST # not(preceding::IF): prevent nested matches which might be incorrect globally - # not(. != .): don't match if there are _any_ expr which _don't_ match the top - # expr if_xpath <- glue(" //IF /parent::expr[ @@ -203,21 +201,28 @@ if_switch_linter <- function(max_branch_lines = 0L, max_branch_expressions = 0L) and {equal_str_cond} and ELSE/following-sibling::expr[IF and {equal_str_cond}] ] - and not( - .//expr/IF/following-sibling::{equal_str_cond}/expr[not(STR_CONST)] - != expr[1][EQ]/expr[not(STR_CONST)] - ) and not({ max_lines_cond }) ] ") + # not(. != .): don't match if there are _any_ expr which _don't_ match the top expr + # do this as a second step to + equality_test_cond <- glue("self::*[ + .//expr/IF/following-sibling::{equal_str_cond}/expr[not(STR_CONST)] + != expr[1][EQ]/expr[not(STR_CONST)] + ]") + Linter(linter_level = "expression", function(source_expression) { xml <- source_expression$xml_parsed_content bad_expr <- xml_find_all(xml, if_xpath) + expr_all_equal <- is.na(xml_find_first( + strip_comments_from_subtree(bad_expr), + equality_test_cond + )) lints <- xml_nodes_to_lints( - bad_expr, + bad_expr[expr_all_equal], source_expression = source_expression, lint_message = paste( "Prefer switch() statements over repeated if/else equality tests,", diff --git a/R/implicit_assignment_linter.R b/R/implicit_assignment_linter.R index 70dfd3376..d2c18ac0f 100644 --- a/R/implicit_assignment_linter.R +++ b/R/implicit_assignment_linter.R @@ -82,7 +82,7 @@ implicit_assignment_linter <- function(except = c("bquote", "expression", "expr" xpath <- glue(" ({assignments}) /parent::expr[ - preceding-sibling::*[2][self::IF or self::WHILE] + preceding-sibling::*[not(self::COMMENT)][2][self::IF or self::WHILE] or parent::forcond or preceding-sibling::expr/{xpath_exceptions} or parent::expr/*[1][self::OP-LEFT-PAREN] @@ -94,7 +94,7 @@ implicit_assignment_linter <- function(except = c("bquote", "expression", "expr" } if (allow_scoped) { # force 2nd preceding to ensure we're in the loop condition, not the loop expression - in_branch_cond <- "ancestor::expr[preceding-sibling::*[2][self::IF or self::WHILE]]" + in_branch_cond <- "ancestor::expr[preceding-sibling::*[not(self::COMMENT)][2][self::IF or self::WHILE]]" xpath <- paste0( xpath, # _if_ we're in an IF/WHILE branch, lint if the assigned SYMBOL appears anywhere later on. diff --git a/R/length_test_linter.R b/R/length_test_linter.R index 1a984ef66..4524a6866 100644 --- a/R/length_test_linter.R +++ b/R/length_test_linter.R @@ -28,8 +28,13 @@ length_test_linter <- function() { Linter(linter_level = "expression", function(source_expression) { xml_calls <- source_expression$xml_find_function_calls("length") bad_expr <- xml_find_all(xml_calls, xpath) + bad_expr <- strip_comments_from_subtree(bad_expr) - expr_parts <- vapply(lapply(bad_expr, xml_find_all, "expr[2]/*"), xml_text, character(3L)) + expr_parts <- vapply( + lapply(bad_expr, xml_find_all, "expr[2]/*[not(self::COMMENT)]"), + xml_text, + character(3L) + ) lint_message <- sprintf( "Checking the length of a logical vector is likely a mistake. Did you mean `length(%s) %s %s`?", expr_parts[1L, ], expr_parts[2L, ], expr_parts[3L, ] diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R index be2b95922..e707fd482 100644 --- a/R/object_usage_linter.R +++ b/R/object_usage_linter.R @@ -61,13 +61,21 @@ object_usage_linter <- function(interpret_glue = NULL, interpret_extensions = c( # NB: the repeated expr[2][FUNCTION] XPath has no performance impact, so the different direct assignment XPaths are # split for better readability, see PR#1197 # TODO(#1106): use //[...] to capture assignments in more scopes - xpath_function_assignment <- " - expr[LEFT_ASSIGN or EQ_ASSIGN]/expr[2][FUNCTION or OP-LAMBDA] - | expr_or_assign_or_help[EQ_ASSIGN]/expr[2][FUNCTION or OP-LAMBDA] - | equal_assign[EQ_ASSIGN]/expr[2][FUNCTION or OP-LAMBDA] - | //SYMBOL_FUNCTION_CALL[text() = 'assign']/parent::expr/following-sibling::expr[2][FUNCTION or OP-LAMBDA] - | //SYMBOL_FUNCTION_CALL[text() = 'setMethod']/parent::expr/following-sibling::expr[3][FUNCTION or OP-LAMBDA] - " + fun_node <- "FUNCTION or OP-LAMBDA" + xpath_function_assignment <- glue(" + expr[LEFT_ASSIGN or EQ_ASSIGN]/expr[2][{fun_node}] + | expr_or_assign_or_help[EQ_ASSIGN]/expr[2][{fun_node}] + | equal_assign[EQ_ASSIGN]/expr[2][{fun_node}] + | //SYMBOL_FUNCTION_CALL[text() = 'assign']/parent::expr/following-sibling::expr[2][{fun_node}] + | //SYMBOL_FUNCTION_CALL[text() = 'setMethod']/parent::expr/following-sibling::expr[3][{fun_node}] + ") + + # code like:content + # foo <- \ #comment + # (x) x + # is technically valid, but won't parse unless the lambda is in a bigger expression (here '<-'). + # the same doesn't apply to 'function'. + xpath_unsafe_lambda <- "OP-LAMBDA[@line1 = following-sibling::*[1][self::COMMENT]/@line1]" # not all instances of linted symbols are potential sources for the observed violations -- see #1914 symbol_exclude_cond <- "preceding-sibling::OP-DOLLAR or preceding-sibling::OP-AT or ancestor::expr[OP-TILDE]" @@ -100,7 +108,9 @@ object_usage_linter <- function(interpret_glue = NULL, interpret_extensions = c( fun_assignments <- xml_find_all(xml, xpath_function_assignment) lapply(fun_assignments, function(fun_assignment) { - code <- get_content(lines = source_expression$content, fun_assignment) + # this will mess with the source line numbers. but I don't think anybody cares. + known_safe <- is.na(xml_find_first(fun_assignment, xpath_unsafe_lambda)) + code <- get_content(lines = source_expression$content, fun_assignment, known_safe = known_safe) fun <- try_silently(eval( envir = env, parse( @@ -190,8 +200,8 @@ get_assignment_symbols <- function(xml) { expr[RIGHT_ASSIGN]/expr[2]/SYMBOL[1] | equal_assign/expr[1]/SYMBOL[1] | expr_or_assign_or_help/expr[1]/SYMBOL[1] | - expr[expr[1][SYMBOL_FUNCTION_CALL/text()='assign']]/expr[2]/* | - expr[expr[1][SYMBOL_FUNCTION_CALL/text()='setMethod']]/expr[2]/* + expr[expr[1][SYMBOL_FUNCTION_CALL/text() = 'assign']]/expr[2]/* | + expr[expr[1][SYMBOL_FUNCTION_CALL/text() = 'setMethod']]/expr[2]/* " )) } diff --git a/R/redundant_equals_linter.R b/R/redundant_equals_linter.R index d986dc184..232deea71 100644 --- a/R/redundant_equals_linter.R +++ b/R/redundant_equals_linter.R @@ -58,7 +58,7 @@ redundant_equals_linter <- function() { xml <- source_expression$xml_parsed_content bad_expr <- xml_find_all(xml, xpath) - op <- xml_text(xml_find_first(bad_expr, "*[2]")) + op <- xml_text(xml_find_first(bad_expr, "*[not(self::COMMENT)][2]")) xml_nodes_to_lints( bad_expr, diff --git a/R/regex_subset_linter.R b/R/regex_subset_linter.R index bf55b4827..7dcbc698a 100644 --- a/R/regex_subset_linter.R +++ b/R/regex_subset_linter.R @@ -47,25 +47,23 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export regex_subset_linter <- function() { - # parent::expr for LEFT_ASSIGN and RIGHT_ASSIGN, but, strangely, - # parent::equal_assign for EQ_ASSIGN. So just use * as a catchall. - # See https://www.w3.org/TR/1999/REC-xpath-19991116/#booleans; - # equality of nodes is based on the string value of the nodes, which - # is basically what we need, i.e., whatever expression comes in - # [grepl(pattern, )] matches exactly, e.g. names(x)[grepl(ptn, names(x))]. xpath_fmt <- " - parent::expr[ - parent::expr[ + self::*[ + not(LEFT_ASSIGN or EQ_ASSIGN or RIGHT_ASSIGN) + ] + /expr[ OP-LEFT-BRACKET - and not(parent::*[LEFT_ASSIGN or EQ_ASSIGN or RIGHT_ASSIGN]) + and expr[1] = expr/expr[position() = {arg_pos} ] ] - and expr[position() = {arg_pos} ] = parent::expr/expr[1] - ]" + " grep_xpath <- glue(xpath_fmt, arg_pos = 3L) stringr_xpath <- glue(xpath_fmt, arg_pos = 2L) Linter(linter_level = "expression", function(source_expression) { - grep_calls <- source_expression$xml_find_function_calls(c("grepl", "grep")) + grep_calls <- xml_parent(xml_parent(xml_parent( + source_expression$xml_find_function_calls(c("grepl", "grep")) + ))) + grep_calls <- strip_comments_from_subtree(grep_calls) grep_expr <- xml_find_all(grep_calls, grep_xpath) grep_lints <- xml_nodes_to_lints( @@ -78,7 +76,10 @@ regex_subset_linter <- function() { type = "warning" ) - stringr_calls <- source_expression$xml_find_function_calls(c("str_detect", "str_which")) + stringr_calls <- xml_parent(xml_parent(xml_parent( + source_expression$xml_find_function_calls(c("str_detect", "str_which")) + ))) + stringr_calls <- strip_comments_from_subtree(stringr_calls) stringr_expr <- xml_find_all(stringr_calls, stringr_xpath) stringr_lints <- xml_nodes_to_lints( diff --git a/R/seq_linter.R b/R/seq_linter.R index c55e661f5..04d7d96ea 100644 --- a/R/seq_linter.R +++ b/R/seq_linter.R @@ -126,6 +126,7 @@ seq_linter <- function() { xml_find_all(seq_calls, seq_xpath), xml_find_all(xml, colon_xpath) ) + seq_expr <- strip_comments_from_subtree(seq_expr) dot_expr1 <- get_fun(seq_expr, 1L) dot_expr2 <- get_fun(seq_expr, 2L) diff --git a/R/sort_linter.R b/R/sort_linter.R index aa66ece89..2a0e6fa08 100644 --- a/R/sort_linter.R +++ b/R/sort_linter.R @@ -69,26 +69,24 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export sort_linter <- function() { - non_keyword_arg <- "expr[not(preceding-sibling::*[1][self::EQ_SUB])]" + # NB: assumes COMMENTs stripped + non_keyword_arg <- "expr[position() > 1 and not(preceding-sibling::*[1][self::EQ_SUB])]" order_xpath <- glue(" - //OP-LEFT-BRACKET + self::expr[ + expr[1] = expr/{non_keyword_arg} + ] + /OP-LEFT-BRACKET /following-sibling::expr[1][ - expr[1][ - SYMBOL_FUNCTION_CALL[text() = 'order'] - and count(following-sibling::{non_keyword_arg}) = 1 - and following-sibling::{non_keyword_arg} = - parent::expr[1]/parent::expr[1]/expr[1] - ] + count({non_keyword_arg}) = 1 ] ") sorted_xpath <- " - parent::expr[not(SYMBOL_SUB)] - /parent::expr[ - (EQ or NE) - and expr/expr = expr - ] - " + self::*[ + (EQ or NE) + and expr/expr = expr + and not(expr/EQ_SUB) + ]" arguments_xpath <- @@ -97,9 +95,11 @@ sort_linter <- function() { arg_values_xpath <- glue("{arguments_xpath}/following-sibling::expr[1]") Linter(linter_level = "expression", function(source_expression) { - xml <- source_expression$xml_parsed_content + order_calls <- strip_comments_from_subtree(xml_parent(xml_parent( + source_expression$xml_find_function_calls("order") + ))) - order_expr <- xml_find_all(xml, order_xpath) + order_expr <- xml_find_all(order_calls, order_xpath) variable <- xml_text(xml_find_first( order_expr, @@ -132,8 +132,9 @@ sort_linter <- function() { type = "warning" ) - xml_calls <- source_expression$xml_find_function_calls("sort") - sorted_expr <- xml_find_all(xml_calls, sorted_xpath) + sort_calls <- xml_parent(xml_parent(source_expression$xml_find_function_calls("sort"))) + sort_calls <- strip_comments_from_subtree(sort_calls) + sorted_expr <- xml_find_all(sort_calls, sorted_xpath) sorted_op <- xml_text(xml_find_first(sorted_expr, "*[2]")) lint_message <- ifelse( diff --git a/R/source_utils.R b/R/source_utils.R index a9014fb63..fc07430f9 100644 --- a/R/source_utils.R +++ b/R/source_utils.R @@ -34,6 +34,13 @@ build_xml_find_function_calls <- function(xml) { res <- function_call_cache[include_function_idx] } } + if (include_s4_slots) { + if (is.null(function_names)) { + res <- combine_nodesets(function_call_cache, s4_slot_cache) + } else { + res <- combine_nodesets(function_call_cache, s4_slot_cache[names(s4_slot_cache) %in% function_names]) + } + } if (keep_names) res else unname(res) } } diff --git a/R/string_boundary_linter.R b/R/string_boundary_linter.R index aaaa67f2d..536556085 100644 --- a/R/string_boundary_linter.R +++ b/R/string_boundary_linter.R @@ -116,25 +116,18 @@ string_boundary_linter <- function(allow_grepl = FALSE) { list(lint_expr = expr[should_lint], lint_type = lint_type) } + string_comparison_xpath <- "self::*[(EQ or NE) and expr/STR_CONST]" substr_xpath <- glue(" - (//EQ | //NE) - /parent::expr[ - expr[STR_CONST] - and expr[ - expr[1][SYMBOL_FUNCTION_CALL[text() = 'substr' or text() = 'substring']] - and expr[ - ( - position() = 3 - and NUM_CONST[text() = '1' or text() = '1L'] - ) or ( - position() = 4 - and expr[1][SYMBOL_FUNCTION_CALL[text() = 'nchar']] - and expr[position() = 2] = preceding-sibling::expr[2] - ) - ] - ] - ] - ") + self::*[expr/expr[ + ( + position() = 3 + and NUM_CONST[text() = '1' or text() = '1L'] + ) or ( + position() = 4 + and expr[1][SYMBOL_FUNCTION_CALL[text() = 'nchar']] + and expr[position() = 2] = preceding-sibling::expr[2] + ) + ]]") substr_arg2_xpath <- "string(./expr[expr[1][SYMBOL_FUNCTION_CALL]]/expr[3])" @@ -168,7 +161,12 @@ string_boundary_linter <- function(allow_grepl = FALSE) { )) } - substr_expr <- xml_find_all(xml, substr_xpath) + substr_calls <- xml_parent(xml_parent( + source_expression$xml_find_function_calls(c("substr", "substring")) + )) + is_str_comparison <- !is.na(xml_find_first(substr_calls, string_comparison_xpath)) + substr_calls <- strip_comments_from_subtree(substr_calls[is_str_comparison]) + substr_expr <- xml_find_all(substr_calls, substr_xpath) substr_one <- xml_find_chr(substr_expr, substr_arg2_xpath) %in% c("1", "1L") substr_lint_message <- paste( ifelse( diff --git a/R/strings_as_factors_linter.R b/R/strings_as_factors_linter.R index 6c8ef3f46..0e33419c3 100644 --- a/R/strings_as_factors_linter.R +++ b/R/strings_as_factors_linter.R @@ -66,7 +66,7 @@ strings_as_factors_linter <- local({ parent::expr[ expr[ ( - STR_CONST[not(following-sibling::*[1][self::EQ_SUB])] + STR_CONST[not(following-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])] or ( {c_combine_strings} ) or expr[1][ SYMBOL_FUNCTION_CALL[text() = 'rep'] @@ -74,7 +74,7 @@ strings_as_factors_linter <- local({ ] or expr[1][SYMBOL_FUNCTION_CALL[ {xp_text_in_table(known_character_funs)} ]] ) - and not(preceding-sibling::*[2][self::SYMBOL_SUB and text() = 'row.names']) + and not(preceding-sibling::*[not(self::COMMENT)][2][self::SYMBOL_SUB and text() = 'row.names']) ] and not(SYMBOL_SUB[text() = 'stringsAsFactors']) ]") diff --git a/R/unnecessary_placeholder_linter.R b/R/unnecessary_placeholder_linter.R index c032fc591..d270dfb72 100644 --- a/R/unnecessary_placeholder_linter.R +++ b/R/unnecessary_placeholder_linter.R @@ -45,7 +45,7 @@ unnecessary_placeholder_linter <- function() { ] /expr[2][ SYMBOL[text() = '.'] - and not(preceding-sibling::*[1][self::EQ_SUB]) + and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]) ] ") diff --git a/R/unreachable_code_linter.R b/R/unreachable_code_linter.R index f2e9f8d56..acfdda2d2 100644 --- a/R/unreachable_code_linter.R +++ b/R/unreachable_code_linter.R @@ -76,33 +76,55 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclude_end", "# nocov end")) { + # nolint next: object_usage_linter. Used in glue() in statically-difficult fashion to detect. expr_after_control <- " (//REPEAT | //ELSE | //FOR)/following-sibling::expr[1] | (//IF | //WHILE)/following-sibling::expr[2] " + + unreachable_expr_cond_ws <- " + following-sibling::*[ + not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON or self::ELSE or preceding-sibling::ELSE) + and (not(self::COMMENT) or @line2 > preceding-sibling::*[not(self::COMMENT)][1]/@line2) + ][1]" + # when a semicolon is present, the condition is a bit different due to nodes + unreachable_expr_cond_sc <- " + parent::exprlist[OP-SEMICOLON] + /following-sibling::*[ + not(self::OP-RIGHT-BRACE) + and (not(self::COMMENT) or @line1 > preceding-sibling::exprlist/expr/@line2) + ][1] + " + # NB: use not(OP-DOLLAR) to prevent matching process$stop(), #1051 - xpath_return_stop <- glue(" + xpath_return_stop_fmt <- " ( {expr_after_control} - | (//FUNCTION | //OP-LAMBDA)[following-sibling::expr[1]/*[1][self::OP-LEFT-BRACE]]/following-sibling::expr[1] + | + (//FUNCTION | //OP-LAMBDA) + /following-sibling::expr[OP-LEFT-BRACE][last()] ) - /expr[expr[1][ + //expr[expr[1][ not(OP-DOLLAR or OP-AT) and SYMBOL_FUNCTION_CALL[text() = 'return' or text() = 'stop'] ]] - /following-sibling::*[ - not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON) - and (not(self::COMMENT) or @line2 > preceding-sibling::*[1]/@line2) - ][1] - ") - xpath_next_break <- glue(" + /{unreachable_expr_cond} + " + xpath_return_stop <- paste( + glue(xpath_return_stop_fmt, unreachable_expr_cond = unreachable_expr_cond_ws), + glue(xpath_return_stop_fmt, unreachable_expr_cond = unreachable_expr_cond_sc), + sep = " | " + ) + xpath_next_break_fmt <- " ({expr_after_control}) - /expr[NEXT or BREAK] - /following-sibling::*[ - not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON) - and (not(self::COMMENT) or @line2 > preceding-sibling::*[1]/@line2) - ][1] - ") + //expr[NEXT or BREAK] + /{unreachable_expr_cond} + " + xpath_next_break <- paste( + glue(xpath_next_break_fmt, unreachable_expr_cond = unreachable_expr_cond_ws), + glue(xpath_next_break_fmt, unreachable_expr_cond = unreachable_expr_cond_sc), + sep = " | " + ) xpath_if_while <- " (//WHILE | //IF)[following-sibling::expr[1]/NUM_CONST[text() = 'FALSE']] diff --git a/R/utils.R b/R/utils.R index 09c97152b..51f36a9d6 100644 --- a/R/utils.R +++ b/R/utils.R @@ -85,20 +85,20 @@ names2 <- function(x) { names(x) %||% rep("", length(x)) } -get_content <- function(lines, info) { +get_content <- function(lines, info, known_safe = TRUE) { lines[is.na(lines)] <- "" if (!missing(info)) { + # put in data.frame-like format if (is_node(info)) { - info <- lapply(stats::setNames(nm = c("col1", "col2", "line1", "line2")), function(attr) { - as.integer(xml_attr(info, attr)) - }) + info <- lapply(xml2::xml_attrs(info), as.integer) } lines <- lines[seq(info$line1, info$line2)] lines[length(lines)] <- substr(lines[length(lines)], 1L, info$col2) lines[1L] <- substr(lines[1L], info$col1, nchar(lines[1L])) } + if (!known_safe) lines <- c("{", lines, "}") paste(lines, collapse = "\n") } diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index 5c8d685f4..d2c6bcebe 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -66,7 +66,7 @@ test_that("arguments handle <<- and ->/->> correctly", { ) }) -test_that("arguments handle trailing assignment operators correctly", { +test_that("arguments handle trailing assignment operators correctly", { # nofuzz linter_default <- assignment_linter() linter_no_trailing <- assignment_linter(allow_trailing = FALSE) expect_no_lint("x <- y", linter_no_trailing) @@ -165,7 +165,7 @@ test_that("arguments handle trailing assignment operators correctly", { ) }) -test_that("allow_trailing interacts correctly with comments in braced expressions", { +test_that("allow_trailing interacts correctly with comments in braced expressions", { # nofuzz linter <- assignment_linter(allow_trailing = FALSE) expect_no_lint( trim_some(" diff --git a/tests/testthat/test-brace_linter.R b/tests/testthat/test-brace_linter.R index 9d2052f92..b645f240b 100644 --- a/tests/testthat/test-brace_linter.R +++ b/tests/testthat/test-brace_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("brace_linter lints braces correctly", { open_curly_msg <- rex::rex( "Opening curly braces should never go on their own line" @@ -119,6 +120,22 @@ test_that("brace_linter lints braces correctly", { linter ) + # a comment after '}' is allowed + expect_no_lint( + trim_some(" + switch( + x, + 'a' = do_something(x), + 'b' = do_another(x), + { + do_first(x) + do_second(x) + } # comment + ) + "), + brace_linter() + ) + expect_no_lint( trim_some(" fun( @@ -650,3 +667,4 @@ test_that("test_that(code=) requires braces", { linter ) }) +# nofuzz end diff --git a/tests/testthat/test-coalesce_linter.R b/tests/testthat/test-coalesce_linter.R index 434bdd7bd..e25cb7a52 100644 --- a/tests/testthat/test-coalesce_linter.R +++ b/tests/testthat/test-coalesce_linter.R @@ -35,6 +35,16 @@ test_that("coalesce_linter blocks simple disallowed usage", { expect_lint("if (!is.null(x[1])) x[1] else y", lint_msg_not, linter) expect_lint("if (!is.null(foo(x))) foo(x) else y", lint_msg_not, linter) + + # adversarial comments + expect_lint( + trim_some(" + if (!is.null(x[1])) x[ # comment + 1] else y + "), + lint_msg_not, + linter + ) }) test_that("coalesce_linter blocks usage with implicit assignment", { diff --git a/tests/testthat/test-commas_linter.R b/tests/testthat/test-commas_linter.R index fb8a4e4f3..8ef94955b 100644 --- a/tests/testthat/test-commas_linter.R +++ b/tests/testthat/test-commas_linter.R @@ -1,14 +1,15 @@ +# nofuzz start test_that("returns the correct linting (with default parameters)", { linter <- commas_linter() 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) - expect_lint("fun(1,\n 1)", NULL, linter) - expect_lint("fun(1,\n1)", NULL, linter) - expect_lint("fun(1\n,\n1)", NULL, linter) - expect_lint("fun(1\n ,\n1)", NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint("fun(1, 1)", linter) + expect_no_lint("fun(1,\n 1)", linter) + expect_no_lint("fun(1,\n1)", linter) + expect_no_lint("fun(1\n,\n1)", linter) + expect_no_lint("fun(1\n ,\n1)", linter) expect_lint("fun(1\n,1)", msg_after, linter) expect_lint("fun(1,1)", msg_after, linter) @@ -25,14 +26,14 @@ test_that("returns the correct linting (with default parameters)", { linter ) - expect_lint("\"fun(1 ,1)\"", NULL, linter) - expect_lint("a[1, , 2]", NULL, linter) - expect_lint("a[1, , 2, , 3]", NULL, linter) + expect_no_lint('"fun(1 ,1)"', linter) + expect_no_lint("a[1, , 2]", linter) + expect_no_lint("a[1, , 2, , 3]", linter) - expect_lint("switch(op, x = foo, y = bar)", NULL, linter) - expect_lint("switch(op, x = , y = bar)", NULL, linter) - expect_lint("switch(op, \"x\" = , y = bar)", NULL, linter) - expect_lint("switch(op, x = ,\ny = bar)", NULL, linter) + expect_no_lint("switch(op, x = foo, y = bar)", linter) + expect_no_lint("switch(op, x = , y = bar)", linter) + expect_no_lint('switch(op, "x" = , y = bar)', linter) + expect_no_lint("switch(op, x = ,\ny = bar)", linter) expect_lint("switch(op, x = foo , y = bar)", msg_before, linter) expect_lint("switch(op, x = foo , y = bar)", msg_before, linter) @@ -55,8 +56,8 @@ test_that("returns the correct linting (with default parameters)", { expect_lint( "fun(op ,bar)", list( - list(message = msg_before, column_number = 7L, ranges = list(c(7L, 10L))), - list(message = msg_after, column_number = 12L, ranges = list(c(12L, 12L))) + list(msg_before, column_number = 7L, ranges = list(c(7L, 10L))), + list(msg_after, column_number = 12L, ranges = list(c(12L, 12L))) ), linter ) @@ -67,14 +68,14 @@ test_that("returns the correct linting (with 'allow_trailing' set)", { 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) - expect_lint("fun(1,\n 1)", NULL, linter) - expect_lint("fun(1,\n1)", NULL, linter) - expect_lint("fun(1\n,\n1)", NULL, linter) - expect_lint("fun(1\n ,\n1)", NULL, linter) - expect_lint("a[1,]", NULL, linter) - expect_lint("a(1,)", NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint("fun(1, 1)", linter) + expect_no_lint("fun(1,\n 1)", linter) + expect_no_lint("fun(1,\n1)", linter) + expect_no_lint("fun(1\n,\n1)", linter) + expect_no_lint("fun(1\n ,\n1)", linter) + expect_no_lint("a[1,]", linter) + expect_no_lint("a(1,)", linter) expect_lint("fun(1\n,1)", msg_after, linter) expect_lint("fun(1,1)", msg_after, linter) @@ -88,15 +89,15 @@ test_that("returns the correct linting (with 'allow_trailing' set)", { linter ) - expect_lint("\"fun(1 ,1)\"", NULL, linter) - expect_lint("a[1, , 2]", NULL, linter) - expect_lint("a[1, , 2, , 3]", NULL, linter) - expect_lint("a[[1,]]", NULL, linter) + expect_no_lint('"fun(1 ,1)"', linter) + expect_no_lint("a[1, , 2]", linter) + expect_no_lint("a[1, , 2, , 3]", linter) + expect_no_lint("a[[1,]]", linter) - expect_lint("switch(op, x = foo, y = bar)", NULL, linter) - expect_lint("switch(op, x = , y = bar)", NULL, linter) - expect_lint("switch(op, \"x\" = , y = bar)", NULL, linter) - expect_lint("switch(op, x = ,\ny = bar)", NULL, linter) + expect_no_lint("switch(op, x = foo, y = bar)", linter) + expect_no_lint("switch(op, x = , y = bar)", linter) + expect_no_lint('switch(op, "x" = , y = bar)', linter) + expect_no_lint("switch(op, x = ,\ny = bar)", linter) expect_lint("switch(op, x = foo , y = bar)", msg_before, linter) expect_lint("switch(op, x = foo , y = bar)", msg_before, linter) @@ -107,9 +108,10 @@ test_that("returns the correct linting (with 'allow_trailing' set)", { expect_lint( "fun(op ,bar)", list( - list(message = msg_before, column_number = 7L, ranges = list(c(7L, 10L))), - list(message = msg_after, column_number = 12L, ranges = list(c(12L, 12L))) + list(msg_before, column_number = 7L, ranges = list(c(7L, 10L))), + list(msg_after, column_number = 12L, ranges = list(c(12L, 12L))) ), linter ) }) +# nofuzz end diff --git a/tests/testthat/test-empty_assignment_linter.R b/tests/testthat/test-empty_assignment_linter.R index 8bf39b34a..a2b7e50f6 100644 --- a/tests/testthat/test-empty_assignment_linter.R +++ b/tests/testthat/test-empty_assignment_linter.R @@ -1,9 +1,11 @@ test_that("empty_assignment_linter skips valid usage", { - expect_lint("x <- { 3 + 4 }", NULL, empty_assignment_linter()) - expect_lint("x <- if (x > 1) { 3 + 4 }", NULL, empty_assignment_linter()) + linter <- empty_assignment_linter() + + expect_no_lint("x <- { 3 + 4 }", linter) + expect_no_lint("x <- if (x > 1) { 3 + 4 }", linter) # also triggers assignment_linter - expect_lint("x = { 3 + 4 }", NULL, empty_assignment_linter()) + expect_no_lint("x = { 3 + 4 }", linter) }) test_that("empty_assignment_linter blocks disallowed usages", { @@ -24,6 +26,7 @@ test_that("empty_assignment_linter blocks disallowed usages", { # newlines also don't matter expect_lint("x <- {\n}", lint_msg, linter) + expect_lint("x <- { # comment\n}", lint_msg, linter) # LHS of assignment doesn't matter expect_lint("env$obj <- {}", lint_msg, linter) diff --git a/tests/testthat/test-expect_comparison_linter.R b/tests/testthat/test-expect_comparison_linter.R index cf1a349aa..adcab53e1 100644 --- a/tests/testthat/test-expect_comparison_linter.R +++ b/tests/testthat/test-expect_comparison_linter.R @@ -2,18 +2,18 @@ test_that("expect_comparison_linter skips allowed usages", { linter <- expect_comparison_linter() # there's no expect_ne() for this operator - expect_lint("expect_true(x != y)", NULL, linter) + expect_no_lint("expect_true(x != y)", linter) # NB: also applies to tinytest, but it's sufficient to test testthat - expect_lint("testthat::expect_true(x != y)", NULL, linter) + expect_no_lint("testthat::expect_true(x != y)", linter) # multiple comparisons are OK - expect_lint("expect_true(x > y || x > z)", NULL, linter) + expect_no_lint("expect_true(x > y || x > z)", linter) # expect_gt() and friends don't have an info= argument - expect_lint("expect_true(x > y, info = 'x is bigger than y yo')", NULL, linter) + expect_no_lint("expect_true(x > y, info = 'x is bigger than y yo')", linter) # expect_true() used incorrectly, and as executed the first argument is not a lint - expect_lint("expect_true(is.count(n_draws), n_draws > 1)", NULL, linter) + expect_no_lint("expect_true(is.count(n_draws), n_draws > 1)", linter) }) test_that("expect_comparison_linter blocks simple disallowed usages", { @@ -49,6 +49,15 @@ test_that("expect_comparison_linter blocks simple disallowed usages", { rex::rex("expect_identical(x, y) is better than expect_true(x == y)."), linter ) + + expect_lint( + trim_some(" + expect_true(x # comment + == (y == 2)) + "), + rex::rex("expect_identical(x, y) is better than expect_true(x == y)."), + expect_comparison_linter() + ) }) test_that("lints vectorize", { diff --git a/tests/testthat/test-function_left_parentheses_linter.R b/tests/testthat/test-function_left_parentheses_linter.R index e45b1b7b0..d9343364d 100644 --- a/tests/testthat/test-function_left_parentheses_linter.R +++ b/tests/testthat/test-function_left_parentheses_linter.R @@ -7,7 +7,7 @@ test_that("function_left_parentheses_linter skips allowed usages", { expect_no_lint("base::print(blah)", linter) expect_no_lint('base::"print"(blah)', linter) expect_no_lint("base::print(blah, fun(1))", linter) - expect_no_lint("blah <- function(blah) { }", linter) + expect_no_lint("blah <- function(blah) { }", linter) # nofuzz expect_no_lint("(1 + 1)", linter) expect_no_lint("( (1 + 1) )", linter) expect_no_lint("if (blah) { }", linter) @@ -18,9 +18,9 @@ test_that("function_left_parentheses_linter skips allowed usages", { expect_no_lint("c(1, 2, 3)[(2 - 1)]", linter) expect_no_lint("list(1, 2, 3)[[(2 - 1)]]", linter) expect_no_lint("range(10)[(2 - 1):(10 - 1)]", linter) - expect_no_lint("function(){function(){}}()()", linter) - expect_no_lint("c(function(){})[1]()", linter) - expect_no_lint("function(x) (mean(x) + 3)", linter) + expect_no_lint("function(){function(){}}()()", linter) # nofuzz + expect_no_lint("c(function(){})[1]()", linter) # nofuzz + expect_no_lint("function(x) (mean(x) + 3)", linter) # nofuzz expect_no_lint('"blah (1)"', linter) }) @@ -197,7 +197,7 @@ test_that("newline in character string doesn't trigger false positive (#1963)", ) }) -test_that("shorthand functions are handled", { +test_that("shorthand functions are handled", { # nofuzz skip_if_not_r_version("4.1.0") linter <- function_left_parentheses_linter() fun_lint_msg <- rex::rex("Remove spaces before the left parenthesis in a function definition.") diff --git a/tests/testthat/test-if_switch_linter.R b/tests/testthat/test-if_switch_linter.R index e6b3e5fe5..867473413 100644 --- a/tests/testthat/test-if_switch_linter.R +++ b/tests/testthat/test-if_switch_linter.R @@ -2,23 +2,23 @@ test_that("if_switch_linter skips allowed usages", { linter <- if_switch_linter() # don't apply to simple if/else statements - expect_lint("if (x == 'a') 1 else 2", NULL, linter) + expect_no_lint("if (x == 'a') 1 else 2", linter) # don't apply to non-character conditions # (NB: switch _could_ be used for integral input, but this # interface is IMO a bit clunky / opaque) - expect_lint("if (x == 1) 1 else 2", NULL, linter) + expect_no_lint("if (x == 1) 1 else 2", linter) # this also has a switch equivalent, but we don't both handling such # complicated cases - expect_lint("if (x == 'a') 1 else if (x != 'b') 2 else 3", NULL, linter) + expect_no_lint("if (x == 'a') 1 else if (x != 'b') 2 else 3", linter) # multiple variables involved --> no clean change - expect_lint("if (x == 'a') 1 else if (y == 'b') 2 else 3", NULL, linter) + expect_no_lint("if (x == 'a') 1 else if (y == 'b') 2 else 3", linter) # multiple conditions --> no clean change - expect_lint("if (is.character(x) && x == 'a') 1 else if (x == 'b') 2 else 3", NULL, linter) + expect_no_lint("if (is.character(x) && x == 'a') 1 else if (x == 'b') 2 else 3", linter) # simple cases with two conditions might be more natural # without switch(); require at least three branches to trigger a lint - expect_lint("if (x == 'a') 1 else if (x == 'b') 2", NULL, linter) + expect_no_lint("if (x == 'a') 1 else if (x == 'b') 2", linter) # still no third if() clause - expect_lint("if (x == 'a') 1 else if (x == 'b') 2 else 3", NULL, linter) + expect_no_lint("if (x == 'a') 1 else if (x == 'b') 2 else 3", linter) }) test_that("if_switch_linter blocks simple disallowed usages", { @@ -29,6 +29,15 @@ test_that("if_switch_linter blocks simple disallowed usages", { expect_lint("if (x == 'a') 1 else if (x == 'b') 2 else if (x == 'c') 3", lint_msg, linter) # expressions are also OK expect_lint("if (foo(x) == 'a') 1 else if (foo(x) == 'b') 2 else if (foo(x) == 'c') 3", lint_msg, linter) + # including when comments are present + expect_lint( + trim_some(" + if (foo(x) == 'a') 1 else if (foo(x # comment + ) == 'b') 2 else if (foo(x) == 'c') 3 + "), + lint_msg, + linter + ) }) test_that("if_switch_linter handles further nested if/else correctly", { @@ -43,9 +52,8 @@ test_that("if_switch_linter handles further nested if/else correctly", { # related to previous test -- if the first condition is non-`==`, the # whole if/else chain is "tainted" / non-switch()-recommended. # (technically, switch can work here, but the semantics are opaque) - expect_lint( + expect_no_lint( "if (x %in% c('a', 'e', 'f')) 1 else if (x == 'b') 2 else if (x == 'c') 3 else if (x == 'd') 4", - NULL, linter ) }) @@ -78,7 +86,7 @@ test_that("multiple lints have right metadata", { ) }) -test_that("max_branch_lines= and max_branch_expressions= arguments work", { +test_that("max_branch_lines= and max_branch_expressions= arguments work", { # nofuzz max_lines2_linter <- if_switch_linter(max_branch_lines = 2L) max_lines4_linter <- if_switch_linter(max_branch_lines = 4L) max_expr2_linter <- if_switch_linter(max_branch_expressions = 2L) @@ -131,9 +139,9 @@ test_that("max_branch_lines= and max_branch_expressions= arguments work", { 9 } ") - expect_lint(three_per_branch_lines, NULL, max_lines2_linter) + expect_no_lint(three_per_branch_lines, max_lines2_linter) expect_lint(three_per_branch_lines, lint_msg, max_lines4_linter) - expect_lint(three_per_branch_lines, NULL, max_expr2_linter) + expect_no_lint(three_per_branch_lines, max_expr2_linter) expect_lint(three_per_branch_lines, lint_msg, max_expr4_linter) five_per_branch_lines <- trim_some(" @@ -157,10 +165,10 @@ test_that("max_branch_lines= and max_branch_expressions= arguments work", { 15 } ") - expect_lint(five_per_branch_lines, NULL, max_lines2_linter) - expect_lint(five_per_branch_lines, NULL, max_lines4_linter) - expect_lint(five_per_branch_lines, NULL, max_expr2_linter) - expect_lint(five_per_branch_lines, NULL, max_expr4_linter) + expect_no_lint(five_per_branch_lines, max_lines2_linter) + expect_no_lint(five_per_branch_lines, max_lines4_linter) + expect_no_lint(five_per_branch_lines, max_expr2_linter) + expect_no_lint(five_per_branch_lines, max_expr4_linter) five_lines_three_expr_lines <- trim_some(" if (x == 'a') { @@ -183,9 +191,9 @@ test_that("max_branch_lines= and max_branch_expressions= arguments work", { ) } ") - expect_lint(five_lines_three_expr_lines, NULL, max_lines2_linter) - expect_lint(five_lines_three_expr_lines, NULL, max_lines4_linter) - expect_lint(five_lines_three_expr_lines, NULL, max_expr2_linter) + expect_no_lint(five_lines_three_expr_lines, max_lines2_linter) + expect_no_lint(five_lines_three_expr_lines, max_lines4_linter) + expect_no_lint(five_lines_three_expr_lines, max_expr2_linter) expect_lint( five_lines_three_expr_lines, list(lint_msg, line_number = 1L), @@ -207,17 +215,17 @@ test_that("max_branch_lines= and max_branch_expressions= arguments work", { 13; 14; 15 } ") - expect_lint(five_expr_three_lines_lines, NULL, max_lines2_linter) + expect_no_lint(five_expr_three_lines_lines, max_lines2_linter) expect_lint( five_expr_three_lines_lines, list(lint_msg, line_number = 1L), max_lines4_linter ) - expect_lint(five_expr_three_lines_lines, NULL, max_expr2_linter) - expect_lint(five_expr_three_lines_lines, NULL, max_expr4_linter) + expect_no_lint(five_expr_three_lines_lines, max_expr2_linter) + expect_no_lint(five_expr_three_lines_lines, max_expr4_linter) }) -test_that("max_branch_lines= and max_branch_expressions= block over-complex switch() too", { +test_that("max_branch_lines= and max_branch_expressions= block over-complex switch() too", { # nofuzz max_lines2_linter <- if_switch_linter(max_branch_lines = 2L) max_lines4_linter <- if_switch_linter(max_branch_lines = 4L) max_expr2_linter <- if_switch_linter(max_branch_expressions = 2L) @@ -237,10 +245,10 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit } ) ") - expect_lint(one_per_branch_lines, NULL, max_lines2_linter) - expect_lint(one_per_branch_lines, NULL, max_lines4_linter) - expect_lint(one_per_branch_lines, NULL, max_expr2_linter) - expect_lint(one_per_branch_lines, NULL, max_expr4_linter) + expect_no_lint(one_per_branch_lines, max_lines2_linter) + expect_no_lint(one_per_branch_lines, max_lines4_linter) + expect_no_lint(one_per_branch_lines, max_expr2_linter) + expect_no_lint(one_per_branch_lines, max_expr4_linter) two_per_branch_lines <- trim_some(" switch(x, @@ -258,10 +266,10 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit } ) ") - expect_lint(two_per_branch_lines, NULL, max_lines2_linter) - expect_lint(two_per_branch_lines, NULL, max_lines4_linter) - expect_lint(two_per_branch_lines, NULL, max_expr2_linter) - expect_lint(two_per_branch_lines, NULL, max_expr4_linter) + expect_no_lint(two_per_branch_lines, max_lines2_linter) + expect_no_lint(two_per_branch_lines, max_lines4_linter) + expect_no_lint(two_per_branch_lines, max_expr2_linter) + expect_no_lint(two_per_branch_lines, max_expr4_linter) three_per_branch_lines <- trim_some(" switch(x, @@ -287,13 +295,13 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit list(lint_msg, line_number = 1L), max_lines2_linter ) - expect_lint(three_per_branch_lines, NULL, max_lines4_linter) + expect_no_lint(three_per_branch_lines, max_lines4_linter) expect_lint( three_per_branch_lines, list(lint_msg, line_number = 1L), max_expr2_linter ) - expect_lint(three_per_branch_lines, NULL, max_expr4_linter) + expect_no_lint(three_per_branch_lines, max_expr4_linter) five_per_branch_lines <- trim_some(" switch(x, @@ -353,7 +361,7 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit expect_lint(five_lines_three_expr_lines, lint_msg, max_lines2_linter) expect_lint(five_lines_three_expr_lines, lint_msg, max_lines4_linter) expect_lint(five_lines_three_expr_lines, lint_msg, max_expr2_linter) - expect_lint(five_lines_three_expr_lines, NULL, max_expr4_linter) + expect_no_lint(five_lines_three_expr_lines, max_expr4_linter) five_expr_three_lines_lines <- trim_some(" switch(x, @@ -375,12 +383,12 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit ) ") expect_lint(five_expr_three_lines_lines, lint_msg, max_lines2_linter) - expect_lint(five_expr_three_lines_lines, NULL, max_lines4_linter) + expect_no_lint(five_expr_three_lines_lines, max_lines4_linter) expect_lint(five_expr_three_lines_lines, lint_msg, max_expr2_linter) expect_lint(five_expr_three_lines_lines, lint_msg, max_expr4_linter) }) -test_that("max_branch_lines= and max_branch_expressions= interact correctly", { +test_that("max_branch_lines= and max_branch_expressions= interact correctly", { # nofuzz linter <- if_switch_linter(max_branch_lines = 5L, max_branch_expressions = 3L) lint_msg <- rex::rex("Prefer switch() statements over repeated if/else equality tests") @@ -398,7 +406,7 @@ test_that("max_branch_lines= and max_branch_expressions= interact correctly", { linter ) - expect_lint( + expect_no_lint( trim_some(" if (x == 'a') { foo( @@ -413,11 +421,10 @@ test_that("max_branch_lines= and max_branch_expressions= interact correctly", { 3 } "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" if (x == 'a') { 1; 2; 3; 4 @@ -427,12 +434,11 @@ test_that("max_branch_lines= and max_branch_expressions= interact correctly", { 6 } "), - NULL, linter ) }) -test_that("max_branch_lines= and max_branch_expressions= work for a terminal 'else' branch", { +test_that("max_branch_lines= and max_branch_expressions= work for a terminal 'else' branch", { # nofuzz max_lines2_linter <- if_switch_linter(max_branch_lines = 2L) max_expr2_linter <- if_switch_linter(max_branch_expressions = 2L) lint_msg <- rex::rex("Prefer repeated if/else statements over overly-complicated switch() statements.") @@ -450,8 +456,8 @@ test_that("max_branch_lines= and max_branch_expressions= work for a terminal 'el 6 } ") - expect_lint(else_long_lines, NULL, max_lines2_linter) - expect_lint(else_long_lines, NULL, max_expr2_linter) + expect_no_lint(else_long_lines, max_lines2_linter) + expect_no_lint(else_long_lines, max_expr2_linter) default_long_lines <- trim_some(" switch(x, @@ -475,7 +481,7 @@ test_that("max_branch_lines= and max_branch_expressions= work for a terminal 'el expect_lint(default_long_lines, lint_msg, max_expr2_linter) }) -test_that("max_branch_lines= and max_branch_expressions= are guided by the most complex branch", { +test_that("max_branch_lines= and max_branch_expressions= are guided by the most complex branch", { # nofuzz max_lines2_linter <- if_switch_linter(max_branch_lines = 2L) max_expr2_linter <- if_switch_linter(max_branch_expressions = 2L) lint_msg <- rex::rex("Prefer repeated if/else statements over overly-complicated switch() statements.") @@ -492,8 +498,8 @@ test_that("max_branch_lines= and max_branch_expressions= are guided by the most 5 } ") - expect_lint(if_else_one_branch_lines, NULL, max_lines2_linter) - expect_lint(if_else_one_branch_lines, NULL, max_expr2_linter) + expect_no_lint(if_else_one_branch_lines, max_lines2_linter) + expect_no_lint(if_else_one_branch_lines, max_expr2_linter) # lint if _any_ branch is too complex switch_one_branch_lines <- trim_some(" diff --git a/tests/testthat/test-implicit_assignment_linter.R b/tests/testthat/test-implicit_assignment_linter.R index 01b5c2107..c9c4a0f3b 100644 --- a/tests/testthat/test-implicit_assignment_linter.R +++ b/tests/testthat/test-implicit_assignment_linter.R @@ -214,6 +214,22 @@ test_that("implicit_assignment_linter blocks disallowed usages in simple conditi expect_lint("while (0L -> x) FALSE", lint_message, linter) expect_lint("for (x in y <- 1:10) print(x)", lint_message, linter) expect_lint("for (x in 1:10 -> y) print(x)", lint_message, linter) + + # adversarial commenting + expect_lint( + trim_some(" + while # comment + (x <- 0L) FALSE + + while ( # comment + x <- 0L) FALSE + "), + list( + list(lint_message, line_number = 2L), + list(lint_message, line_number = 5L) + ), + linter + ) }) test_that("implicit_assignment_linter blocks disallowed usages in nested conditional statements", { @@ -419,6 +435,17 @@ test_that("allow_scoped skips scoped assignments", { # outside of branching, doesn't matter expect_lint("foo(idx <- bar()); baz()", lint_message, linter) expect_lint("foo(x, idx <- bar()); baz()", lint_message, linter) + + # adversarial comments + expect_no_lint( + trim_some(" + if # comment + (any(idx <- x < 0)) { + stop('negative elements: ', toString(which(idx))) + } + "), + linter + ) }) test_that("interaction of allow_lazy and allow_scoped", { diff --git a/tests/testthat/test-indentation_linter.R b/tests/testthat/test-indentation_linter.R index a4e1f6a55..19a78b520 100644 --- a/tests/testthat/test-indentation_linter.R +++ b/tests/testthat/test-indentation_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("indentation linter flags unindented expressions", { linter <- indentation_linter(indent = 2L) @@ -912,3 +913,4 @@ test_that("for loop gets correct linting", { linter ) }) +# nofuzz end diff --git a/tests/testthat/test-infix_spaces_linter.R b/tests/testthat/test-infix_spaces_linter.R index 245ac8a4e..ba7182f83 100644 --- a/tests/testthat/test-infix_spaces_linter.R +++ b/tests/testthat/test-infix_spaces_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("returns the correct linting", { ops <- c( "+", @@ -235,3 +236,4 @@ test_that("lints vectorize", { infix_spaces_linter() ) }) +# nofuzz end diff --git a/tests/testthat/test-knitr_formats.R b/tests/testthat/test-knitr_formats.R index eb3dfc5f9..8a70c7c87 100644 --- a/tests/testthat/test-knitr_formats.R +++ b/tests/testthat/test-knitr_formats.R @@ -120,7 +120,7 @@ test_that("it handles asciidoc", { ) }) -test_that("it does _not_ handle brew", { +test_that("it does _not_ handle brew", { # nofuzz expect_lint("'<% a %>'\n", checks = list( regexes[["quotes"]], @@ -131,9 +131,8 @@ test_that("it does _not_ handle brew", { }) test_that("it does _not_ error with inline \\Sexpr", { - expect_lint( + expect_no_lint( "#' text \\Sexpr{1 + 1} more text", - NULL, default_linters ) }) diff --git a/tests/testthat/test-length_test_linter.R b/tests/testthat/test-length_test_linter.R index b60557c12..f71e13e66 100644 --- a/tests/testthat/test-length_test_linter.R +++ b/tests/testthat/test-length_test_linter.R @@ -1,8 +1,8 @@ test_that("skips allowed usages", { linter <- length_test_linter() - expect_lint("length(x) > 0", NULL, linter) - expect_lint("length(DF[key == val, cols])", NULL, linter) + expect_no_lint("length(x) > 0", linter) + expect_no_lint("length(DF[key == val, cols])", linter) }) test_that("blocks simple disallowed usages", { @@ -12,6 +12,16 @@ test_that("blocks simple disallowed usages", { expect_lint("length(x == 0)", rex::rex(lint_msg_stub, "`length(x) == 0`?"), linter) expect_lint("length(x == y)", rex::rex(lint_msg_stub, "`length(x) == y`?"), linter) expect_lint("length(x + y == 2)", rex::rex(lint_msg_stub, "`length(x+y) == 2`?"), linter) + + # adversarial comments + expect_lint( + trim_some(" + length(x + # + y == 2) + "), + rex::rex(lint_msg_stub, "`length(x+y) == 2`?"), + linter + ) }) local({ @@ -32,6 +42,8 @@ local({ }) test_that("lints vectorize", { + linter <- length_test_linter() + expect_lint( trim_some("{ length(x == y) @@ -41,6 +53,26 @@ test_that("lints vectorize", { list(rex::rex("length(x) == y"), line_number = 2L), list(rex::rex("length(y) == z"), line_number = 3L) ), - length_test_linter() + linter + ) + + expect_lint( + trim_some("{ + length( # comment + x # comment + == # comment + y # comment + ) # comment + length( # comment + y # comment + == # comment + z # comment + ) + }"), + list( + list(rex::rex("length(x) == y"), line_number = 2L), + list(rex::rex("length(y) == z"), line_number = 7L) + ), + linter ) }) diff --git a/tests/testthat/test-line_length_linter.R b/tests/testthat/test-line_length_linter.R index 5e22fc523..483ecff5a 100644 --- a/tests/testthat/test-line_length_linter.R +++ b/tests/testthat/test-line_length_linter.R @@ -1,8 +1,9 @@ +# nofuzz start test_that("line_length_linter skips allowed usages", { linter <- line_length_linter(80L) - expect_lint("blah", NULL, linter) - expect_lint(strrep("x", 80L), NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint(strrep("x", 80L), linter) }) test_that("line_length_linter blocks disallowed usages", { @@ -37,7 +38,7 @@ test_that("line_length_linter blocks disallowed usages", { linter <- line_length_linter(20L) lint_msg <- rex::rex("Lines should not be more than 20 characters. This line is 22 characters.") - expect_lint(strrep("a", 20L), NULL, linter) + expect_no_lint(strrep("a", 20L), linter) expect_lint( strrep("a", 22L), list( @@ -71,3 +72,4 @@ test_that("Multiple lints give custom messages", { line_length_linter(5L) ) }) +# nofuzz end diff --git a/tests/testthat/test-lint.R b/tests/testthat/test-lint.R index 983c5e0c4..cb4836232 100644 --- a/tests/testthat/test-lint.R +++ b/tests/testthat/test-lint.R @@ -146,7 +146,7 @@ test_that("lint() results from file or text should be consistent", { expect_identical(lint_from_file, lint_from_text) }) -test_that("exclusions work with custom linter names", { +test_that("exclusions work with custom linter names", { # nofuzz expect_no_lint( "a = 2 # nolint: bla.", linters = list(bla = assignment_linter()), diff --git a/tests/testthat/test-nested_pipe_linter.R b/tests/testthat/test-nested_pipe_linter.R index 1e1679238..f79dbd3e6 100644 --- a/tests/testthat/test-nested_pipe_linter.R +++ b/tests/testthat/test-nested_pipe_linter.R @@ -1,54 +1,50 @@ test_that("nested_pipe_linter skips allowed usages", { linter <- nested_pipe_linter() - expect_lint("a %>% b() %>% c()", NULL, linter) + expect_no_lint("a %>% b() %>% c()", linter) - expect_lint( + expect_no_lint( trim_some(" foo <- function(x) { out <- a %>% b() return(out) } "), - NULL, linter ) # pipes fitting on one line can be ignored - expect_lint( + expect_no_lint( # nofuzz "bind_rows(a %>% select(b), c %>% select(b))", - NULL, linter ) # switch outputs are OK - expect_lint("switch(x, a = x %>% foo())", NULL, linter) + expect_no_lint("switch(x, a = x %>% foo())", linter) # final position is an output position - expect_lint("switch(x, a = x, x %>% foo())", NULL, linter) + expect_no_lint("switch(x, a = x, x %>% foo())", linter) # inline switch inputs are not linted - expect_lint( + expect_no_lint( # nofuzz trim_some(" switch( x %>% foo(), a = x ) "), - NULL, linter ) }) patrick::with_parameters_test_that( "allow_outer_calls defaults are ignored by default", - expect_lint( + expect_no_lint( trim_some(sprintf(outer_call, fmt = " %s( x %%>%% foo() ) ")), - NULL, nested_pipe_linter() ), .test_name = c("try", "tryCatch", "withCallingHandlers"), @@ -114,14 +110,13 @@ test_that("allow_outer_calls= argument works", { nested_pipe_linter(allow_outer_calls = character()) ) - expect_lint( + expect_no_lint( trim_some(" print( x %>% foo() ) "), - NULL, nested_pipe_linter(allow_outer_calls = "print") ) }) @@ -133,9 +128,8 @@ test_that("Native pipes are handled as well", { linter_inline <- nested_pipe_linter(allow_inline = FALSE) lint_msg <- rex::rex("Don't nest pipes inside other calls.") - expect_lint( + expect_no_lint( # nofuzz "bind_rows(a |> select(b), c |> select(b))", - NULL, linter ) expect_lint( @@ -156,7 +150,7 @@ test_that("Native pipes are handled as well", { ) }) -test_that("lints vectorize", { +test_that("lints vectorize", { # nofuzz lint_msg <- rex::rex("Don't nest pipes inside other calls.") lines <- trim_some("{ diff --git a/tests/testthat/test-object_usage_linter.R b/tests/testthat/test-object_usage_linter.R index 7efc4025b..4283e16d6 100644 --- a/tests/testthat/test-object_usage_linter.R +++ b/tests/testthat/test-object_usage_linter.R @@ -753,6 +753,21 @@ test_that("symbols in formulas aren't treated as 'undefined global'", { ), linter ) + + # native lambda requires being in an expression to support a comment immediately after + expect_lint( + trim_some(" + foo <- \\ # comment + (x) { + lm( + y(w) ~ z, + data = x[!is.na(y)] + ) + } + "), + "no visible", + linter + ) }) test_that("NSE-ish symbols after $/@ are ignored as sources for lints", { diff --git a/tests/testthat/test-paren_body_linter.R b/tests/testthat/test-paren_body_linter.R index dac02cae4..d82c1738c 100644 --- a/tests/testthat/test-paren_body_linter.R +++ b/tests/testthat/test-paren_body_linter.R @@ -1,3 +1,4 @@ +# nofuzz start testthat::test_that("paren_body_linter returns correct lints", { linter <- paren_body_linter() lint_msg <- rex::rex("Put a space between a right parenthesis and a body expression.") @@ -10,10 +11,10 @@ testthat::test_that("paren_body_linter returns correct lints", { expect_lint("for (i in seq_along(1))test", lint_msg, linter) # A space after the closing parenthesis does not prompt a lint - expect_lint("function() test", NULL, linter) + expect_no_lint("function() test", linter) # Symbols after the closing parenthesis of a function call do not prompt a lint - expect_lint("head(mtcars)$cyl", NULL, linter) + expect_no_lint("head(mtcars)$cyl", linter) # paren_body_linter returns the correct line number expect_lint( @@ -35,10 +36,10 @@ testthat::test_that("paren_body_linter returns correct lints", { ) # paren_body_linter does not lint when the function body is defined on a new line - expect_lint("function()\n test", NULL, linter) + expect_no_lint("function()\n test", linter) # paren_body_linter does not lint comments - expect_lint("#function()test", NULL, linter) + expect_no_lint("#function()test", linter) # multiple lints on the same line expect_lint("function()if(TRUE)while(TRUE)test", list(lint_msg, lint_msg, lint_msg), linter) @@ -95,3 +96,4 @@ test_that("function shorthand is handled", { expect_lint("\\()test", lint_msg, linter) }) +# nofuzz end diff --git a/tests/testthat/test-pipe_continuation_linter.R b/tests/testthat/test-pipe_continuation_linter.R index 89633f6b2..c693eb3a6 100644 --- a/tests/testthat/test-pipe_continuation_linter.R +++ b/tests/testthat/test-pipe_continuation_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("pipe-continuation correctly handles stand-alone expressions", { linter <- pipe_continuation_linter() lint_msg <- rex::rex("Put a space before `%>%` and a new line after it,") @@ -199,3 +200,4 @@ local({ .cases = cases ) }) +# nofuzz end diff --git a/tests/testthat/test-redundant_equals_linter.R b/tests/testthat/test-redundant_equals_linter.R index 541237f83..8bd829b6a 100644 --- a/tests/testthat/test-redundant_equals_linter.R +++ b/tests/testthat/test-redundant_equals_linter.R @@ -1,8 +1,10 @@ test_that("redundant_equals_linter skips allowed usages", { + linter <- redundant_equals_linter() + # comparisons to non-logical constants - expect_lint("x == 1", NULL, redundant_equals_linter()) + expect_no_lint("x == 1", linter) # comparison to TRUE as a string - expect_lint("x != 'TRUE'", NULL, redundant_equals_linter()) + expect_no_lint("x != 'TRUE'", linter) }) test_that("multiple lints return correct custom messages", { @@ -40,3 +42,14 @@ patrick::with_parameters_test_that( "!=, FALSE", "!=", "FALSE" ) ) + +test_that("logic survives adversarial comments", { + expect_lint( + trim_some(" + list(x # + == TRUE) + "), + "==", + redundant_equals_linter() + ) +}) diff --git a/tests/testthat/test-regex_subset_linter.R b/tests/testthat/test-regex_subset_linter.R index 0c3e0c6e9..5375b662c 100644 --- a/tests/testthat/test-regex_subset_linter.R +++ b/tests/testthat/test-regex_subset_linter.R @@ -1,6 +1,8 @@ test_that("regex_subset_linter skips allowed usages", { - expect_lint("y[grepl(ptn, x)]", NULL, regex_subset_linter()) - expect_lint("x[grepl(ptn, foo(x))]", NULL, regex_subset_linter()) + linter <- regex_subset_linter() + + expect_no_lint("y[grepl(ptn, x)]", linter) + expect_no_lint("x[grepl(ptn, foo(x))]", linter) }) test_that("regex_subset_linter blocks simple disallowed usages", { @@ -10,24 +12,42 @@ test_that("regex_subset_linter blocks simple disallowed usages", { expect_lint("x[grep(ptn, x)]", lint_msg, linter) expect_lint("names(y)[grepl(ptn, names(y), perl = TRUE)]", lint_msg, linter) expect_lint("names(foo(y))[grepl(ptn, names(foo(y)), fixed = TRUE)]", lint_msg, linter) + + # adversarial commenting + expect_lint( + trim_some(" + names(y #comment + )[grepl(ptn, names(y), perl = TRUE)] + "), + lint_msg, + linter + ) }) test_that("regex_subset_linter skips grep/grepl subassignment", { linter <- regex_subset_linter() - expect_lint("x[grep(ptn, x)] <- ''", NULL, linter) - expect_lint("x[grepl(ptn, x)] <- ''", NULL, linter) - expect_lint("x[grep(ptn, x, perl = TRUE)] = ''", NULL, linter) - expect_lint("'' -> x[grep(ptn, x, ignore.case = TRUE)] = ''", NULL, linter) + expect_no_lint("x[grep(ptn, x)] <- ''", linter) + expect_no_lint("x[grepl(ptn, x)] <- ''", linter) + expect_no_lint("x[grep(ptn, x, perl = TRUE)] = ''", linter) + expect_no_lint("'' -> x[grep(ptn, x, ignore.case = TRUE)] = ''", linter) + + expect_no_lint( + trim_some(" + x[grepl(ptn, x) # comment + ] <- '' + "), + linter + ) }) test_that("regex_subset_linter skips allowed usages for stringr equivalents", { linter <- regex_subset_linter() - expect_lint("y[str_detect(x, ptn)]", NULL, linter) - expect_lint("x[str_detect(foo(x), ptn)]", NULL, linter) - expect_lint("x[str_detect(x, ptn)] <- ''", NULL, linter) - expect_lint("x[str_detect(x, ptn)] <- ''", NULL, linter) + expect_no_lint("y[str_detect(x, ptn)]", linter) + expect_no_lint("x[str_detect(foo(x), ptn)]", linter) + expect_no_lint("x[str_detect(x, ptn)] <- ''", linter) + expect_no_lint("x[str_detect(x, ptn)] <- ''", linter) }) test_that("regex_subset_linter blocks disallowed usages for stringr equivalents", { diff --git a/tests/testthat/test-return_linter.R b/tests/testthat/test-return_linter.R index 1a228e912..9cb9a23a6 100644 --- a/tests/testthat/test-return_linter.R +++ b/tests/testthat/test-return_linter.R @@ -704,7 +704,7 @@ test_that("except= and except_regex= combination works", { ) }) -test_that("return_linter skips brace-wrapped inline functions", { +test_that("return_linter skips brace-wrapped inline functions", { # nofuzz expect_no_lint("function(x) { sum(x) }", return_linter(return_style = "explicit")) }) diff --git a/tests/testthat/test-semicolon_linter.R b/tests/testthat/test-semicolon_linter.R index 8a72da509..1d8fb66c7 100644 --- a/tests/testthat/test-semicolon_linter.R +++ b/tests/testthat/test-semicolon_linter.R @@ -1,64 +1,90 @@ -test_that("Lint all semicolons", { +test_that("semicolon_linter skips allowed usages", { linter <- semicolon_linter() - trail_msg <- rex::rex("Remove trailing semicolons.") - comp_msg <- rex::rex("Replace compound semicolons by a newline.") - # No semicolon - expect_lint("", NULL, linter) - expect_lint("a <- 1", NULL, linter) - expect_lint("function() {a <- 1}", NULL, linter) - expect_lint("a <- \"foo;bar\"", NULL, linter) - expect_lint("function() {a <- \"foo;bar\"}", NULL, linter) - expect_lint("a <- FALSE # ok; cool!", NULL, linter) - expect_lint("function() {\na <- FALSE # ok; cool!\n}", NULL, linter) + expect_no_lint("", linter) + expect_no_lint("a <- 1", linter) + expect_no_lint("function() {a <- 1}", linter) + expect_no_lint('a <- "foo;bar"', linter) + expect_no_lint('function() {a <- "foo;bar"}', linter) + expect_no_lint("a <- FALSE # ok; cool!", linter) + expect_no_lint( + trim_some(" + function() { + a <- FALSE # ok; cool! + } + "), + linter + ) +}) + +test_that("semicolon_linter handles trailing semicolons", { + linter <- semicolon_linter() + lint_msg <- rex::rex("Remove trailing semicolons.") - # Trailing semicolons expect_lint( "a <- 1;", - list(message = trail_msg, line_number = 1L, column_number = 7L), + list(lint_msg, line_number = 1L, column_number = 7L), linter ) expect_lint( "function(){a <- 1;}", - list(message = trail_msg, line_number = 1L, column_number = 18L), + list(lint_msg, line_number = 1L, column_number = 18L), linter ) expect_lint( - "a <- 1; \n", - list(message = trail_msg, line_number = 1L, column_number = 7L), - linter - ) - expect_lint( - "function(){a <- 1; \n}", - list(message = trail_msg, line_number = 1L, column_number = 18L), + trim_some(" + function() { a <- 1; + }" + ), + list(lint_msg, line_number = 1L, column_number = 20L), linter ) +}) + +test_that("semicolon_linter handles compound semicolons", { # nofuzz + linter <- semicolon_linter() + lint_msg <- rex::rex("Replace compound semicolons by a newline.") - # Compound semicolons expect_lint( "a <- 1;b <- 2", - list(message = comp_msg, line_number = 1L, column_number = 7L), + list(lint_msg, line_number = 1L, column_number = 7L), linter ) expect_lint( - "function() {a <- 1;b <- 2}\n", - list(message = comp_msg, line_number = 1L, column_number = 19L), + "function() {a <- 1;b <- 2}", + list(lint_msg, line_number = 1L, column_number = 19L), linter ) expect_lint( - "foo <-\n 1 ; foo <- 1.23", - list(message = comp_msg, line_number = 2L, column_number = 6L), + trim_some(" + foo <- + 1 ; foo <- 1.23 + "), + list(lint_msg, line_number = 2L, column_number = 6L), linter ) expect_lint( - "function(){\nfoo <-\n 1 ; foo <- 1.23\n}", - list(message = comp_msg, line_number = 3L, column_number = 6L), + trim_some(" + function() { + foo <- + 1 ; foo <- 1.23 + } + "), + list(lint_msg, line_number = 3L, column_number = 6L), linter ) +}) + +test_that("semicolon_linter handles multiple/mixed semicolons", { # nofuzz + linter <- semicolon_linter() + trail_msg <- rex::rex("Remove trailing semicolons.") + comp_msg <- rex::rex("Replace compound semicolons by a newline.") - # Multiple, mixed semicolons", { expect_lint( - "a <- 1 ; b <- 2;\nc <- 3;", + trim_some(" + a <- 1 ; b <- 2; + c <- 3; + "), list( list(message = comp_msg, line_number = 1L, column_number = 8L), list(message = trail_msg, line_number = 1L, column_number = 16L), @@ -67,38 +93,60 @@ test_that("Lint all semicolons", { linter ) expect_lint( - "function() { a <- 1 ; b <- 2;\nc <- 3;}", + trim_some(" + function() { a <- 1 ; b <- 2; + c <- 3;} + "), list( list(message = comp_msg, line_number = 1L, column_number = 21L), list(message = trail_msg, line_number = 1L, column_number = 29L), - list(message = trail_msg, line_number = 2L, column_number = 7L) + list(message = trail_msg, line_number = 2L, column_number = 9L) ), linter ) }) -test_that("Compound semicolons only", { +test_that("Compound semicolons only", { # nofuzz linter <- semicolon_linter(allow_trailing = TRUE) - expect_lint("a <- 1;", NULL, linter) - expect_lint("function(){a <- 1;}", NULL, linter) - expect_lint("a <- 1; \n", NULL, linter) - expect_lint("function(){a <- 1; \n}", NULL, linter) + expect_no_lint("a <- 1;", linter) + expect_no_lint("function(){a <- 1;}", linter) + expect_no_lint( + trim_some(" + function(){a <- 1; + } + "), + linter + ) }) test_that("Trailing semicolons only", { linter <- semicolon_linter(allow_compound = TRUE) expect_lint("a <- 1;b <- 2", NULL, linter) - expect_lint("function() {a <- 1;b <- 2}\n", NULL, linter) - expect_lint("f <-\n 1 ;f <- 1.23", NULL, linter) - expect_lint("function(){\nf <-\n 1 ;f <- 1.23\n}", NULL, linter) + expect_no_lint("function() {a <- 1;b <- 2}", linter) + expect_no_lint( + trim_some(" + f <- + 1 ;f <- 1.23 + "), + linter + ) + expect_no_lint( + trim_some(" + function(){ + f <- + 1 ;f <- 1.23 + } + "), + linter + ) }) -test_that("Compound semicolons only", { +test_that("Compound semicolons only", { # nofuzz expect_error( - lint(text = "a <- 1;", linters = semicolon_linter(allow_trailing = TRUE, allow_compound = TRUE)), + semicolon_linter(allow_trailing = TRUE, allow_compound = TRUE), "At least one of `allow_compound` or `allow_trailing` must be `FALSE`", fixed = TRUE ) diff --git a/tests/testthat/test-seq_linter.R b/tests/testthat/test-seq_linter.R index 9424d394f..295e496ef 100644 --- a/tests/testthat/test-seq_linter.R +++ b/tests/testthat/test-seq_linter.R @@ -96,6 +96,15 @@ test_that("finds 1:length(...) expressions", { linter ) + expect_lint( + trim_some(" + mutate(x, .id = 1:n( # comment + )) + "), + lint_msg("seq_len(n())", "1:n(),"), + linter + ) + expect_lint( "x[, .id := 1:.N]", lint_msg("seq_len(.N)", "1:.N,"), diff --git a/tests/testthat/test-sort_linter.R b/tests/testthat/test-sort_linter.R index 15d8ab209..aa0e57804 100644 --- a/tests/testthat/test-sort_linter.R +++ b/tests/testthat/test-sort_linter.R @@ -1,21 +1,21 @@ test_that("sort_linter skips allowed usages", { linter <- sort_linter() - expect_lint("order(y)", NULL, linter) + expect_no_lint("order(y)", linter) - expect_lint("y[order(x)]", NULL, linter) + expect_no_lint("y[order(x)]", linter) # If another function is intercalated, don't fail - expect_lint("x[c(order(x))]", NULL, linter) + expect_no_lint("x[c(order(x))]", linter) - expect_lint("x[order(y, x)]", NULL, linter) - expect_lint("x[order(x, y)]", NULL, linter) + expect_no_lint("x[order(y, x)]", linter) + expect_no_lint("x[order(x, y)]", linter) # pretty sure this never makes sense, but test anyway - expect_lint("x[order(y, na.last = x)]", NULL, linter) + expect_no_lint("x[order(y, na.last = x)]", linter) }) -test_that("sort_linter blocks simple disallowed usages", { +test_that("sort_linter blocks simple disallowed usages for x[order(x)] cases", { linter <- sort_linter() lint_message <- rex::rex("sort(", anything, ") is better than") @@ -62,6 +62,32 @@ test_that("sort_linter produces customized warning message", { rex::rex("sort(f(), na.last = TRUE) is better than f()[order(f())]"), linter ) + + # comment torture + expect_lint( + trim_some(" + x[ # comment + order( # comment + x # comment + , # comment + na.last # comment + = # comment + FALSE # comment + ) # comment + ] + "), + rex::rex("sort(x, na.last = FALSE)"), + linter + ) + + expect_lint( + trim_some(" + f( # comment + )[order(f())] + "), + rex::rex("sort(f(), na.last = TRUE) is better than f()[order(f())]"), + linter + ) }) test_that("sort_linter works with multiple lints in a single expression", { @@ -89,20 +115,20 @@ test_that("sort_linter skips usages calling sort arguments", { linter <- sort_linter() # any arguments to sort --> not compatible - expect_lint("sort(x, decreasing = TRUE) == x", NULL, linter) - expect_lint("sort(x, na.last = TRUE) != x", NULL, linter) - expect_lint("sort(x, method_arg = TRUE) == x", NULL, linter) + expect_no_lint("sort(x, decreasing = TRUE) == x", linter) + expect_no_lint("sort(x, na.last = TRUE) != x", linter) + expect_no_lint("sort(x, method_arg = TRUE) == x", linter) }) test_that("sort_linter skips when inputs don't match", { linter <- sort_linter() - expect_lint("sort(x) == y", NULL, linter) - expect_lint("sort(x) == foo(x)", NULL, linter) - expect_lint("sort(foo(x)) == x", NULL, linter) + expect_no_lint("sort(x) == y", linter) + expect_no_lint("sort(x) == foo(x)", linter) + expect_no_lint("sort(foo(x)) == x", linter) }) -test_that("sort_linter blocks simple disallowed usages", { +test_that("sort_linter blocks simple disallowed usages for is.sorted cases", { linter <- sort_linter() unsorted_msg <- rex::rex("Use is.unsorted(x) to test the unsortedness of a vector.") sorted_msg <- rex::rex("Use !is.unsorted(x) to test the sortedness of a vector.") @@ -117,6 +143,14 @@ test_that("sort_linter blocks simple disallowed usages", { # expression matching expect_lint("sort(foo(x)) == foo(x)", sorted_msg, linter) + expect_lint( + trim_some(" + sort(foo(x # comment + )) == foo(x) + "), + sorted_msg, + linter + ) }) test_that("lints vectorize", { diff --git a/tests/testthat/test-spaces_inside_linter.R b/tests/testthat/test-spaces_inside_linter.R index ff0981ab5..e2c93329e 100644 --- a/tests/testthat/test-spaces_inside_linter.R +++ b/tests/testthat/test-spaces_inside_linter.R @@ -1,36 +1,35 @@ +# nofuzz start test_that("spaces_inside_linter skips allowed usages", { linter <- spaces_inside_linter() - expect_lint("blah", NULL, linter) - expect_lint("print(blah)", NULL, linter) - expect_lint("base::print(blah)", NULL, linter) - expect_lint("a[, ]", NULL, linter) - expect_lint("a[1]", NULL, linter) - expect_lint("fun(\na[1]\n )", NULL, linter) - expect_lint("a(, )", NULL, linter) - expect_lint("a(,)", NULL, linter) - expect_lint("a(1)", NULL, linter) - expect_lint('"a( 1 )"', NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint("print(blah)", linter) + expect_no_lint("base::print(blah)", linter) + expect_no_lint("a[, ]", linter) + expect_no_lint("a[1]", linter) + expect_no_lint("fun(\na[1]\n )", linter) + expect_no_lint("a(, )", linter) + expect_no_lint("a(,)", linter) + expect_no_lint("a(1)", linter) + expect_no_lint('"a( 1 )"', linter) # trailing comments are OK (#636) - expect_lint( + expect_no_lint( trim_some(" or( #code x, y ) "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" fun( # this is another comment a = 42, # because 42 is always the answer b = Inf ) "), - NULL, linter ) }) @@ -41,7 +40,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { expect_lint( "a[1 ]", list( - message = "Do not place spaces before square brackets", + "Do not place spaces before square brackets", line_number = 1L, column_number = 4L, type = "style" @@ -52,7 +51,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { expect_lint( "a[[1 ]]", list( - message = "Do not place spaces before square brackets", + "Do not place spaces before square brackets", line_number = 1L, column_number = 5L, type = "style" @@ -63,7 +62,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { expect_lint( "\n\na[ 1]", list( - message = "Do not place spaces after square brackets", + "Do not place spaces after square brackets", line_number = 3L, column_number = 3L, type = "style" @@ -75,13 +74,13 @@ test_that("spaces_inside_linter blocks diallowed usages", { "a[ 1 ]", list( list( - message = "Do not place spaces after square brackets", + "Do not place spaces after square brackets", line_number = 1L, column_number = 3L, type = "style" ), list( - message = "Do not place spaces before square brackets", + "Do not place spaces before square brackets", line_number = 1L, column_number = 5L, type = "style" @@ -93,7 +92,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { expect_lint( "a(1 )", list( - message = "Do not place spaces before parentheses", + "Do not place spaces before parentheses", line_number = 1L, column_number = 4L, type = "style" @@ -104,7 +103,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { expect_lint( "a[[ 1]]", list( - message = "Do not place spaces after square brackets", + "Do not place spaces after square brackets", line_number = 1L, column_number = 4L, type = "style" @@ -115,7 +114,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { expect_lint( "a( 1)", list( - message = "Do not place spaces after parentheses", + "Do not place spaces after parentheses", line_number = 1L, column_number = 3L, type = "style" @@ -127,13 +126,13 @@ test_that("spaces_inside_linter blocks diallowed usages", { "x[[ 1L ]]", list( list( - message = "Do not place spaces after square brackets", + "Do not place spaces after square brackets", line_number = 1L, column_number = 4L, type = "style" ), list( - message = "Do not place spaces before square brackets", + "Do not place spaces before square brackets", line_number = 1L, column_number = 7L, type = "style" @@ -146,13 +145,13 @@ test_that("spaces_inside_linter blocks diallowed usages", { "a( 1 )", list( list( - message = "Do not place spaces after parentheses", + "Do not place spaces after parentheses", line_number = 1L, column_number = 3L, type = "style" ), list( - message = "Do not place spaces before parentheses", + "Do not place spaces before parentheses", line_number = 1L, column_number = 5L, type = "style" @@ -166,14 +165,14 @@ test_that("spaces_inside_linter blocks diallowed usages", { "a( blah )", list( list( - message = "Do not place spaces after parentheses", + "Do not place spaces after parentheses", line_number = 1L, column_number = 3L, ranges = list(c(3L, 4L)), type = "style" ), list( - message = "Do not place spaces before parentheses", + "Do not place spaces before parentheses", line_number = 1L, column_number = 9L, ranges = list(c(9L, 10L)), @@ -191,8 +190,8 @@ test_that("multi-line expressions have good markers", { y ) "), list( - list(line_number = 1L, ranges = list(c(2L, 2L)), message = "Do not place spaces after parentheses"), - list(line_number = 2L, ranges = list(c(4L, 4L)), message = "Do not place spaces before parentheses") + list("Do not place spaces after parentheses", line_number = 1L, ranges = list(c(2L, 2L))), + list("Do not place spaces before parentheses", line_number = 2L, ranges = list(c(4L, 4L))) ), spaces_inside_linter() ) @@ -207,13 +206,13 @@ test_that("spaces_inside_linter blocks disallowed usages with a pipe", { "letters[1:3] %>% paste0( )", list( list( - message = "Do not place spaces after parentheses", + "Do not place spaces after parentheses", line_number = 1L, column_number = 25L, type = "style" ), list( - message = "Do not place spaces before parentheses", + "Do not place spaces before parentheses", line_number = 1L, column_number = 25L, type = "style" @@ -226,13 +225,13 @@ test_that("spaces_inside_linter blocks disallowed usages with a pipe", { "letters[1:3] |> paste0( )", list( list( - message = "Do not place spaces after parentheses", + "Do not place spaces after parentheses", line_number = 1L, column_number = 24L, type = "style" ), list( - message = "Do not place spaces before parentheses", + "Do not place spaces before parentheses", line_number = 1L, column_number = 24L, type = "style" @@ -243,5 +242,6 @@ test_that("spaces_inside_linter blocks disallowed usages with a pipe", { }) test_that("terminal missing keyword arguments are OK", { - expect_lint("alist(missing_arg = )", NULL, spaces_inside_linter()) + expect_no_lint("alist(missing_arg = )", spaces_inside_linter()) }) +# nofuzz end diff --git a/tests/testthat/test-spaces_left_parentheses_linter.R b/tests/testthat/test-spaces_left_parentheses_linter.R index ce854828c..6d7956daf 100644 --- a/tests/testthat/test-spaces_left_parentheses_linter.R +++ b/tests/testthat/test-spaces_left_parentheses_linter.R @@ -1,44 +1,45 @@ +# nofuzz start test_that("spaces_left_parentheses_linter skips allowed usages", { linter <- spaces_left_parentheses_linter() - expect_lint("blah", NULL, linter) - expect_lint("print(blah)", NULL, linter) - expect_lint("base::print(blah)", NULL, linter) - expect_lint("base::print(blah, fun(1))", NULL, linter) - expect_lint("blah <- function(blah) { }", NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint("print(blah)", linter) + expect_no_lint("base::print(blah)", linter) + expect_no_lint("base::print(blah, fun(1))", linter) + expect_no_lint("blah <- function(blah) { }", linter) - expect_lint("(1 + 1)", NULL, linter) - expect_lint("(1 + 1)", NULL, linter) - expect_lint("( (1 + 1) )", NULL, linter) - expect_lint("if (blah) { }", NULL, linter) - expect_lint("for (i in j) { }", NULL, linter) - expect_lint("1 * (1 + 1)", NULL, linter) - expect_lint("!(1 == 1)", NULL, linter) - expect_lint("(2 - 1):(3 - 1)", NULL, linter) - expect_lint("c(1, 2, 3)[(2 - 1)]", NULL, linter) - expect_lint("list(1, 2, 3)[[(2 - 1)]]", NULL, linter) - expect_lint("range(10)[(2 - 1):(10 - 1)]", NULL, linter) - expect_lint("function(){function(){}}()()", NULL, linter) - expect_lint("c(function(){})[1]()", NULL, linter) + expect_no_lint("(1 + 1)", linter) + expect_no_lint("(1 + 1)", linter) + expect_no_lint("( (1 + 1) )", linter) + expect_no_lint("if (blah) { }", linter) + expect_no_lint("for (i in j) { }", linter) + expect_no_lint("1 * (1 + 1)", linter) + expect_no_lint("!(1 == 1)", linter) + expect_no_lint("(2 - 1):(3 - 1)", linter) + expect_no_lint("c(1, 2, 3)[(2 - 1)]", linter) + expect_no_lint("list(1, 2, 3)[[(2 - 1)]]", linter) + expect_no_lint("range(10)[(2 - 1):(10 - 1)]", linter) + expect_no_lint("function(){function(){}}()()", linter) + expect_no_lint("c(function(){})[1]()", linter) - expect_lint("\"test <- function(x) { if(1 + 1) 'hi' }\"", NULL, linter) - expect_lint("res <- c((mat - 1L) %*% combs + 1L)", NULL, linter) - expect_lint("if (!(foo && bar || baz)) { foo }", NULL, linter) - expect_lint("x^(y + z)", NULL, linter) - expect_lint("x**(y + z)", NULL, linter) - expect_lint("a <- -(b)", NULL, linter) + expect_no_lint("\"test <- function(x) { if(1 + 1) 'hi' }\"", linter) + expect_no_lint("res <- c((mat - 1L) %*% combs + 1L)", linter) + expect_no_lint("if (!(foo && bar || baz)) { foo }", linter) + expect_no_lint("x^(y + z)", linter) + expect_no_lint("x**(y + z)", linter) + expect_no_lint("a <- -(b)", linter) - expect_lint("(3^(3 + 2))", NULL, linter) - expect_lint("-(!!!symb)", NULL, linter) + expect_no_lint("(3^(3 + 2))", linter) + expect_no_lint("-(!!!symb)", linter) - expect_lint("'[[<-.data.frame'(object, y)", NULL, linter) - expect_lint("object@data@get('input')", NULL, linter) - expect_lint("x <- ~(. + y)", NULL, linter) + expect_no_lint("'[[<-.data.frame'(object, y)", linter) + expect_no_lint("object@data@get('input')", linter) + expect_no_lint("x <- ~(. + y)", linter) # the internal newline is required to trigger the lint - expect_lint("if (x > 1)\n x <- x[-(i)]", NULL, linter) + expect_no_lint("if (x > 1)\n x <- x[-(i)]", linter) # these don't violate the linter, even if they are strange coding practice - expect_lint("for (ii in 1:10) next()", NULL, linter) - expect_lint("for (ii in 1:10) break()", NULL, linter) + expect_no_lint("for (ii in 1:10) next()", linter) + expect_no_lint("for (ii in 1:10) break()", linter) }) test_that("spaces_left_parentheses_linter blocks disallowed usages", { @@ -111,3 +112,4 @@ test_that("lints vectorize", { spaces_left_parentheses_linter() ) }) +# nofuzz end diff --git a/tests/testthat/test-string_boundary_linter.R b/tests/testthat/test-string_boundary_linter.R index 54f915ae7..7e02c658d 100644 --- a/tests/testthat/test-string_boundary_linter.R +++ b/tests/testthat/test-string_boundary_linter.R @@ -102,6 +102,16 @@ test_that("string_boundary_linter blocks disallowed substr()/substring() usage", expect_lint("substring(x, start, nchar(x)) == 'abcde'", ends_message, linter) # more complicated expressions expect_lint("substring(colnames(x), start, nchar(colnames(x))) == 'abc'", ends_message, linter) + + # adversarial comments + expect_lint( + trim_some(" + substring(colnames(x), start, nchar(colnames( # comment + x))) == 'abc' + "), + ends_message, + linter + ) }) test_that("plain ^ or $ are skipped", { diff --git a/tests/testthat/test-strings_as_factors_linter.R b/tests/testthat/test-strings_as_factors_linter.R index a45624b80..52c570510 100644 --- a/tests/testthat/test-strings_as_factors_linter.R +++ b/tests/testthat/test-strings_as_factors_linter.R @@ -1,22 +1,34 @@ test_that("strings_as_factors_linter skips allowed usages", { linter <- strings_as_factors_linter() - expect_lint("data.frame(1:3)", NULL, linter) - expect_lint("data.frame(x = 1:3)", NULL, linter) + expect_no_lint("data.frame(1:3)", linter) + expect_no_lint("data.frame(x = 1:3)", linter) - expect_lint("data.frame(x = 'a', stringsAsFactors = TRUE)", NULL, linter) - expect_lint("data.frame(x = 'a', stringsAsFactors = FALSE)", NULL, linter) - expect_lint("data.frame(x = c('a', 'b'), stringsAsFactors = FALSE)", NULL, linter) + expect_no_lint("data.frame(x = 'a', stringsAsFactors = TRUE)", linter) + expect_no_lint("data.frame(x = 'a', stringsAsFactors = FALSE)", linter) + expect_no_lint("data.frame(x = c('a', 'b'), stringsAsFactors = FALSE)", linter) # strings in argument names to c() don't get linted - expect_lint("data.frame(x = c('a b' = 1L, 'b c' = 2L))", NULL, linter) + expect_no_lint("data.frame(x = c('a b' = 1L, 'b c' = 2L))", linter) # characters supplied to row.names are not affected - expect_lint("data.frame(x = 1:3, row.names = c('a', 'b', 'c'))", NULL, linter) + expect_no_lint("data.frame(x = 1:3, row.names = c('a', 'b', 'c'))", linter) # ambiguous cases passes - expect_lint("data.frame(x = c(xx, 'a'))", NULL, linter) - expect_lint("data.frame(x = c(foo(y), 'a'))", NULL, linter) + expect_no_lint("data.frame(x = c(xx, 'a'))", linter) + expect_no_lint("data.frame(x = c(foo(y), 'a'))", linter) + + # adversarial comments + expect_no_lint( + trim_some(" + data.frame( + x = 1:3, + row.names # comment + = c('a', 'b', 'c') + ) + "), + linter + ) }) test_that("strings_as_factors_linter blocks simple disallowed usages", { @@ -44,8 +56,8 @@ test_that("strings_as_factors_linters catches rep(char) usages", { expect_lint("data.frame(rep(c('a', 'b'), 10L))", lint_msg, linter) # literal char, not mixed or non-char - expect_lint("data.frame(rep(1L, 10L))", NULL, linter) - expect_lint("data.frame(rep(c(x, 'a'), 10L))", NULL, linter) + expect_no_lint("data.frame(rep(1L, 10L))", linter) + expect_no_lint("data.frame(rep(c(x, 'a'), 10L))", linter) # however, type promotion of literals is caught expect_lint("data.frame(rep(c(TRUE, 'a'), 10L))", lint_msg, linter) }) @@ -59,7 +71,7 @@ test_that("strings_as_factors_linter catches character(), as.character() usages" expect_lint("data.frame(a = as.character(x))", lint_msg, linter) # but not for row.names - expect_lint("data.frame(a = 1:10, row.names = as.character(1:10))", NULL, linter) + expect_no_lint("data.frame(a = 1:10, row.names = as.character(1:10))", linter) }) test_that("strings_as_factors_linter catches more functions with string output", { @@ -74,7 +86,7 @@ test_that("strings_as_factors_linter catches more functions with string output", expect_lint("data.frame(a = toString(x))", lint_msg, linter) expect_lint("data.frame(a = encodeString(x))", lint_msg, linter) # but not for row.names - expect_lint("data.frame(a = 1:10, row.names = paste(1:10))", NULL, linter) + expect_no_lint("data.frame(a = 1:10, row.names = paste(1:10))", linter) }) test_that("lints vectorize", { diff --git a/tests/testthat/test-trailing_blank_lines_linter.R b/tests/testthat/test-trailing_blank_lines_linter.R index 5b6f89511..f6060e0ec 100644 --- a/tests/testthat/test-trailing_blank_lines_linter.R +++ b/tests/testthat/test-trailing_blank_lines_linter.R @@ -1,13 +1,14 @@ +# nofuzz start test_that("trailing_blank_lines_linter doesn't block allowed usages", { linter <- trailing_blank_lines_linter() - expect_lint("blah", NULL, linter) - expect_lint("blah <- 1 ", NULL, linter) - expect_lint("blah <- 1\nblah", NULL, linter) - expect_lint("blah <- 1\nblah\n \n blah", NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint("blah <- 1 ", linter) + expect_no_lint("blah <- 1\nblah", linter) + expect_no_lint("blah <- 1\nblah\n \n blah", linter) tmp <- withr::local_tempfile(lines = "lm(y ~ x)") - expect_lint(file = tmp, checks = NULL, linters = linter) + expect_no_lint(file = tmp, linters = linter) }) test_that("trailing_blank_lines_linter detects disallowed usages", { @@ -158,3 +159,4 @@ test_that("blank lines in knitr chunks produce lints", { linters = linter ) }) +# nofuzz end diff --git a/tests/testthat/test-trailing_whitespace_linter.R b/tests/testthat/test-trailing_whitespace_linter.R index 329f5a24f..82e5e56bb 100644 --- a/tests/testthat/test-trailing_whitespace_linter.R +++ b/tests/testthat/test-trailing_whitespace_linter.R @@ -1,8 +1,9 @@ +# nofuzz start test_that("returns the correct linting", { linter <- trailing_whitespace_linter() lint_msg <- rex::rex("Remove trailing whitespace.") - expect_lint("blah", NULL, linter) + expect_no_lint("blah", linter) expect_lint( "blah <- 1 ", @@ -35,9 +36,8 @@ test_that("also handles completely empty lines per allow_empty_lines argument", trailing_whitespace_linter(allow_empty_lines = TRUE) ) - expect_lint( + expect_no_lint( "blah <- 1\n \n'hi'\na <- 2", - NULL, trailing_whitespace_linter(allow_empty_lines = TRUE) ) }) @@ -46,7 +46,7 @@ test_that("also handles trailing whitespace in string constants", { linter <- trailing_whitespace_linter() lint_msg <- rex::rex("Remove trailing whitespace.") - expect_lint("blah <- ' \n \n'", NULL, linter) + expect_no_lint("blah <- ' \n \n'", linter) # Don't exclude past the end of string expect_lint( "blah <- ' \n \n' ", @@ -68,3 +68,4 @@ test_that("also handles trailing whitespace in string constants", { trailing_whitespace_linter(allow_in_strings = FALSE) ) }) +# nofuzz end diff --git a/tests/testthat/test-unnecessary_placeholder_linter.R b/tests/testthat/test-unnecessary_placeholder_linter.R index 8ee413a4b..d69cbf3ed 100644 --- a/tests/testthat/test-unnecessary_placeholder_linter.R +++ b/tests/testthat/test-unnecessary_placeholder_linter.R @@ -53,3 +53,13 @@ test_that("lints vectorize", { # nofuzz unnecessary_placeholder_linter() ) }) + +test_that("logic survives adversarial commenting", { + expect_no_lint( + trim_some(" + x %T>% foo(arg = # comment + .) + "), + unnecessary_placeholder_linter() + ) +}) diff --git a/tests/testthat/test-unreachable_code_linter.R b/tests/testthat/test-unreachable_code_linter.R index b54d3b11e..2a9cf20d4 100644 --- a/tests/testthat/test-unreachable_code_linter.R +++ b/tests/testthat/test-unreachable_code_linter.R @@ -4,7 +4,7 @@ test_that("unreachable_code_linter works in simple function", { return(bar) } ") - expect_lint(lines, NULL, unreachable_code_linter()) + expect_no_lint(lines, unreachable_code_linter()) }) test_that("unreachable_code_linter works in sub expressions", { @@ -55,44 +55,43 @@ test_that("unreachable_code_linter works in sub expressions", { linter ) - lines <- trim_some(" - foo <- function(bar) { - if (bar) { - return(bar) # Test comment - } - while (bar) { - return(bar) # 5 + 3 - } - repeat { - return(bar) # Test comment - } - - } - ") - - expect_lint(lines, NULL, linter) + expect_no_lint( # nofuzz + trim_some(" + foo <- function(bar) { + if (bar) { + return(bar) # Test comment + } + while (bar) { + return(bar) # 5 + 3 + } + repeat { + return(bar) # Test comment + } - lines <- trim_some(" - foo <- function(bar) { - if (bar) { - return(bar); x <- 2 - } else { - return(bar); x <- 3 - } - while (bar) { - return(bar); 5 + 3 } - repeat { - return(bar); test() - } - for(i in 1:3) { - return(bar); 5 + 4 - } - } - ") + "), + linter + ) - expect_lint( - lines, + expect_lint( + trim_some(" + foo <- function(bar) { + if (bar) { + return(bar); x <- 2 + } else { + return(bar); x <- 3 + } + while (bar) { + return(bar); 5 + 3 + } + repeat { + return(bar); test() + } + for(i in 1:3) { + return(bar); 5 + 4 + } + } + "), list( list(line_number = 3L, message = msg), list(line_number = 5L, message = msg), @@ -102,6 +101,40 @@ test_that("unreachable_code_linter works in sub expressions", { ), linter ) + + expect_lint( + trim_some(" + foo <- function(bar) { + if (bar) { + return(bar); # comment + x <- 2 + } else { + return(bar); # comment + x <- 3 + } + while (bar) { + return(bar); # comment + 5 + 3 + } + repeat { + return(bar); # comment + test() + } + for(i in 1:3) { + return(bar); # comment + 5 + 4 + } + } + "), + list( + list(line_number = 4L, message = msg), + list(line_number = 7L, message = msg), + list(line_number = 11L, message = msg), + list(line_number = 15L, message = msg), + list(line_number = 19L, message = msg) + ), + linter + ) }) test_that("unreachable_code_linter works with next and break in sub expressions", { @@ -144,48 +177,47 @@ test_that("unreachable_code_linter works with next and break in sub expressions" linter ) - lines <- trim_some(" - foo <- function(bar) { - if (bar) { - break # Test comment - } else { - next # Test comment - } - while (bar) { - next # 5 + 3 - } - repeat { - next # Test comment - } - for(i in 1:3) { - break # 5 + 4 - } - } - ") - - expect_lint(lines, NULL, linter) - - lines <- trim_some(" - foo <- function(bar) { - if (bar) { - next; x <- 2 - } else { - break; x <- 3 - } - while (bar) { - break; 5 + 3 - } - repeat { - next; test() - } - for(i in 1:3) { - break; 5 + 4 + expect_no_lint( # nofuzz + trim_some(" + foo <- function(bar) { + if (bar) { + break # Test comment + } else { + next # Test comment + } + while (bar) { + next # 5 + 3 + } + repeat { + next # Test comment + } + for(i in 1:3) { + break # 5 + 4 + } } - } - ") + "), + linter + ) expect_lint( - lines, + trim_some(" + foo <- function(bar) { + if (bar) { + next; x <- 2 + } else { + break; x <- 3 + } + while (bar) { + break; 5 + 3 + } + repeat { + next; test() + } + for(i in 1:3) { + break; 5 + 4 + } + } + "), list( list(line_number = 3L, message = msg), list(line_number = 5L, message = msg), @@ -195,14 +227,49 @@ test_that("unreachable_code_linter works with next and break in sub expressions" ), linter ) + + # also with comments + expect_lint( + trim_some(" + foo <- function(bar) { + if (bar) { + next; # comment + x <- 2 + } else { + break; # comment + x <- 3 + } + while (bar) { + break; # comment + 5 + 3 + } + repeat { + next; # comment + test() + } + for(i in 1:3) { + break; # comment + 5 + 4 + } + } + "), + list( + list(line_number = 4L, message = msg), + list(line_number = 7L, message = msg), + list(line_number = 11L, message = msg), + list(line_number = 15L, message = msg), + list(line_number = 19L, message = msg) + ), + linter + ) }) test_that("unreachable_code_linter ignores expressions that aren't functions", { - expect_lint("x + 1", NULL, unreachable_code_linter()) + expect_no_lint("x + 1", unreachable_code_linter()) }) test_that("unreachable_code_linter ignores anonymous/inline functions", { - expect_lint("lapply(rnorm(10), function(x) x + 1)", NULL, unreachable_code_linter()) + expect_no_lint("lapply(rnorm(10), function(x) x + 1)", unreachable_code_linter()) }) test_that("unreachable_code_linter passes on multi-line functions", { @@ -212,27 +279,31 @@ test_that("unreachable_code_linter passes on multi-line functions", { return(y) } ") - expect_lint(lines, NULL, unreachable_code_linter()) + expect_no_lint(lines, unreachable_code_linter()) }) -test_that("unreachable_code_linter ignores comments on the same expression", { - lines <- trim_some(" - foo <- function(x) { - return( - y^2 - ) # y^3 - } - ") - expect_lint(lines, NULL, unreachable_code_linter()) +test_that("unreachable_code_linter ignores comments on the same expression", { # nofuzz + linter <- unreachable_code_linter() + + expect_no_lint( + trim_some(" + foo <- function(x) { + return( + y^2 + ) # y^3 + } + "), + linter + ) }) -test_that("unreachable_code_linter ignores comments on the same line", { +test_that("unreachable_code_linter ignores comments on the same line", { # nofuzz lines <- trim_some(" foo <- function(x) { return(y^2) # y^3 } ") - expect_lint(lines, NULL, unreachable_code_linter()) + expect_no_lint(lines, unreachable_code_linter()) }) test_that("unreachable_code_linter identifies simple unreachable code", { @@ -268,7 +339,7 @@ test_that("unreachable_code_linter finds unreachable comments", { ) }) -test_that("unreachable_code_linter finds expressions in the same line", { +test_that("unreachable_code_linter finds expressions in the same line", { # nofuzz msg <- rex::rex("Remove code and comments coming after return() or stop()") linter <- unreachable_code_linter() @@ -349,7 +420,7 @@ test_that("unreachable_code_linter finds code after stop()", { test_that("unreachable_code_linter ignores code after foo$stop(), which might be stopping a subprocess, for example", { linter <- unreachable_code_linter() - expect_lint( + expect_no_lint( trim_some(" foo <- function(x) { bar <- get_process() @@ -357,10 +428,9 @@ test_that("unreachable_code_linter ignores code after foo$stop(), which might be TRUE } "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" foo <- function(x) { bar <- get_process() @@ -368,7 +438,6 @@ test_that("unreachable_code_linter ignores code after foo$stop(), which might be TRUE } "), - NULL, linter ) }) @@ -381,7 +450,7 @@ test_that("unreachable_code_linter ignores terminal nolint end comments", { lintr.exclude_end = "#\\s*TestNoLintEnd" )) - expect_lint( + expect_no_lint( trim_some(" foo <- function() { do_something @@ -391,11 +460,10 @@ test_that("unreachable_code_linter ignores terminal nolint end comments", { # TestNoLintEnd } "), - NULL, list(linter, one_linter = assignment_linter()) ) - expect_lint( + expect_no_lint( trim_some(" foo <- function() { do_something @@ -405,7 +473,6 @@ test_that("unreachable_code_linter ignores terminal nolint end comments", { # TestNoLintEnd } "), - NULL, linter ) }) @@ -593,14 +660,14 @@ test_that("function shorthand is handled", { test_that("Do not lint inline else after stop", { - expect_lint("if (x > 3L) stop() else x + 3", NULL, unreachable_code_linter()) + expect_no_lint("if (x > 3L) stop() else x + 3", unreachable_code_linter()) }) test_that("Do not lint inline else after stop in inline function", { linter <- unreachable_code_linter() - expect_lint("function(x) if (x > 3L) stop() else x + 3", NULL, linter) - expect_lint("function(x) if (x > 3L) { stop() } else {x + 3}", NULL, linter) + expect_no_lint("function(x) if (x > 3L) stop() else x + 3", linter) + expect_no_lint("function(x) if (x > 3L) { stop() } else {x + 3}", linter) }) test_that("Do not lint inline else after stop in inline lambda function", { @@ -608,8 +675,8 @@ test_that("Do not lint inline else after stop in inline lambda function", { linter <- unreachable_code_linter() - expect_lint("\\(x) if (x > 3L) stop() else x + 3", NULL, linter) - expect_lint("\\(x){ if (x > 3L) stop() else x + 3 }", NULL, linter) + expect_no_lint("\\(x) if (x > 3L) stop() else x + 3", linter) + expect_no_lint("\\(x){ if (x > 3L) stop() else x + 3 }", linter) }) test_that("allow_comment_regex= works", { @@ -619,18 +686,17 @@ test_that("allow_comment_regex= works", { linter_xxxx <- unreachable_code_linter(allow_comment_regex = "#.*xxxx") linter_x1x2 <- unreachable_code_linter(allow_comment_regex = c("#x", "#y")) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) # nocov end } "), - NULL, linter_covr ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) @@ -638,22 +704,20 @@ test_that("allow_comment_regex= works", { # nocov end } "), - NULL, linter_covr ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) # ABCDxxxx } "), - NULL, linter_xxxx ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) @@ -661,22 +725,20 @@ test_that("allow_comment_regex= works", { # ABCDxxxx } "), - NULL, linter_xxxx ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) #x } "), - NULL, linter_x1x2 ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) @@ -684,12 +746,11 @@ test_that("allow_comment_regex= works", { #yDEF } "), - NULL, linter_x1x2 ) # might contain capture groups, #2678 - expect_lint( + expect_no_lint( trim_some(" function() { stop('a') @@ -697,7 +758,6 @@ test_that("allow_comment_regex= works", { # ab } "), - NULL, unreachable_code_linter(allow_comment_regex = "#\\s*(a|ab|abc)") ) }) @@ -710,18 +770,17 @@ test_that("allow_comment_regex= obeys covr's custom exclusion when set", { linter_covr <- unreachable_code_linter() - expect_lint( + expect_no_lint( trim_some(" function() { return(1) # TestNoCovEnd } "), - NULL, linter_covr ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) @@ -729,7 +788,6 @@ test_that("allow_comment_regex= obeys covr's custom exclusion when set", { # TestNoCovEnd } "), - NULL, linter_covr ) })