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 8daf63fe2..fa6cd1f69 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/NAMESPACE b/NAMESPACE
index 8c20f1f68..ba4e2f0b1 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -192,4 +192,5 @@ importFrom(xml2,xml_find_first)
 importFrom(xml2,xml_find_lgl)
 importFrom(xml2,xml_find_num)
 importFrom(xml2,xml_name)
+importFrom(xml2,xml_parent)
 importFrom(xml2,xml_text)
diff --git a/NEWS.md b/NEWS.md
index af6d69e88..39817f20b 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -31,6 +31,38 @@
 * `object_usage_linter()` gains argument `interpret_extensions` to govern which false positive-prone common syntaxes should be checked for used objects (#1472, @MichaelChirico). Currently `"glue"` (renamed from earlier argument `interpret_glue`) and `"rlang"` are supported. The latter newly covers usage of the `.env` pronoun like `.env$key`, where `key` was previously missed as being a used variable.
 * `boolean_arithmetic_linter()` finds many more cases like `sum(x | y) == 0` where the total of a known-logical vector is compared to 0 (#1580, @MichaelChirico).
 * 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).
+* 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()`
+   + `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 4c7add043..474b29a32 100644
--- a/R/brace_linter.R
+++ b/R/brace_linter.R
@@ -122,7 +122,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/comparison_negation_linter.R b/R/comparison_negation_linter.R
index 37ae8e697..6a5fa4ec1 100644
--- a/R/comparison_negation_linter.R
+++ b/R/comparison_negation_linter.R
@@ -65,13 +65,13 @@ comparison_negation_linter <- function() {
 
     bad_expr <- xml_find_all(xml, xpath)
 
-    comparator_node <- xml_find_first(bad_expr, "expr/expr/*[2]")
+    comparator_node <- xml_find_first(bad_expr, "expr/expr/*[not(self::COMMENT)][2]")
     comparator_name <- xml_name(comparator_node)
 
     # "typical" case is assumed to be !(x == y), so try that first, and back
     #   up to the less nested case. there may be a cleaner way to do this...
     unnested <- !comparator_name %in% names(comparator_inverses)
-    comparator_node[unnested] <- xml_find_first(bad_expr[unnested], "expr/*[2]")
+    comparator_node[unnested] <- xml_find_first(bad_expr[unnested], "expr/*[not(self::COMMENT)][2]")
     comparator_name[unnested] <- xml_name(comparator_node[unnested])
 
     comparator_text <- xml_text(comparator_node)
diff --git a/R/conjunct_test_linter.R b/R/conjunct_test_linter.R
index 95eee5150..8fd825b4a 100644
--- a/R/conjunct_test_linter.R
+++ b/R/conjunct_test_linter.R
@@ -82,7 +82,8 @@ conjunct_test_linter <- function(allow_named_stopifnot = TRUE,
   following-sibling::expr[1][AND2]
     /parent::expr
   "
-  named_stopifnot_condition <- if (allow_named_stopifnot) "and not(preceding-sibling::*[1][self::EQ_SUB])" else ""
+  named_stopifnot_condition <-
+    if (allow_named_stopifnot) "and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])" else ""
   stopifnot_xpath <- glue("
   following-sibling::expr[1][AND2 {named_stopifnot_condition}]
     /parent::expr
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 <equal_assign>, not <expr>, 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/fixed_regex_linter.R b/R/fixed_regex_linter.R
index 02ce1e576..12b45d0a7 100644
--- a/R/fixed_regex_linter.R
+++ b/R/fixed_regex_linter.R
@@ -120,7 +120,7 @@ fixed_regex_linter <- function(allow_unescaped = FALSE) {
         and not({ in_pipe_cond })
       ) or (
         STR_CONST
-        and preceding-sibling::*[2][self::SYMBOL_SUB/text() = 'pattern']
+        and preceding-sibling::*[not(self::COMMENT)][2][self::SYMBOL_SUB/text() = 'pattern']
       )
     ]
   ")
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/ifelse_censor_linter.R b/R/ifelse_censor_linter.R
index fd9d1e9a5..73710f27d 100644
--- a/R/ifelse_censor_linter.R
+++ b/R/ifelse_censor_linter.R
@@ -36,20 +36,19 @@
 #' @export
 ifelse_censor_linter <- function() {
   xpath <- glue("
-  following-sibling::expr[
+  self::*[expr[
     (LT or GT or LE or GE)
     and expr[1] = following-sibling::expr
     and expr[2] = following-sibling::expr
-  ]
-    /parent::expr
-  ")
+  ]]")
 
   Linter(linter_level = "expression", function(source_expression) {
-    ifelse_calls <- source_expression$xml_find_function_calls(ifelse_funs)
+    ifelse_calls <- xml_parent(source_expression$xml_find_function_calls(ifelse_funs))
+    ifelse_calls <- strip_comments_from_subtree(ifelse_calls)
     bad_expr <- xml_find_all(ifelse_calls, xpath)
 
     matched_call <- xp_call_name(bad_expr)
-    operator <- xml_find_chr(bad_expr, "string(expr[2]/*[2])")
+    operator <- xml_find_chr(bad_expr, "string(expr[2]/*[not(self::COMMENT)][2])")
     match_first <- !is.na(xml_find_first(bad_expr, "expr[2][expr[1] = following-sibling::expr[1]]"))
     optimizer <- ifelse((operator %in% c("<", "<=")) == match_first, "pmin", "pmax")
     first_var <- rep_len("x", length(match_first))
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/lintr-package.R b/R/lintr-package.R
index cd0b9bd5d..c9a36b58f 100644
--- a/R/lintr-package.R
+++ b/R/lintr-package.R
@@ -15,7 +15,8 @@
 #' @importFrom tools R_user_dir
 #' @importFrom utils capture.output getParseData  globalVariables head relist tail
 #' @importFrom xml2 as_list
-#'   xml_attr xml_children xml_find_all xml_find_chr xml_find_lgl xml_find_num xml_find_first xml_name xml_text
+#'   xml_attr xml_children xml_find_all xml_find_chr xml_find_lgl xml_find_num
+#'   xml_find_first xml_name xml_parent xml_text
 ## lintr namespace: end
 NULL
 
diff --git a/R/literal_coercion_linter.R b/R/literal_coercion_linter.R
index 12b8cf39c..b458eaf43 100644
--- a/R/literal_coercion_linter.R
+++ b/R/literal_coercion_linter.R
@@ -61,7 +61,7 @@ literal_coercion_linter <- function() {
     not(OP-DOLLAR or OP-AT)
     and (
       NUM_CONST[not(contains(translate(text(), 'E', 'e'), 'e'))]
-      or STR_CONST[not(following-sibling::*[1][self::EQ_SUB])]
+      or STR_CONST[not(following-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])]
     )
   "
   xpath <- glue("
@@ -89,6 +89,7 @@ literal_coercion_linter <- function() {
       )
       # nocov end
     } else {
+      bad_expr <- strip_comments_from_subtree(bad_expr)
       # duplicate, unless we add 'rlang::' and it wasn't there originally
       coercion_str <- report_str <- xml_text(bad_expr)
       if (any(is_rlang_coercer) && !("package:rlang" %in% search())) {
diff --git a/R/matrix_apply_linter.R b/R/matrix_apply_linter.R
index 6691bc00f..2a99100d4 100644
--- a/R/matrix_apply_linter.R
+++ b/R/matrix_apply_linter.R
@@ -97,6 +97,7 @@ matrix_apply_linter <- function() {
   Linter(linter_level = "expression", function(source_expression) {
     xml_calls <- source_expression$xml_find_function_calls("apply")
     bad_expr <- xml_find_all(xml_calls, xpath)
+    bad_expr <- strip_comments_from_subtree(bad_expr)
 
     variable <- xml_text(xml_find_all(bad_expr, variable_xpath))
 
diff --git a/R/nzchar_linter.R b/R/nzchar_linter.R
index 6e44b804e..e525f2977 100644
--- a/R/nzchar_linter.R
+++ b/R/nzchar_linter.R
@@ -112,8 +112,9 @@ nzchar_linter <- function() {
   #   its "opposite" (not inverse) if the bad usage is on the RHS,
   #   e.g. 0 < nchar(x) has to be treated as nchar(x) > 0.
   op_for_msg <- function(expr, const) {
-    op <- xml_name(xml_find_first(expr, "*[2]"))
-    maybe_needs_flip <- !is.na(xml_find_first(expr, sprintf("*[1][%s]", const)))
+    op <- xml_name(xml_find_first(expr, "*[not(self::COMMENT)][2]"))
+    maybe_needs_flip <-
+      !is.na(xml_find_first(expr, sprintf("*[not(self::COMMENT)][1][%s]", const)))
 
     ordered_ops <- c("GT", "GE", "LE", "LT")
     ordered_idx <- match(op, ordered_ops)
diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R
index 70ebe76c1..b41211633 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]"
@@ -91,7 +99,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(
@@ -178,8 +188,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/outer_negation_linter.R b/R/outer_negation_linter.R
index 6a5ce6e18..584573fd6 100644
--- a/R/outer_negation_linter.R
+++ b/R/outer_negation_linter.R
@@ -44,7 +44,7 @@ outer_negation_linter <- function() {
       not(expr[
         position() > 1
         and not(OP-EXCLAMATION)
-        and not(preceding-sibling::*[1][self::EQ_SUB])
+        and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])
       ])
     ]
   "
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 b6471e72f..5ac1d1478 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
-  #   <expr>[grepl(pattern, <expr>)] 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(
@@ -76,7 +74,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/shared_constants.R b/R/shared_constants.R
index 20c054c11..dbad48dcb 100644
--- a/R/shared_constants.R
+++ b/R/shared_constants.R
@@ -220,7 +220,7 @@ object_name_xpath <- local({
   ]"
 
   # either an argument supplied positionally, i.e., not like 'arg = val', or the call <expr>
-  not_kwarg_cond <- "not(preceding-sibling::*[1][self::EQ_SUB])"
+  not_kwarg_cond <- "not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])"
 
   glue(xp_strip_comments("
   //SYMBOL[ {sprintf(xp_assignment_target_fmt, 'ancestor', '')} ]
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/sprintf_linter.R b/R/sprintf_linter.R
index 1eb3b345d..fb06af173 100644
--- a/R/sprintf_linter.R
+++ b/R/sprintf_linter.R
@@ -38,9 +38,12 @@ sprintf_linter <- function() {
 
   pipes <- setdiff(magrittr_pipes, "%$%")
   in_pipe_xpath <- glue("self::expr[
-    preceding-sibling::*[1][self::PIPE or self::SPECIAL[{ xp_text_in_table(pipes) }]]
+    preceding-sibling::*[not(self::COMMENT)][1][
+      self::PIPE
+      or self::SPECIAL[{ xp_text_in_table(pipes) }
+    ]]
     and (
-      preceding-sibling::*[2]/STR_CONST
+      preceding-sibling::*[not(self::COMMENT)][2]/STR_CONST
       or SYMBOL_SUB[text() = 'fmt']/following-sibling::expr[1]/STR_CONST
     )
   ]")
@@ -89,7 +92,7 @@ sprintf_linter <- function() {
       arg_idx <- 2L:length(parsed_expr)
       parsed_expr[arg_idx + 1L] <- parsed_expr[arg_idx]
       names(parsed_expr)[arg_idx + 1L] <- arg_names[arg_idx]
-      parsed_expr[[2L]] <- xml2lang(xml_find_first(xml, "preceding-sibling::*[2]"))
+      parsed_expr[[2L]] <- xml2lang(xml_find_first(xml, "preceding-sibling::*[not(self::COMMENT)][2]"))
       names(parsed_expr)[2L] <- ""
     }
     parsed_expr <- zap_extra_args(parsed_expr)
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_concatenation_linter.R b/R/unnecessary_concatenation_linter.R
index 271d2ece6..519662a91 100644
--- a/R/unnecessary_concatenation_linter.R
+++ b/R/unnecessary_concatenation_linter.R
@@ -66,7 +66,7 @@ unnecessary_concatenation_linter <- function(allow_single_expression = TRUE) { #
 
   pipes <- setdiff(magrittr_pipes, "%$%")
   to_pipe_xpath <- glue("
-    ./preceding-sibling::*[1][
+    ./preceding-sibling::*[not(self::COMMENT)][1][
       self::PIPE or
       self::SPECIAL[{ xp_text_in_table(pipes) }]
     ]
diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R
index f2f62232d..76dbf9c6b 100644
--- a/R/unnecessary_lambda_linter.R
+++ b/R/unnecessary_lambda_linter.R
@@ -125,10 +125,14 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) {
         .//expr[
           position() = 2
           and preceding-sibling::expr/SYMBOL_FUNCTION_CALL
-          and not(preceding-sibling::*[1][self::EQ_SUB])
+          and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])
           and not(parent::expr[
             preceding-sibling::expr[not(SYMBOL_FUNCTION_CALL)]
-            or following-sibling::*[not(self::OP-RIGHT-PAREN or self::OP-RIGHT-BRACE)]
+            or following-sibling::*[not(
+              self::OP-RIGHT-PAREN
+              or self::OP-RIGHT-BRACE
+              or self::COMMENT
+            )]
           ])
         ]/SYMBOL
     ]
@@ -143,7 +147,12 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) {
   purrr_fun_xpath <- glue("
   following-sibling::expr[
     OP-TILDE
-    and expr[OP-LEFT-PAREN/following-sibling::expr[1][not(preceding-sibling::*[2][self::SYMBOL_SUB])]/{purrr_symbol}]
+    and expr
+      /OP-LEFT-PAREN
+      /following-sibling::expr[1][
+        not(preceding-sibling::*[not(self::COMMENT)][2][self::SYMBOL_SUB])
+      ]
+      /{purrr_symbol}
     and not(expr/OP-LEFT-PAREN/following-sibling::expr[position() > 1]//{purrr_symbol})
   ]")
 
diff --git a/R/unnecessary_nesting_linter.R b/R/unnecessary_nesting_linter.R
index 3490f9409..71e7b432e 100644
--- a/R/unnecessary_nesting_linter.R
+++ b/R/unnecessary_nesting_linter.R
@@ -234,7 +234,7 @@ unnecessary_nesting_linter <- function(
       # catch if (cond) { if (other_cond) { ... } }
       #   count(*): only OP-LEFT-BRACE, one <expr>, and OP-RIGHT-BRACE.
       #             Note that third node could be <expr_or_assign_or_help>.
-      "following-sibling::expr[OP-LEFT-BRACE and count(*) = 3]/expr[IF and not(ELSE)]"
+      "following-sibling::expr[OP-LEFT-BRACE and count(*) - count(COMMENT) = 3]/expr[IF and not(ELSE)]"
     ),
     collapse = " | "
   )
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 <exprlist> 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 748a73658..65271d74e 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -87,20 +87,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/R/vector_logic_linter.R b/R/vector_logic_linter.R
index adc17d9ab..029b23a33 100644
--- a/R/vector_logic_linter.R
+++ b/R/vector_logic_linter.R
@@ -77,7 +77,7 @@ vector_logic_linter <- function() {
       and preceding-sibling::*[
         self::IF
         or self::WHILE
-        or self::expr[SYMBOL_FUNCTION_CALL[text() = 'expect_true' or text() = 'expect_false']]
+        or self::expr/SYMBOL_FUNCTION_CALL[text() = 'expect_true' or text() = 'expect_false']
       ]
     ]
     and not(ancestor::expr[
@@ -100,7 +100,7 @@ vector_logic_linter <- function() {
       and not(preceding-sibling::OP-LEFT-BRACKET)
       and not(preceding-sibling::*[not(self::COMMENT)][2][self::SYMBOL_SUB and text() = 'circular'])
     ]
-    /*[2]
+    /*[not(self::COMMENT)][2]
   "
 
   Linter(linter_level = "expression", function(source_expression) {
diff --git a/R/xml_utils.R b/R/xml_utils.R
index 3b0546da6..a4fe98e9b 100644
--- a/R/xml_utils.R
+++ b/R/xml_utils.R
@@ -12,6 +12,29 @@ xml2lang <- function(x) {
   str2lang(paste(xml_text(x_strip_comments), collapse = " "))
 }
 
+# TODO(r-lib/xml2#341): Use xml_clone() instead.
+clone_xml_ <- function(x) {
+  tmp_doc <- tempfile()
+  on.exit(unlink(tmp_doc))
+
+  doc <- xml2::xml_new_root("root")
+  for (ii in seq_along(x)) {
+    xml2::write_xml(x[[ii]], tmp_doc)
+    xml2::xml_add_child(doc, xml2::read_xml(tmp_doc))
+  }
+  xml_find_all(doc, "*")
+}
+
+# caveat: whether this is a copy or not is inconsistent. assume the output is read-only!
+strip_comments_from_subtree <- function(expr) {
+  comments <- xml_find_all(expr, ".//COMMENT")
+  if (length(comments) == 0L) {
+    return(expr)
+  }
+  expr <- clone_xml_(expr)
+  for (comment in xml_find_all(expr, ".//COMMENT")) xml2::xml_remove(comment)
+  expr
+}
 
 safe_parse_to_xml <- function(parsed_content) {
   if (is.null(parsed_content)) {
diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R
index 84f1ea606..d2d87500d 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 0d0532f8e..2257dc49f 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(
@@ -617,3 +634,4 @@ test_that("function shorthand is treated like 'full' function", {
     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-comparison_negation_linter.R b/tests/testthat/test-comparison_negation_linter.R
index 8fd32a256..1867f2ea7 100644
--- a/tests/testthat/test-comparison_negation_linter.R
+++ b/tests/testthat/test-comparison_negation_linter.R
@@ -2,16 +2,16 @@ test_that("comparison_negation_linter skips allowed usages", {
   linter <- comparison_negation_linter()
 
   # doesn't apply to joint statements
-  expect_lint("!(x == y | y == z)", NULL, linter)
+  expect_no_lint("!(x == y | y == z)", linter)
   # don't force de Morgan's laws
-  expect_lint("!(x & y)", NULL, linter)
+  expect_no_lint("!(x & y)", linter)
 
   # naive xpath will include !foo(x) cases
-  expect_lint("!any(x > y)", NULL, linter)
+  expect_no_lint("!any(x > y)", linter)
   # ditto for tidyeval cases
-  expect_lint("!!target == 1 ~ 'target'", NULL, linter)
+  expect_no_lint("!!target == 1 ~ 'target'", linter)
   # ditto for !x[f == g]
-  expect_lint("!passes.test[stage == 1]", NULL, linter)
+  expect_no_lint("!passes.test[stage == 1]", linter)
 })
 
 local({
@@ -61,3 +61,14 @@ test_that("Lints vectorize", {
     comparison_negation_linter()
   )
 })
+
+test_that("logic survives adversarial comments", {
+  expect_lint(
+    trim_some("
+      !(x #
+      > y)
+    "),
+    rex::rex("Use x <= y, not !(x > y)"),
+    comparison_negation_linter()
+  )
+})
diff --git a/tests/testthat/test-conjunct_test_linter.R b/tests/testthat/test-conjunct_test_linter.R
index 047d2456d..d08e46d4f 100644
--- a/tests/testthat/test-conjunct_test_linter.R
+++ b/tests/testthat/test-conjunct_test_linter.R
@@ -1,21 +1,25 @@
 test_that("conjunct_test_linter skips allowed usages of expect_true", {
-  expect_lint("expect_true(x)", NULL, conjunct_test_linter())
-  expect_lint("testthat::expect_true(x, y, z)", NULL, conjunct_test_linter())
+  linter <- conjunct_test_linter()
+
+  expect_no_lint("expect_true(x)", linter)
+  expect_no_lint("testthat::expect_true(x, y, z)", linter)
 
   # more complicated expression
-  expect_lint("expect_true(x || (y && z))", NULL, conjunct_test_linter())
+  expect_no_lint("expect_true(x || (y && z))", linter)
   # the same by operator precedence, though not obvious a priori
-  expect_lint("expect_true(x || y && z)", NULL, conjunct_test_linter())
-  expect_lint("expect_true(x && y || z)", NULL, conjunct_test_linter())
+  expect_no_lint("expect_true(x || y && z)", linter)
+  expect_no_lint("expect_true(x && y || z)", linter)
 })
 
 test_that("conjunct_test_linter skips allowed usages of expect_true", {
-  expect_lint("expect_false(x)", NULL, conjunct_test_linter())
-  expect_lint("testthat::expect_false(x, y, z)", NULL, conjunct_test_linter())
+  linter <- conjunct_test_linter()
+
+  expect_no_lint("expect_false(x)", linter)
+  expect_no_lint("testthat::expect_false(x, y, z)", linter)
 
   # more complicated expression
   # (NB: xx && yy || zz and xx || yy && zz both parse with || first)
-  expect_lint("expect_false(x && (y || z))", NULL, conjunct_test_linter())
+  expect_no_lint("expect_false(x && (y || z))", linter)
 })
 
 test_that("conjunct_test_linter blocks && conditions with expect_true()", {
@@ -43,14 +47,14 @@ test_that("conjunct_test_linter blocks || conditions with expect_false()", {
 test_that("conjunct_test_linter skips allowed stopifnot() and assert_that() usages", {
   linter <- conjunct_test_linter()
 
-  expect_lint("stopifnot(x)", NULL, linter)
-  expect_lint("assert_that(x, y, z)", NULL, linter)
+  expect_no_lint("stopifnot(x)", linter)
+  expect_no_lint("assert_that(x, y, z)", linter)
 
   # more complicated expression
-  expect_lint("stopifnot(x || (y && z))", NULL, linter)
+  expect_no_lint("stopifnot(x || (y && z))", linter)
   # the same by operator precedence, though not obvious a priori
-  expect_lint("stopifnot(x || y && z)", NULL, linter)
-  expect_lint("assertthat::assert_that(x && y || z)", NULL, linter)
+  expect_no_lint("stopifnot(x || y && z)", linter)
+  expect_no_lint("assertthat::assert_that(x && y || z)", linter)
 })
 
 test_that("conjunct_test_linter blocks simple disallowed usages of stopifnot() and assert_that()", {
@@ -66,12 +70,23 @@ test_that("conjunct_test_linter blocks simple disallowed usages of stopifnot() a
 })
 
 test_that("conjunct_test_linter's allow_named_stopifnot argument works", {
+  linter <- conjunct_test_linter()
+
   # allowed by default
-  expect_lint(
+  expect_no_lint(
     "stopifnot('x must be a logical scalar' = length(x) == 1 && is.logical(x) && !is.na(x))",
-    NULL,
-    conjunct_test_linter()
+    linter
   )
+  # including with intervening comment
+  expect_no_lint(
+    trim_some("
+      stopifnot('x must be a logical scalar' = # comment
+        length(x) == 1 && is.logical(x) && !is.na(x)
+      )
+    "),
+    linter
+  )
+
   expect_lint(
     "stopifnot('x is a logical scalar' = length(x) == 1 && is.logical(x) && !is.na(x))",
     rex::rex("Write multiple conditions like stopifnot(A, B)"),
@@ -82,11 +97,11 @@ test_that("conjunct_test_linter's allow_named_stopifnot argument works", {
 test_that("conjunct_test_linter skips allowed usages", {
   linter <- conjunct_test_linter()
 
-  expect_lint("dplyr::filter(DF, A, B)", NULL, linter)
-  expect_lint("dplyr::filter(DF, !(A & B))", NULL, linter)
+  expect_no_lint("dplyr::filter(DF, A, B)", linter)
+  expect_no_lint("dplyr::filter(DF, !(A & B))", linter)
   # | is the "top-level" operator here
-  expect_lint("dplyr::filter(DF, A & B | C)", NULL, linter)
-  expect_lint("dplyr::filter(DF, A | B & C)", NULL, linter)
+  expect_no_lint("dplyr::filter(DF, A & B | C)", linter)
+  expect_no_lint("dplyr::filter(DF, A | B & C)", linter)
 })
 
 test_that("conjunct_test_linter blocks simple disallowed usages", {
@@ -105,22 +120,22 @@ test_that("conjunct_test_linter respects its allow_filter argument", {
   linter_dplyr <- conjunct_test_linter(allow_filter = "not_dplyr")
   lint_msg <- rex::rex("Use dplyr::filter(DF, A, B) instead of dplyr::filter(DF, A & B)")
 
-  expect_lint("dplyr::filter(DF, A & B)", NULL, linter_always)
-  expect_lint("dplyr::filter(DF, A & B & C)", NULL, linter_always)
-  expect_lint("DF %>% dplyr::filter(A & B)", NULL, linter_always)
+  expect_no_lint("dplyr::filter(DF, A & B)", linter_always)
+  expect_no_lint("dplyr::filter(DF, A & B & C)", linter_always)
+  expect_no_lint("DF %>% dplyr::filter(A & B)", linter_always)
   expect_lint("dplyr::filter(DF, A & B)", lint_msg, linter_dplyr)
   expect_lint("dplyr::filter(DF, A & B & C)", lint_msg, linter_dplyr)
   expect_lint("DF %>% dplyr::filter(A & B)", lint_msg, linter_dplyr)
-  expect_lint("filter(DF, A & B)", NULL, linter_dplyr)
-  expect_lint("filter(DF, A & B & C)", NULL, linter_dplyr)
-  expect_lint("DF %>% filter(A & B)", NULL, linter_dplyr)
+  expect_no_lint("filter(DF, A & B)", linter_dplyr)
+  expect_no_lint("filter(DF, A & B & C)", linter_dplyr)
+  expect_no_lint("DF %>% filter(A & B)", linter_dplyr)
 })
 
 test_that("filter() is assumed to be dplyr::filter() by default, unless o/w specified", {
   linter <- conjunct_test_linter()
 
-  expect_lint("stats::filter(A & B)", NULL, linter)
-  expect_lint("ns::filter(A & B)", NULL, linter)
+  expect_no_lint("stats::filter(A & B)", linter)
+  expect_no_lint("ns::filter(A & B)", linter)
   expect_lint(
     "DF %>% filter(A & B)",
     rex::rex("Use dplyr::filter(DF, A, B) instead of dplyr::filter(DF, A & B)"),
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-fixed_regex_linter.R b/tests/testthat/test-fixed_regex_linter.R
index 83a00c141..0b4a9f273 100644
--- a/tests/testthat/test-fixed_regex_linter.R
+++ b/tests/testthat/test-fixed_regex_linter.R
@@ -1,30 +1,30 @@
 test_that("fixed_regex_linter skips allowed usages", {
   linter <- fixed_regex_linter()
 
-  expect_lint("gsub('^x', '', y)", NULL, linter)
-  expect_lint("grep('x$', '', y)", NULL, linter)
-  expect_lint("sub('[a-zA-Z]', '', y)", NULL, linter)
-  expect_lint("grepl(fmt, y)", NULL, linter)
-  expect_lint(R"{regexec('\\s', '', y)}", NULL, linter)
-  expect_lint("grep('a(?=b)', x, perl = TRUE)", NULL, linter)
-  expect_lint("grep('0+1', x, perl = TRUE)", NULL, linter)
-  expect_lint("grep('1*2', x)", NULL, linter)
-  expect_lint("grep('a|b', x)", NULL, linter)
-  expect_lint(R"{grep('\\[|\\]', x)}", NULL, linter)
+  expect_no_lint("gsub('^x', '', y)", linter)
+  expect_no_lint("grep('x$', '', y)", linter)
+  expect_no_lint("sub('[a-zA-Z]', '', y)", linter)
+  expect_no_lint("grepl(fmt, y)", linter)
+  expect_no_lint(R"{regexec('\\s', '', y)}", linter)
+  expect_no_lint("grep('a(?=b)', x, perl = TRUE)", linter)
+  expect_no_lint("grep('0+1', x, perl = TRUE)", linter)
+  expect_no_lint("grep('1*2', x)", linter)
+  expect_no_lint("grep('a|b', x)", linter)
+  expect_no_lint(R"{grep('\\[|\\]', x)}", linter)
 
   # if fixed=TRUE is already set, regex patterns don't matter
-  expect_lint(R"{gsub('\\.', '', y, fixed = TRUE)}", NULL, linter)
+  expect_no_lint(R"{gsub('\\.', '', y, fixed = TRUE)}", linter)
 
   # ignore.case=TRUE implies regex interpretation
-  expect_lint("gsub('abcdefg', '', y, ignore.case = TRUE)", NULL, linter)
+  expect_no_lint("gsub('abcdefg', '', y, ignore.case = TRUE)", linter)
 
   # char classes starting with [] might contain other characters -> not fixed
-  expect_lint("sub('[][]', '', y)", NULL, linter)
-  expect_lint("sub('[][ ]', '', y)", NULL, linter)
-  expect_lint("sub('[],[]', '', y)", NULL, linter)
+  expect_no_lint("sub('[][]', '', y)", linter)
+  expect_no_lint("sub('[][ ]', '', y)", linter)
+  expect_no_lint("sub('[],[]', '', y)", linter)
 
   # wrapper functions don't throw
-  expect_lint("gregexpr(pattern = pattern, data, perl = TRUE, ...)", NULL, linter)
+  expect_no_lint("gregexpr(pattern = pattern, data, perl = TRUE, ...)", linter)
 })
 
 test_that("fixed_regex_linter blocks simple disallowed usages", {
@@ -77,19 +77,19 @@ test_that("fixed_regex_linter catches regex like [.] or [$]", {
 test_that("fixed_regex_linter catches null calls to strsplit as well", {
   linter <- fixed_regex_linter()
 
-  expect_lint("strsplit(x, '^x')", NULL, linter)
-  expect_lint(R"{strsplit(x, '\\s')}", NULL, linter)
-  expect_lint("strsplit(x, 'a(?=b)', perl = TRUE)", NULL, linter)
-  expect_lint("strsplit(x, '0+1', perl = TRUE)", NULL, linter)
-  expect_lint("strsplit(x, 'a|b')", NULL, linter)
+  expect_no_lint("strsplit(x, '^x')", linter)
+  expect_no_lint(R"{strsplit(x, '\\s')}", linter)
+  expect_no_lint("strsplit(x, 'a(?=b)', perl = TRUE)", linter)
+  expect_no_lint("strsplit(x, '0+1', perl = TRUE)", linter)
+  expect_no_lint("strsplit(x, 'a|b')", linter)
 
-  expect_lint("tstrsplit(x, '1*2')", NULL, linter)
-  expect_lint("tstrsplit(x, '[a-zA-Z]')", NULL, linter)
-  expect_lint("tstrsplit(x, fmt)", NULL, linter)
+  expect_no_lint("tstrsplit(x, '1*2')", linter)
+  expect_no_lint("tstrsplit(x, '[a-zA-Z]')", linter)
+  expect_no_lint("tstrsplit(x, fmt)", linter)
 
   # if fixed=TRUE is already set, regex patterns don't matter
-  expect_lint(R"{strsplit(x, '\\.', fixed = TRUE)}", NULL, linter)
-  expect_lint(R"{strsplit(x, '\\.', fixed = T)}", NULL, linter)
+  expect_no_lint(R"{strsplit(x, '\\.', fixed = TRUE)}", linter)
+  expect_no_lint(R"{strsplit(x, '\\.', fixed = T)}", linter)
 })
 
 test_that("fixed_regex_linter catches calls to strsplit as well", {
@@ -106,7 +106,7 @@ test_that("fixed_regex_linter is more exact about distinguishing \\s from \\:",
   linter <- fixed_regex_linter()
   lint_msg <- rex::rex("This regular expression is static")
 
-  expect_lint(R"{grep('\\s', '', x)}", NULL, linter)
+  expect_no_lint(R"{grep('\\s', '', x)}", linter)
   expect_lint(R"{grep('\\:', '', x)}", lint_msg, linter)
 })
 
@@ -114,18 +114,18 @@ test_that("fixed_regex_linter is more exact about distinguishing \\s from \\:",
 test_that("fixed_regex_linter skips allowed stringr usages", {
   linter <- fixed_regex_linter()
 
-  expect_lint("str_replace(y, '[a-zA-Z]', '')", NULL, linter)
-  expect_lint("str_replace_all(y, '^x', '')", NULL, linter)
-  expect_lint("str_detect(y, fmt)", NULL, linter)
-  expect_lint(R"{str_extract(y, '\\s')}", NULL, linter)
-  expect_lint(R"{str_extract_all(y, '\\s')}", NULL, linter)
-  expect_lint("str_which(x, '1*2')", NULL, linter)
+  expect_no_lint("str_replace(y, '[a-zA-Z]', '')", linter)
+  expect_no_lint("str_replace_all(y, '^x', '')", linter)
+  expect_no_lint("str_detect(y, fmt)", linter)
+  expect_no_lint(R"{str_extract(y, '\\s')}", linter)
+  expect_no_lint(R"{str_extract_all(y, '\\s')}", linter)
+  expect_no_lint("str_which(x, '1*2')", linter)
 
   # if fixed() is already set, regex patterns don't matter
-  expect_lint(R"{str_replace(y, fixed('\\.'), '')}", NULL, linter)
+  expect_no_lint(R"{str_replace(y, fixed('\\.'), '')}", linter)
 
   # namespace qualification doesn't matter
-  expect_lint("stringr::str_replace(y, stringr::fixed('abcdefg'), '')", NULL, linter)
+  expect_no_lint("stringr::str_replace(y, stringr::fixed('abcdefg'), '')", linter)
 })
 
 test_that("fixed_regex_linter blocks simple disallowed usages of stringr functions", {
@@ -148,11 +148,11 @@ test_that("fixed_regex_linter catches calls to str_split as well", {
   linter <- fixed_regex_linter()
   lint_msg <- rex::rex("This regular expression is static")
 
-  expect_lint("str_split(x, '^x')", NULL, linter)
-  expect_lint("str_split(x, fmt)", NULL, linter)
+  expect_no_lint("str_split(x, '^x')", linter)
+  expect_no_lint("str_split(x, fmt)", linter)
 
   # if fixed() is already set, regex patterns don't matter
-  expect_lint(R"{str_split(x, fixed('\\.'))}", NULL, linter)
+  expect_no_lint(R"{str_split(x, fixed('\\.'))}", linter)
   expect_lint(R"{str_split(x, '\\.')}", lint_msg, linter)
   expect_lint("str_split(x, '[.]')", lint_msg, linter)
 })
@@ -163,8 +163,8 @@ test_that("str_replace_all's multi-replacement version is handled", {
   # While each of the replacements is fixed, and this _could_ in principle be replaced by
   #   a pipeline where each step does one of the replacements and fixed() is used, this is overkill.
   #   Instead, ensure that no lint is returned for this case
-  expect_lint('str_replace_all(x, c("one" = "1", "two" = "2", "three" = "3"))', NULL, linter)
-  expect_lint('grepl(c("a" = "b"), x)', NULL, linter)
+  expect_no_lint('str_replace_all(x, c("one" = "1", "two" = "2", "three" = "3"))', linter)
+  expect_no_lint('grepl(c("a" = "b"), x)', linter)
 })
 
 test_that("1- or 2-width octal escape sequences are handled", {
@@ -209,20 +209,20 @@ test_that("bracketed unicode escapes are caught", {
 
 test_that("escaped characters are handled correctly", {
   linter <- fixed_regex_linter()
-  expect_lint(R"{gsub('\n+', '', sql)}", NULL, linter)
-  expect_lint('gsub("\\n{2,}", "\n", D)', NULL, linter)
-  expect_lint(R'{gsub("[\r\n]", "", x)}', NULL, linter)
-  expect_lint(R'{gsub("\n $", "", y)}', NULL, linter)
-  expect_lint(R'{gsub("```\n*```r*\n*", "", x)}', NULL, linter)
-  expect_lint('strsplit(x, "(;|\n)")', NULL, linter)
-  expect_lint(R'{strsplit(x, "(;|\n)")}', NULL, linter)
-  expect_lint(R'{grepl("[\\W]", x, perl = TRUE)}', NULL, linter)
-  expect_lint(R'{grepl("[\\W]", x)}', NULL, linter)
+  expect_no_lint(R"{gsub('\n+', '', sql)}", linter)
+  expect_no_lint('gsub("\\n{2,}", "\n", D)', linter)
+  expect_no_lint(R'{gsub("[\r\n]", "", x)}', linter)
+  expect_no_lint(R'{gsub("\n $", "", y)}', linter)
+  expect_no_lint(R'{gsub("```\n*```r*\n*", "", x)}', linter)
+  expect_no_lint('strsplit(x, "(;|\n)")', linter)
+  expect_no_lint(R'{strsplit(x, "(;|\n)")}', linter)
+  expect_no_lint(R'{grepl("[\\W]", x, perl = TRUE)}', linter)
+  expect_no_lint(R'{grepl("[\\W]", x)}', linter)
 })
 
 # make sure the logic is properly vectorized
 test_that("single expression with multiple regexes is OK", {
-  expect_lint('c(grep("^a", x), grep("b$", x))', NULL, fixed_regex_linter())
+  expect_no_lint('c(grep("^a", x), grep("b$", x))', fixed_regex_linter())
 })
 
 test_that("fixed replacements vectorize and recognize str_detect", {
@@ -344,34 +344,45 @@ local({
 test_that("'unescaped' regex can optionally be skipped", {
   linter <- fixed_regex_linter(allow_unescaped = TRUE)
 
-  expect_lint("grepl('a', x)", NULL, linter)
-  expect_lint("str_detect(x, 'a')", NULL, linter)
+  expect_no_lint("grepl('a', x)", linter)
+  expect_no_lint("str_detect(x, 'a')", linter)
   expect_lint("grepl('[$]', x)", rex::rex('Use "$" with fixed = TRUE'), linter)
 })
 
 local({
+  linter <- fixed_regex_linter()
+  lint_msg <- "This regular expression is static"
   pipes <- pipes(exclude = c("%$%", "%T>%"))
+
   patrick::with_parameters_test_that(
     "linter is pipe-aware",
     {
-      linter <- fixed_regex_linter()
-      lint_msg <- "This regular expression is static"
-
       expect_lint(paste("x", pipe, "grepl(pattern = 'a')"), lint_msg, linter)
-      expect_lint(paste("x", pipe, "grepl(pattern = '^a')"), NULL, linter)
-      expect_lint(paste("x", pipe, "grepl(pattern = 'a', fixed = TRUE)"), NULL, linter)
+      expect_no_lint(paste("x", pipe, "grepl(pattern = '^a')"), linter)
+      expect_no_lint(paste("x", pipe, "grepl(pattern = 'a', fixed = TRUE)"), linter)
       expect_lint(paste("x", pipe, "str_detect('a')"), lint_msg, linter)
-      expect_lint(paste("x", pipe, "str_detect('^a')"), NULL, linter)
-      expect_lint(paste("x", pipe, "str_detect(fixed('a'))"), NULL, linter)
+      expect_no_lint(paste("x", pipe, "str_detect('^a')"), linter)
+      expect_no_lint(paste("x", pipe, "str_detect(fixed('a'))"), linter)
 
       expect_lint(paste("x", pipe, "gsub(pattern = 'a', replacement = '')"), lint_msg, linter)
-      expect_lint(paste("x", pipe, "gsub(pattern = '^a', replacement = '')"), NULL, linter)
-      expect_lint(paste("x", pipe, "gsub(pattern = 'a', replacement = '', fixed = TRUE)"), NULL, linter)
+      expect_no_lint(paste("x", pipe, "gsub(pattern = '^a', replacement = '')"), linter)
+      expect_no_lint(paste("x", pipe, "gsub(pattern = 'a', replacement = '', fixed = TRUE)"), linter)
       expect_lint(paste("x", pipe, "str_replace('a', '')"), lint_msg, linter)
-      expect_lint(paste("x", pipe, "str_replace('^a', '')"), NULL, linter)
-      expect_lint(paste("x", pipe, "str_replace(fixed('a'), '')"), NULL, linter)
+      expect_no_lint(paste("x", pipe, "str_replace('^a', '')"), linter)
+      expect_no_lint(paste("x", pipe, "str_replace(fixed('a'), '')"), linter)
     },
     pipe = pipes,
     .test_name = names(pipes)
   )
 })
+
+test_that("pipe-aware lint logic survives adversarial comments", {
+  expect_lint(
+    trim_some("
+      x %>%   grepl(pattern = # comment
+      'a')
+    "),
+    "This regular expression is static",
+    fixed_regex_linter()
+  )
+})
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-ifelse_censor_linter.R b/tests/testthat/test-ifelse_censor_linter.R
index 581a4081f..763a077af 100644
--- a/tests/testthat/test-ifelse_censor_linter.R
+++ b/tests/testthat/test-ifelse_censor_linter.R
@@ -1,8 +1,8 @@
 test_that("ifelse_censor_linter skips allowed usages", {
   linter <- ifelse_censor_linter()
 
-  expect_lint("ifelse(x == 2, x, y)", NULL, linter)
-  expect_lint("ifelse(x > 2, x, y)", NULL, linter)
+  expect_no_lint("ifelse(x == 2, x, y)", linter)
+  expect_no_lint("ifelse(x > 2, x, y)", linter)
 })
 
 test_that("ifelse_censor_linter blocks simple disallowed usages", {
@@ -56,13 +56,30 @@ test_that("ifelse_censor_linter blocks simple disallowed usages", {
   )
 
   # more complicated expression still matches
-  lines <- trim_some("
-    ifelse(2 + p + 104 + 1 > ncols,
-           ncols, 2 + p + 104 + 1
-           )
-  ")
   expect_lint(
-    lines,
+    trim_some("
+      ifelse(2 + p + 104 + 1 > ncols,
+            ncols, 2 + p + 104 + 1
+            )
+    "),
+    rex::rex("pmin(x, y) is preferable to ifelse(x > y, y, x)"),
+    linter
+  )
+
+  # including with comments
+  expect_lint(
+    trim_some("
+      ifelse(2 + p + 104 + 1 #comment
+      > ncols, ncols, 2 + p + 104 + 1)
+    "),
+    rex::rex("pmin(x, y) is preferable to ifelse(x > y, y, x)"),
+    linter
+  )
+  expect_lint(
+    trim_some("
+      ifelse(2 + p + 104 + # comment
+      1 > ncols, ncols, 2 + p + 104 + 1)
+    "),
     rex::rex("pmin(x, y) is preferable to ifelse(x > y, y, x)"),
     linter
   )
diff --git a/tests/testthat/test-implicit_assignment_linter.R b/tests/testthat/test-implicit_assignment_linter.R
index 0681b2ecd..2b81f8b11 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", {
@@ -422,6 +438,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 57da887f2..3b71e451f 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-literal_coercion_linter.R b/tests/testthat/test-literal_coercion_linter.R
index aa5f752fb..823c442fd 100644
--- a/tests/testthat/test-literal_coercion_linter.R
+++ b/tests/testthat/test-literal_coercion_linter.R
@@ -2,42 +2,50 @@ test_that("literal_coercion_linter skips allowed usages", {
   linter <- literal_coercion_linter()
 
   # naive xpath includes the "_f0" here as a literal
-  expect_lint('as.numeric(x$"_f0")', NULL, linter)
-  expect_lint('as.numeric(x@"_f0")', NULL, linter)
+  expect_no_lint('as.numeric(x$"_f0")', linter)
+  expect_no_lint('as.numeric(x@"_f0")', linter)
   # only examine the first method for as.<type> methods
-  expect_lint("as.character(as.Date(x), '%Y%m%d')", NULL, linter)
+  expect_no_lint("as.character(as.Date(x), '%Y%m%d')", linter)
 
   # we are as yet agnostic on whether to prefer literals over coerced vectors
-  expect_lint("as.integer(c(1, 2, 3))", NULL, linter)
+  expect_no_lint("as.integer(c(1, 2, 3))", linter)
   # even more ambiguous for character vectors like here, where quotes are much
   #   more awkward to type than a sequence of numbers
-  expect_lint("as.character(c(1, 2, 3))", NULL, linter)
+  expect_no_lint("as.character(c(1, 2, 3))", linter)
   # not possible to declare raw literals
-  expect_lint("as.raw(c(1, 2, 3))", NULL, linter)
+  expect_no_lint("as.raw(c(1, 2, 3))", linter)
   # also not taking a stand on as.complex(0) vs. 0 + 0i
-  expect_lint("as.complex(0)", NULL, linter)
+  expect_no_lint("as.complex(0)", linter)
   # ditto for as.integer(1e6) vs. 1000000L
-  expect_lint("as.integer(1e6)", NULL, linter)
+  expect_no_lint("as.integer(1e6)", linter)
   # ditto for as.numeric(1:3) vs. c(1, 2, 3)
-  expect_lint("as.numeric(1:3)", NULL, linter)
+  expect_no_lint("as.numeric(1:3)", linter)
 })
 
 test_that("literal_coercion_linter skips allowed rlang usages", {
   linter <- literal_coercion_linter()
 
-  expect_lint("int(1, 2.0, 3)", NULL, linter)
-  expect_lint("chr('e', 'ab', 'xyz')", NULL, linter)
-  expect_lint("lgl(0, 1)", NULL, linter)
-  expect_lint("lgl(0L, 1)", NULL, linter)
-  expect_lint("dbl(1.2, 1e5, 3L, 2E4)", NULL, linter)
+  expect_no_lint("int(1, 2.0, 3)", linter)
+  expect_no_lint("chr('e', 'ab', 'xyz')", linter)
+  expect_no_lint("lgl(0, 1)", linter)
+  expect_no_lint("lgl(0L, 1)", linter)
+  expect_no_lint("dbl(1.2, 1e5, 3L, 2E4)", linter)
   # make sure using namespace (`rlang::`) doesn't create problems
-  expect_lint("rlang::int(1, 2, 3)", NULL, linter)
+  expect_no_lint("rlang::int(1, 2, 3)", linter)
   # even if scalar, carve out exceptions for the following
-  expect_lint("int(1.0e6)", NULL, linter)
+  expect_no_lint("int(1.0e6)", linter)
 })
 
 test_that("literal_coercion_linter skips quoted keyword arguments", {
-  expect_lint("as.numeric(foo('a' = 1))", NULL, literal_coercion_linter())
+  linter <- literal_coercion_linter()
+  expect_no_lint("as.numeric(foo('a' = 1))", linter)
+  expect_no_lint(
+    trim_some("
+      as.numeric(foo('a' # comment
+      = 1))
+    "),
+    linter
+  )
 })
 
 test_that("no warnings surfaced by running coercion", {
@@ -50,6 +58,18 @@ test_that("no warnings surfaced by running coercion", {
   expect_no_warning(
     expect_lint("as.integer(2147483648)", "Use NA_integer_", linter)
   )
+
+  expect_no_warning(
+    expect_lint(
+      trim_some("
+        as.double(
+          NA # comment
+        )
+      "),
+      "Use NA_real_",
+      linter
+    )
+  )
 })
 
 skip_if_not_installed("tibble")
@@ -81,6 +101,7 @@ patrick::with_parameters_test_that(
 
 skip_if_not_installed("rlang")
 test_that("multiple lints return custom messages", {
+  linter <- literal_coercion_linter()
   expect_lint(
     trim_some("{
       as.integer(1)
@@ -90,7 +111,24 @@ test_that("multiple lints return custom messages", {
       list(rex::rex("Use 1L instead of as.integer(1)"), line_number = 2L),
       list(rex::rex("Use TRUE instead of lgl(1L)"), line_number = 3L)
     ),
-    literal_coercion_linter()
+    linter
+  )
+
+  # also ensure comment remove logic works across several lints
+  expect_lint(
+    trim_some("{
+      as.integer( # comment
+      1           # comment
+      )           # comment
+      lgl(        # comment
+      1L          # comment
+      )           # comment
+    }"),
+    list(
+      list(rex::rex("Use 1L instead of as.integer(1)"), line_number = 2L),
+      list(rex::rex("Use TRUE instead of lgl(1L)"), line_number = 5L)
+    ),
+    linter
   )
 })
 
diff --git a/tests/testthat/test-matrix_apply_linter.R b/tests/testthat/test-matrix_apply_linter.R
index 0a30b3ce1..5503fb8b2 100644
--- a/tests/testthat/test-matrix_apply_linter.R
+++ b/tests/testthat/test-matrix_apply_linter.R
@@ -1,78 +1,74 @@
 test_that("matrix_apply_linter skips allowed usages", {
   linter <- matrix_apply_linter()
 
-  expect_lint("apply(x, 1, prod)", NULL, linter)
+  expect_no_lint("apply(x, 1, prod)", linter)
 
-  expect_lint("apply(x, 1, function(i) sum(i[i > 0]))", NULL, linter)
+  expect_no_lint("apply(x, 1, function(i) sum(i[i > 0]))", linter)
 
   # sum as FUN argument
-  expect_lint("apply(x, 1, f, sum)", NULL, linter)
+  expect_no_lint("apply(x, 1, f, sum)", linter)
 
   # mean() with named arguments other than na.rm is skipped because they are not
   # implemented in colMeans() or rowMeans()
-  expect_lint("apply(x, 1, mean, trim = 0.2)", NULL, linter)
+  expect_no_lint("apply(x, 1, mean, trim = 0.2)", linter)
 })
 
 test_that("matrix_apply_linter is not implemented for complex MARGIN values", {
   linter <- matrix_apply_linter()
 
   # Could be implemented at some point
-  expect_lint("apply(x, seq(2, 4), sum)", NULL, linter)
+  expect_no_lint("apply(x, seq(2, 4), sum)", linter)
 
   # No equivalent
-  expect_lint("apply(x, c(2, 4), sum)", NULL, linter)
+  expect_no_lint("apply(x, c(2, 4), sum)", linter)
 
   # Beyond the scope of static analysis
-  expect_lint("apply(x, m, sum)", NULL, linter)
-
-  expect_lint("apply(x, 1 + 2:4, sum)", NULL, linter)
+  expect_no_lint("apply(x, m, sum)", linter)
 
+  expect_no_lint("apply(x, 1 + 2:4, sum)", linter)
 })
 
 
 test_that("matrix_apply_linter simple disallowed usages", {
   linter <- matrix_apply_linter()
-  lint_message <- rex::rex("rowSums(x)")
 
+  lint_message <- rex::rex("rowSums(x)")
   expect_lint("apply(x, 1, sum)", lint_message, linter)
-
   expect_lint("apply(x, MARGIN = 1, FUN = sum)", lint_message, linter)
-
   expect_lint("apply(x, 1L, sum)", lint_message, linter)
-
   expect_lint("apply(x, 1:4, sum)", rex::rex("rowSums(x, dims = 4)"), linter)
-
   expect_lint("apply(x, 2, sum)", rex::rex("rowSums(colSums(x))"), linter)
-
   expect_lint("apply(x, 2:4, sum)", rex::rex("rowSums(colSums(x), dims = 3)"), linter)
 
   lint_message <- rex::rex("rowMeans")
-
   expect_lint("apply(x, 1, mean)", lint_message, linter)
-
   expect_lint("apply(x, MARGIN = 1, FUN = mean)", lint_message, linter)
 
   # Works with extra args in mean()
   expect_lint("apply(x, 1, mean, na.rm = TRUE)", lint_message, linter)
 
   lint_message <- rex::rex("colMeans")
-
   expect_lint("apply(x, 2, mean)", lint_message, linter)
-
   expect_lint("apply(x, 2:4, mean)", lint_message, linter)
 
+  # adversarial comments
+  expect_lint(
+    trim_some("
+      apply(x, 2, #comment
+      mean)
+    "),
+    lint_message,
+    linter
+  )
 })
 
 test_that("matrix_apply_linter recommendation includes na.rm if present in original call", {
   linter <- matrix_apply_linter()
-  lint_message <- rex::rex("na.rm = TRUE")
 
+  lint_message <- rex::rex("na.rm = TRUE")
   expect_lint("apply(x, 1, sum, na.rm = TRUE)", lint_message, linter)
-
   expect_lint("apply(x, 2, sum, na.rm = TRUE)", lint_message, linter)
-
   expect_lint("apply(x, 1, mean, na.rm = TRUE)", lint_message, linter)
-
   expect_lint("apply(x, 2, mean, na.rm = TRUE)", lint_message, linter)
 
   lint_message <- rex::rex("rowSums(x)")
@@ -80,7 +76,6 @@ test_that("matrix_apply_linter recommendation includes na.rm if present in origi
 
   lint_message <- rex::rex("na.rm = foo")
   expect_lint("apply(x, 1, sum, na.rm = foo)", lint_message, linter)
-
 })
 
 test_that("matrix_apply_linter works with multiple lints in a single expression", {
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-nzchar_linter.R b/tests/testthat/test-nzchar_linter.R
index a034f8a26..774fb8afa 100644
--- a/tests/testthat/test-nzchar_linter.R
+++ b/tests/testthat/test-nzchar_linter.R
@@ -33,13 +33,22 @@ test_that("nzchar_linter skips as appropriate for other nchar args", {
 
 test_that("nzchar_linter blocks simple disallowed usages", {
   linter <- nzchar_linter()
-  lint_msg_quote <- rex::rex('Use !nzchar(x) instead of x == ""')
-  lint_msg_nchar <- rex::rex("Use nzchar() instead of comparing nchar(x) to 0")
+  lint_msg <- rex::rex("Use !nzchar(x) instead of nchar(x) == 0")
 
-  expect_lint("which(x == '')", lint_msg_quote, linter)
+  expect_lint("which(x == '')", rex::rex('Use !nzchar(x) instead of x == ""'), linter)
   expect_lint("any(nchar(x) >= 0)", rex::rex("nchar(x) >= 0 is always true, maybe you want nzchar(x)?"), linter)
-  expect_lint("all(nchar(x) == 0L)", rex::rex("Use !nzchar(x) instead of nchar(x) == 0"), linter)
+  expect_lint("all(nchar(x) == 0L)", lint_msg, linter)
   expect_lint("sum(0.0 < nchar(x))", rex::rex("Use nzchar(x) instead of nchar(x) > 0"), linter)
+
+  # adversarial comment
+  expect_lint(
+    trim_some("
+      all(nchar(x) #comment
+      == 0L)
+    "),
+    lint_msg,
+    linter
+  )
 })
 
 test_that("nzchar_linter skips comparison to '' in if/while statements", {
diff --git a/tests/testthat/test-object_length_linter.R b/tests/testthat/test-object_length_linter.R
index 240c86192..051c6bf2f 100644
--- a/tests/testthat/test-object_length_linter.R
+++ b/tests/testthat/test-object_length_linter.R
@@ -104,4 +104,14 @@ test_that("literals in assign() and setGeneric() are checked", {
   expect_lint("assign(x = 'badBadBadBadName', 2, env)", lint_msg, linter)
   expect_lint("assign(envir = 'good_env_name', 'badBadBadBadName', 2)", lint_msg, linter)
   expect_lint("assign(envir = 'good_env_name', x = 'badBadBadBadName', 2)", lint_msg, linter)
+
+  # adversarial comments
+  expect_lint(
+    trim_some("
+      assign(envir = # comment
+      'good_env_name', 'badBadBadBadName', 2)
+    "),
+    lint_msg,
+    linter
+  )
 })
diff --git a/tests/testthat/test-object_name_linter.R b/tests/testthat/test-object_name_linter.R
index 75fdcb00d..dc520efe1 100644
--- a/tests/testthat/test-object_name_linter.R
+++ b/tests/testthat/test-object_name_linter.R
@@ -308,6 +308,16 @@ test_that("literals in assign() and setGeneric() are checked", {
   expect_lint("assign(x = 'badName', 2, env)", lint_msg, linter)
   expect_lint("assign(envir = 'good_env_name', 'badName', 2)", lint_msg, linter)
   expect_lint("assign(envir = 'good_env_name', x = 'badName', 2)", lint_msg, linter)
+
+  # adversarial comments
+  expect_lint(
+    trim_some("
+      assign(envir = # comment
+      'good_env_name', 'badName', 2)
+    "),
+    lint_msg,
+    linter
+  )
 })
 
 test_that("generics assigned with '=' or <<- are registered", {
diff --git a/tests/testthat/test-object_usage_linter.R b/tests/testthat/test-object_usage_linter.R
index cd9172619..3bb9cbbb9 100644
--- a/tests/testthat/test-object_usage_linter.R
+++ b/tests/testthat/test-object_usage_linter.R
@@ -750,6 +750,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-outer_negation_linter.R b/tests/testthat/test-outer_negation_linter.R
index 0601aa4ee..aa18761f1 100644
--- a/tests/testthat/test-outer_negation_linter.R
+++ b/tests/testthat/test-outer_negation_linter.R
@@ -1,20 +1,20 @@
 test_that("outer_negation_linter skips allowed usages", {
   linter <- outer_negation_linter()
 
-  expect_lint("x <- any(y)", NULL, linter)
-  expect_lint("y <- all(z)", NULL, linter)
+  expect_no_lint("x <- any(y)", linter)
+  expect_no_lint("y <- all(z)", linter)
 
   # extended usage of any is not covered
-  expect_lint("any(!a & b)", NULL, linter)
-  expect_lint("all(a | !b)", NULL, linter)
-
-  expect_lint("any(a, b)", NULL, linter)
-  expect_lint("all(b, c)", NULL, linter)
-  expect_lint("any(!a, b)", NULL, linter)
-  expect_lint("all(a, !b)", NULL, linter)
-  expect_lint("any(a, !b, na.rm = TRUE)", NULL, linter)
+  expect_no_lint("any(!a & b)", linter)
+  expect_no_lint("all(a | !b)", linter)
+
+  expect_no_lint("any(a, b)", linter)
+  expect_no_lint("all(b, c)", linter)
+  expect_no_lint("any(!a, b)", linter)
+  expect_no_lint("all(a, !b)", linter)
+  expect_no_lint("any(a, !b, na.rm = TRUE)", linter)
   # ditto when na.rm is passed quoted
-  expect_lint("any(a, !b, 'na.rm' = TRUE)", NULL, linter)
+  expect_no_lint("any(a, !b, 'na.rm' = TRUE)", linter)
 })
 
 test_that("outer_negation_linter blocks simple disallowed usages", {
@@ -31,15 +31,25 @@ test_that("outer_negation_linter blocks simple disallowed usages", {
   # catch when all inputs are negated
   expect_lint("any(!x, !y)", not_all_msg, linter)
   expect_lint("all(!x, !y, na.rm = TRUE)", not_any_msg, linter)
+
+  # adversarial comment
+  expect_lint(
+    trim_some("
+      any(!x, na.rm = # comment
+      TRUE)
+    "),
+    not_all_msg,
+    linter
+  )
 })
 
 test_that("outer_negation_linter doesn't trigger on empty calls", {
   linter <- outer_negation_linter()
 
   # minimal version of issue
-  expect_lint("any()", NULL, linter)
+  expect_no_lint("any()", linter)
   # closer to what was is practically relevant, as another regression test
-  expect_lint("x %>% any()", NULL, linter)
+  expect_no_lint("x %>% any()", linter)
 })
 
 test_that("lints vectorize", {
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 566848505..470ae9c5d 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,")
@@ -201,3 +202,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 27303ee40..f819d543f 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-sprintf_linter.R b/tests/testthat/test-sprintf_linter.R
index e0626a974..7fc6fa27d 100644
--- a/tests/testthat/test-sprintf_linter.R
+++ b/tests/testthat/test-sprintf_linter.R
@@ -4,14 +4,14 @@ patrick::with_parameters_test_that(
     linter <- sprintf_linter()
 
     # NB: using paste0, not sprintf, to avoid escaping '%d' in sprint fmt=
-    expect_lint(paste0(call_name, "('hello')"), NULL, linter)
-    expect_lint(paste0(call_name, "('hello %d', 1)"), NULL, linter)
-    expect_lint(paste0(call_name, "('hello %d', x)"), NULL, linter)
-    expect_lint(paste0(call_name, "('hello %d', x + 1)"), NULL, linter)
-    expect_lint(paste0(call_name, "('hello %d', f(x))"), NULL, linter)
-    expect_lint(paste0(call_name, "('hello %1$s %1$s', x)"), NULL, linter)
-    expect_lint(paste0(call_name, "('hello %1$s %1$s %2$d', x, y)"), NULL, linter)
-    expect_lint(paste0(call_name, "('hello %1$s %1$s %2$d %3$s', x, y, 1.5)"), NULL, linter)
+    expect_no_lint(paste0(call_name, "('hello')"), linter)
+    expect_no_lint(paste0(call_name, "('hello %d', 1)"), linter)
+    expect_no_lint(paste0(call_name, "('hello %d', x)"), linter)
+    expect_no_lint(paste0(call_name, "('hello %d', x + 1)"), linter)
+    expect_no_lint(paste0(call_name, "('hello %d', f(x))"), linter)
+    expect_no_lint(paste0(call_name, "('hello %1$s %1$s', x)"), linter)
+    expect_no_lint(paste0(call_name, "('hello %1$s %1$s %2$d', x, y)"), linter)
+    expect_no_lint(paste0(call_name, "('hello %1$s %1$s %2$d %3$s', x, y, 1.5)"), linter)
   },
   .test_name = c("sprintf", "gettextf"),
   call_name = c("sprintf", "gettextf")
@@ -66,24 +66,23 @@ test_that("edge cases are detected correctly", {
   linter <- sprintf_linter()
 
   # works with multi-line sprintf and comments
-  expect_lint(
+  expect_no_lint(
     trim_some("
       sprintf(
         'test fmt %s', # this is a comment
         2
       )
     "),
-    NULL,
     linter
   )
 
   # dots
-  expect_lint("sprintf('%d %d, %d', id, ...)", NULL, linter)
+  expect_no_lint("sprintf('%d %d, %d', id, ...)", linter)
 
   # TODO(#1265) extend ... detection to at least test for too many arguments.
 
   # named argument fmt
-  expect_lint("sprintf(x, fmt = 'hello %1$s %1$s')", NULL, linter)
+  expect_no_lint("sprintf(x, fmt = 'hello %1$s %1$s')", linter)
 
   expect_lint(
     "sprintf(x, fmt = 'hello %1$s %1$s %3$d', y)",
@@ -92,7 +91,7 @@ test_that("edge cases are detected correctly", {
   )
 
   # #2131: xml2lang stripped necessary whitespace
-  expect_lint("sprintf('%s', if (A) '' else y)", NULL, linter)
+  expect_no_lint("sprintf('%s', if (A) '' else y)", linter)
 })
 
 local({
@@ -103,13 +102,13 @@ local({
   patrick::with_parameters_test_that(
     "piping into sprintf works",
     {
-      expect_lint(paste("x", pipe, "sprintf(fmt = '%s')"), NULL, linter)
+      expect_no_lint(paste("x", pipe, "sprintf(fmt = '%s')"), linter)
       # no fmt= specified -> this is just 'sprintf("%s", "%s%s")', which won't lint
-      expect_lint(paste('"%s"', pipe, 'sprintf("%s%s")'), NULL, linter)
+      expect_no_lint(paste('"%s"', pipe, 'sprintf("%s%s")'), linter)
       expect_lint(paste("x", pipe, "sprintf(fmt = '%s%s')"), unused_fmt_msg, linter)
 
       # Cannot evaluate statically --> skip
-      expect_lint(paste("x", pipe, 'sprintf("a")'), NULL, linter)
+      expect_no_lint(paste("x", pipe, 'sprintf("a")'), linter)
       # Nested pipes
       expect_lint(
         paste("'%%sb'", pipe, "sprintf('%s')", pipe, "sprintf('a')"),
@@ -132,6 +131,26 @@ local({
   )
 })
 
+test_that("pipe logic survives adversarial comments", {
+  linter <- sprintf_linter()
+
+  expect_no_lint(
+    trim_some("
+      x |> # comment
+      sprintf(fmt = '%s')
+    "),
+    linter
+  )
+
+  expect_no_lint(
+    trim_some('
+      "%s" %>% # comment
+      sprintf("%s%s")
+    '),
+    linter
+  )
+})
+
 test_that("lints vectorize", {
   skip_if_not_r_version("4.1.0")
 
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_concatenation_linter.R b/tests/testthat/test-unnecessary_concatenation_linter.R
index 55abd21b0..1800f3490 100644
--- a/tests/testthat/test-unnecessary_concatenation_linter.R
+++ b/tests/testthat/test-unnecessary_concatenation_linter.R
@@ -1,13 +1,13 @@
 test_that("unnecessary_concatenation_linter skips allowed usages", {
   linter <- unnecessary_concatenation_linter()
 
-  expect_lint("c(x)", NULL, linter)
-  expect_lint("c(1, 2)", NULL, linter)
-  expect_lint("c(x, recursive = TRUE)", NULL, linter)
-  expect_lint("c(1, recursive = FALSE)", NULL, linter)
-  expect_lint("lapply(1, c)", NULL, linter)
-  expect_lint("c(a = 1)", NULL, linter)
-  expect_lint("c('a' = 1)", NULL, linter)
+  expect_no_lint("c(x)", linter)
+  expect_no_lint("c(1, 2)", linter)
+  expect_no_lint("c(x, recursive = TRUE)", linter)
+  expect_no_lint("c(1, recursive = FALSE)", linter)
+  expect_no_lint("lapply(1, c)", linter)
+  expect_no_lint("c(a = 1)", linter)
+  expect_no_lint("c('a' = 1)", linter)
 })
 
 test_that("unnecessary_concatenation_linter blocks disallowed usages", {
@@ -54,7 +54,7 @@ local({
   patrick::with_parameters_test_that(
     "Correctly handles concatenation within magrittr pipes",
     {
-      expect_lint(sprintf('"a" %s c("b")', pipe), NULL, linter)
+      expect_no_lint(sprintf('"a" %s c("b")', pipe), linter)
       expect_lint(sprintf('"a" %s c()', pipe), const_msg, linter)
       expect_lint(sprintf('"a" %s list("b", c())', pipe), no_arg_msg, linter)
     },
@@ -63,14 +63,24 @@ local({
   )
 })
 
+test_that("logic survives adversarial comments", {
+  expect_no_lint(
+    trim_some('
+      "a" %T>% # comment
+        c("b")
+    '),
+    unnecessary_concatenation_linter()
+  )
+})
+
 test_that("symbolic expressions are allowed, except by request", {
   linter <- unnecessary_concatenation_linter()
   linter_strict <- unnecessary_concatenation_linter(allow_single_expression = FALSE)
   lint_msg <- rex::rex("Remove unnecessary c() of a constant expression.")
 
-  expect_lint("c(alpha / 2)", NULL, linter)
-  expect_lint("c(paste0('.', 1:2))", NULL, linter)
-  expect_lint("c(DF[cond > 1, col])", NULL, linter)
+  expect_no_lint("c(alpha / 2)", linter)
+  expect_no_lint("c(paste0('.', 1:2))", linter)
+  expect_no_lint("c(DF[cond > 1, col])", linter)
 
   # allow_single_expression = FALSE turns both into lints
   expect_lint("c(alpha / 2)", lint_msg, linter_strict)
@@ -89,24 +99,24 @@ test_that("sequences with : are linted whenever a constant is involved", {
 
   # this is slightly different if a,b are factors, in which case : does
   #   something like interaction
-  expect_lint("c(a:b)", NULL, linter)
+  expect_no_lint("c(a:b)", linter)
   expect_lint("c(a:b)", expr_msg, linter_strict)
-  expect_lint("c(a:foo(b))", NULL, linter)
+  expect_no_lint("c(a:foo(b))", linter)
   expect_lint("c(a:foo(b))", expr_msg, linter_strict)
 })
 
 test_that("c(...) does not lint under !allow_single_expression", {
-  expect_lint("c(...)", NULL, unnecessary_concatenation_linter(allow_single_expression = FALSE))
+  expect_no_lint("c(...)", unnecessary_concatenation_linter(allow_single_expression = FALSE))
 })
 
 test_that("invalid allow_single_expression argument produce informative error messages", {
   expect_error(
-    expect_lint("c()", NULL, unnecessary_concatenation_linter(allow_single_expression = 1.0)),
+    expect_no_lint("c()", unnecessary_concatenation_linter(allow_single_expression = 1.0)),
     rex::rex("is.logical(allow_single_expression) is not TRUE")
   )
 
   expect_error(
-    expect_lint("c()", NULL, unnecessary_concatenation_linter(allow_single_expression = c(TRUE, FALSE))),
+    expect_no_lint("c()", unnecessary_concatenation_linter(allow_single_expression = c(TRUE, FALSE))),
     rex::rex("length(allow_single_expression) == 1L is not TRUE")
   )
 })
diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R
index 44655b44b..f3228058b 100644
--- a/tests/testthat/test-unnecessary_lambda_linter.R
+++ b/tests/testthat/test-unnecessary_lambda_linter.R
@@ -161,6 +161,15 @@ test_that("unnecessary_lambda_linter doesn't apply to keyword args", {
 
   expect_no_lint("lapply(x, function(xi) data.frame(nm = xi))", linter)
   expect_no_lint("lapply(x, function(xi) return(data.frame(nm = xi)))", linter)
+
+  # adversarially commented
+  expect_no_lint(
+    trim_some("
+      lapply(x, function(xi) data.frame(nm = # comment
+      xi))
+    "),
+    linter
+  )
 })
 
 test_that("purrr-style anonymous functions are also caught", {
@@ -185,6 +194,15 @@ test_that("purrr-style anonymous functions are also caught", {
     rex::rex("Pass foo directly as a symbol to map_vec()"),
     linter
   )
+
+  # adversarial comment
+  expect_no_lint(
+    trim_some("
+      map_dbl(x, ~foo(bar = # comment
+      .x))
+    "),
+    linter
+  )
 })
 
 test_that("cases with braces are caught", {
@@ -246,6 +264,16 @@ test_that("cases with braces are caught", {
   # false positives like #2231, #2247 are avoided with braces too
   expect_no_lint("lapply(x, function(xi) { foo(xi)$bar })", linter)
   expect_no_lint("lapply(x, function(xi) { foo(xi) - 1 })", linter)
+
+  expect_lint(
+    trim_some("
+      lapply(y, function(yi) {
+        print(yi) # comment
+      })
+    "),
+    lint_msg,
+    linter
+  )
 })
 
 test_that("function shorthand is handled", {
diff --git a/tests/testthat/test-unnecessary_nesting_linter.R b/tests/testthat/test-unnecessary_nesting_linter.R
index c48383e64..64c09855a 100644
--- a/tests/testthat/test-unnecessary_nesting_linter.R
+++ b/tests/testthat/test-unnecessary_nesting_linter.R
@@ -496,6 +496,21 @@ test_that("unnecessary_nesting_linter skips allowed usages", {
     linter
   )
 
+  # but comments are irrelevant (they should be moved to another anchor)
+  expect_lint(
+    trim_some("
+      if (x && a) {
+        # comment1
+        if (y || b) {
+          1L
+        }
+        # comment2
+      }
+    "),
+    "Combine this `if` statement with the one found at line 1",
+    linter
+  )
+
   expect_no_lint(
     trim_some("
       if (x) {
@@ -758,7 +773,7 @@ patrick::with_parameters_test_that(
   )
 )
 
-test_that("allow_functions= works", {
+test_that("allow_functions= works", { # nofuzz '})' break-up by comment
   linter_default <- unnecessary_nesting_linter()
   linter_foo <- unnecessary_nesting_linter(allow_functions = "foo")
   expect_lint("foo(x, {y}, z)", "Reduce the nesting of this statement", linter_default)
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
   )
 })
diff --git a/tests/testthat/test-vector_logic_linter.R b/tests/testthat/test-vector_logic_linter.R
index 6afaafbd4..d9d5d2f20 100644
--- a/tests/testthat/test-vector_logic_linter.R
+++ b/tests/testthat/test-vector_logic_linter.R
@@ -1,30 +1,31 @@
 test_that("vector_logic_linter skips allowed usages", {
   linter <- vector_logic_linter()
 
-  expect_lint("if (TRUE) 5 else if (TRUE) 2", NULL, linter)
-  expect_lint("if (TRUE || FALSE) 1; while (TRUE && FALSE) 2", NULL, linter)
+  expect_no_lint("if (TRUE) 5 else if (TRUE) 2", linter)
+  expect_no_lint("if (TRUE || FALSE) 1; while (TRUE && FALSE) 2", linter)
 
   # function calls and extractions may aggregate to scalars -- only catch
   #   usages at the highest logical level
-  expect_lint("if (agg_function(x & y)) 1", NULL, linter)
-  expect_lint("if (DT[x | y, cond]) 1", NULL, linter)
+  expect_no_lint("if (agg_function(x & y)) 1", linter)
+  expect_no_lint("if (DT[x | y, cond]) 1", linter)
 
   # don't match potentially OK usages nested within calls
-  expect_lint("if (TRUE && any(TRUE | FALSE)) 4", NULL, linter)
+  expect_no_lint("if (TRUE && any(TRUE | FALSE)) 4", linter)
   # even if the usage is nested in those calls (b/181915948)
-  expect_lint("if (TRUE && any(TRUE | FALSE | TRUE)) 4", NULL, linter)
+  expect_no_lint("if (TRUE && any(TRUE | FALSE | TRUE)) 4", linter)
 
   # don't match potentially OK usages in the branch itself
-  lines <- trim_some("
-    if (TRUE) {
-      x | y
-    }
-  ")
-  expect_lint(lines, NULL, linter)
-
+  expect_no_lint(
+    trim_some("
+      if (TRUE) {
+        x | y
+      }
+    "),
+    linter
+  )
 
   # valid nested usage within aggregator
-  expect_lint("testthat::expect_false(any(TRUE | TRUE))", NULL, linter)
+  expect_no_lint("testthat::expect_false(any(TRUE | TRUE))", linter)
 })
 
 test_that("vector_logic_linter blocks simple disallowed usages", {
@@ -63,7 +64,7 @@ test_that("vector_logic_linter catches usages in expect_true()/expect_false()",
 })
 
 test_that("vector_logic_linter doesn't get mixed up from complex usage", {
-  expect_lint(
+  expect_no_lint(
     trim_some("
       if (a) {
         expect_true(ok)
@@ -71,7 +72,6 @@ test_that("vector_logic_linter doesn't get mixed up from complex usage", {
         a | b
       }
     "),
-    NULL,
     vector_logic_linter()
   )
 })
@@ -79,25 +79,25 @@ test_that("vector_logic_linter doesn't get mixed up from complex usage", {
 test_that("vector_logic_linter recognizes some false positves around bitwise &/|", {
   linter <- vector_logic_linter()
 
-  expect_lint("if (info & as.raw(12)) { }", NULL, linter)
-  expect_lint("if (as.raw(12) & info) { }", NULL, linter)
-  expect_lint("if (info | as.raw(12)) { }", NULL, linter)
-  expect_lint("if (info & as.octmode('100')) { }", NULL, linter)
-  expect_lint("if (info | as.octmode('011')) { }", NULL, linter)
-  expect_lint("if (info & as.hexmode('100')) { }", NULL, linter)
-  expect_lint("if (info | as.hexmode('011')) { }", NULL, linter)
+  expect_no_lint("if (info & as.raw(12)) { }", linter)
+  expect_no_lint("if (as.raw(12) & info) { }", linter)
+  expect_no_lint("if (info | as.raw(12)) { }", linter)
+  expect_no_lint("if (info & as.octmode('100')) { }", linter)
+  expect_no_lint("if (info | as.octmode('011')) { }", linter)
+  expect_no_lint("if (info & as.hexmode('100')) { }", linter)
+  expect_no_lint("if (info | as.hexmode('011')) { }", linter)
   # implicit as.octmode() coercion
-  expect_lint("if (info & '100') { }", NULL, linter)
-  expect_lint("if (info | '011') { }", NULL, linter)
-  expect_lint("if ('011' | info) { }", NULL, linter)
+  expect_no_lint("if (info & '100') { }", linter)
+  expect_no_lint("if (info | '011') { }", linter)
+  expect_no_lint("if ('011' | info) { }", linter)
 
   # further nesting
-  expect_lint("if ((info & as.raw(12)) == as.raw(12)) { }", NULL, linter)
-  expect_lint("if ((info | as.raw(12)) == as.raw(12)) { }", NULL, linter)
-  expect_lint('if ((mode & "111") != as.octmode("111")) { }', NULL, linter)
-  expect_lint('if ((mode | "111") != as.octmode("111")) { }', NULL, linter)
-  expect_lint('if ((mode & "111") != as.hexmode("111")) { }', NULL, linter)
-  expect_lint('if ((mode | "111") != as.hexmode("111")) { }', NULL, linter)
+  expect_no_lint("if ((info & as.raw(12)) == as.raw(12)) { }", linter)
+  expect_no_lint("if ((info | as.raw(12)) == as.raw(12)) { }", linter)
+  expect_no_lint('if ((mode & "111") != as.octmode("111")) { }', linter)
+  expect_no_lint('if ((mode | "111") != as.octmode("111")) { }', linter)
+  expect_no_lint('if ((mode & "111") != as.hexmode("111")) { }', linter)
+  expect_no_lint('if ((mode | "111") != as.hexmode("111")) { }', linter)
 })
 
 test_that("incorrect subset/filter usage is caught", {
@@ -128,10 +128,29 @@ test_that("subsetting logic handles nesting", {
   expect_lint("filter(x, a & b || c)", or_msg, linter)
   expect_lint("filter(x, a && b | c)", and_msg, linter)
 
+  # adversarial commenting
+  expect_lint(
+    trim_some("
+      filter(x, a #comment
+      && b | c)
+    "),
+    and_msg,
+    linter
+  )
+
+  expect_lint(
+    trim_some("
+      filter(x, a && #comment
+      b | c)
+    "),
+    and_msg,
+    linter
+  )
+
   # but not valid usage
-  expect_lint("filter(x, y < mean(y, na.rm = AA && BB))", NULL, linter)
-  expect_lint("subset(x, y < mean(y, na.rm = AA && BB) & y > 0)", NULL, linter)
-  expect_lint("subset(x, y < x[y > 0, drop = AA && BB, y])", NULL, linter)
+  expect_no_lint("filter(x, y < mean(y, na.rm = AA && BB))", linter)
+  expect_no_lint("subset(x, y < mean(y, na.rm = AA && BB) & y > 0)", linter)
+  expect_no_lint("subset(x, y < x[y > 0, drop = AA && BB, y])", linter)
 })
 
 test_that("filter() handling is conservative about stats::filter()", {
@@ -139,35 +158,32 @@ test_that("filter() handling is conservative about stats::filter()", {
   and_msg <- rex::rex("Use `&` in subsetting expressions")
 
   # NB: this should be invalid, filter= is a vector argument
-  expect_lint("stats::filter(x, y && z)", NULL, linter)
+  expect_no_lint("stats::filter(x, y && z)", linter)
   # The only logical argument to stats::filter(), exclude by keyword
-  expect_lint("filter(x, circular = y && z)", NULL, linter)
+  expect_no_lint("filter(x, circular = y && z)", linter)
   # But presence of circular= doesn't invalidate lint
   expect_lint("filter(x, circular = TRUE, y && z)", and_msg, linter)
   expect_lint("filter(x, y && z, circular = TRUE)", and_msg, linter)
-  expect_lint(
+  expect_no_lint(
     trim_some("
       filter(x, circular # comment
       = y && z)
     "),
-    NULL,
     linter
   )
-  expect_lint(
+  expect_no_lint(
     trim_some("
       filter(x, circular = # comment
         y && z)
     "),
-    NULL,
     linter
   )
-  expect_lint(
+  expect_no_lint(
     trim_some("
       filter(x, circular # comment
       = # comment
       y && z)
     "),
-    NULL,
     linter
   )
 })