Improve robustness to comments in matrix_apply_linter() (#2896)

* Improve robustness to comments

* need strip_comments_from_subtree

* Improve robustness to comments

Author: MichaelChirico

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))
 

tests/testthat/test-matrix_apply_linter.R

@@ -1,86 +1,81 @@
 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)")
   expect_lint("apply(x, 1, sum)", lint_message, linter)
 
   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", {