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/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", {