Merge pull request #722 from jimhester/fix/451-commented-code

Author: AshesITR

NEWS.md

@@ -45,6 +45,7 @@
 * Set the default `complexity_limit` in `cyclocomp_linter` to 15. This is the same complexity limit that is enforced via
   `default_linters` (#693, #695, @AshesITR).
 * `lint_package()` now lints files in the `demo` directory by default (#703, @dmurdoch).
+* `commented_code_linter()` uses the parse tree to find comments, eliminating some false positives (#451, @AshesITR)
 
 # lintr 2.0.1
 

R/comment_linters.R

@@ -27,37 +27,42 @@ ops <- list(
 #' blocks
 #' @export
 commented_code_linter <- function(source_file) {
-  res <- re_matches(source_file$file_lines,
-                    rex(some_of("#"), any_spaces,
-                        capture(name = "code",
-                          # except("'"),
-                          anything,
-                          or(some_of("{}[]"), # code-like parentheses
-                            or(ops), # any operator
-                            group(graphs, "(", anything, ")"), # a function call
-                            group("!", alphas) # a negation
-                            ),
-                          anything
-                        )
-                    ),
-                    global = FALSE, locations = TRUE)
+  if (is.null(source_file$full_xml_parsed_content)) return(list())
+  all_comment_nodes <- xml2::xml_find_all(source_file$full_xml_parsed_content, "//COMMENT")
+  all_comments <- xml2::xml_text(all_comment_nodes)
+  code_candidates <- re_matches(
+    all_comments,
+    rex(some_of("#"), any_spaces,
+        capture(name = "code",
+                # except("'"),
+                anything,
+                or(some_of("{}[]"), # code-like parentheses
+                   or(ops), # any operator
+                   group(graphs, "(", anything, ")"), # a function call
+                   group("!", alphas) # a negation
+                ),
+                anything
+        )
+    ),
+    global = FALSE, locations = TRUE)
 
-  line_numbers <- rownames(na.omit(res))
-  lapply(line_numbers, function(line_number) {
-    line <- source_file$file_lines[as.numeric(line_number)]
-    is_parsable <- parsable(substr(line,
-                                   res[line_number, "code.start"],
-                                   res[line_number, "code.end"]))
+  lapply(rownames(na.omit(code_candidates)), function(code_candidate) {
+    is_parsable <- parsable(code_candidates[code_candidate, "code"])
     if (is_parsable) {
+      comment_node <- all_comment_nodes[[as.integer(code_candidate)]]
+      line_number <- as.integer(xml2::xml_attr(comment_node, "line1"))
+      column_offset <- as.integer(xml2::xml_attr(comment_node, "col1")) - 1L
+
       Lint(
         filename = source_file$filename,
         line_number = line_number,
-        column_number = res[line_number, "code.start"],
+        column_number = column_offset + code_candidates[line_number, "code.start"],
         type = "style",
         message = "Commented code should be removed.",
-        line = line,
+        line = source_file$file_lines[line_number],
         linter = "commented_code_linter",
-        ranges = list(c(res[line_number, "code.start"], res[line_number, "code.end"]))
+        ranges = list(column_offset + c(code_candidates[line_number, "code.start"],
+                                        code_candidates[line_number, "code.end"]))
         )
     }
   })

tests/testthat/test-commented_code_linter.R

@@ -52,4 +52,7 @@ test_that("returns the correct linting", {
 
   expect_lint("1+1 # cat('123')", msg, linter)
   expect_lint("#expect_ftype(1e-12 , t)", msg, linter)
+
+  # regression test for #451
+  expect_lint("c('#a#' = 1)", NULL, linter)
 })