Fix problems with r-lintr, add unit tests (#4235)

* Add failing R lintr tests

* Remove bundled .lintr files

* Update lintr-caller to resolve test issues

* Fix lints

* Update CHANGELOG

* Fix logic for user-supplied config files

* Update .cspell.json

---------

Co-authored-by: Nicolas Vuillamy <nicolas.vuillamy@gmail.com>

.automation/test/r/r_good_1.r

@@ -1,27 +1,8 @@
-# Each of the default linters should throw at least one lint on this file
+# This file has no lints
 
-# assignment
-# function_left_parentheses
-# brace_linter
-# commas
-# paren_brace
 f <- function(x, y = 1) {
 
 }
-
-# commented_code
-
-# cyclocomp
-# equals_na
-# brace_linter
-# indentation
-# infix_spaces
-# line_length
-# object_length
-# object_name
-# object_usage
-# open_curly
-# T_and_F_symbol
 short_snake <- function(x) {
   y <- 1
   y <- y^2
@@ -32,32 +13,19 @@ short_snake <- function(x) {
   }
 }
 
-# vector_logic
 if (1 && 2) FALSE else TRUE
 
-# function_brace
 my_metric <- function(x) {
   sum(x) + prod(x)
 }
 
-# no_tab
-# pipe_continuation
-# seq_linter
-# spaces_inside
-# indentation
 x <- 1:10
 x[2]
 seq_len(x) %>%
   lapply(function(x) x * 2) %>%
   head()
 
-# single_quotes
 message("single_quotes")
 
-# spaces_left_parentheses
-# trailing_whitespace
-# semicolon
 x <- 42
 y <- 2 + (1:10)
-
-# trailing_blank_lines

.automation/test/r/subfolder/r_bad_2.r

@@ -0,0 +1,56 @@
+# Each of the default linters should throw at least one lint on this file
+
+# assignment
+# function_left_parentheses
+# brace_linter
+# commas
+# paren_brace
+f = function (x,y = 1){}
+
+# commented_code
+# some <- commented("out code")
+
+# cyclocomp
+# equals_na
+# brace_linter
+# indentation
+# infix_spaces
+# line_length
+# object_length
+# object_name
+# object_usage
+# open_curly
+# T_and_F_symbol
+someComplicatedFunctionWithALongCamelCaseName <- function(x)
+{
+    y <- 1
+  if (1 > 2 && 2 > 3 && 3 > 4 && 4 > 5 && 5*10 > 6 && 5 > 6 && 6 > 7 && x == NA) {T} else F
+}
+
+# vector_logic
+if (1 & 2) FALSE else TRUE
+
+# function_brace
+my_metric <- function(x)
+  sum(x) + prod(x)
+
+# no_tab
+# pipe_continuation
+# seq_linter
+# spaces_inside
+# indentation
+x <- 1:10
+x[ 2]
+1:length(x) %>% lapply(function(x) x*2) %>%
+	head()
+
+# single_quotes
+message('single_quotes')
+
+# spaces_left_parentheses
+# trailing_whitespace
+# semicolon
+x <- 42; y <- 2 +(1:10) 
+
+# trailing_blank_lines
+

.automation/test/r/subfolder/r_good_2.r

@@ -0,0 +1,31 @@
+# This file has no lints
+
+f <- function(x, y = 1) {
+
+}
+short_snake <- function(x) {
+  y <- 1
+  y <- y^2
+  if (1 > 2 && 5 * 10 > 6 && is.na(x)) {
+    TRUE
+  } else {
+    FALSE
+  }
+}
+
+if (1 && 2) FALSE else TRUE
+
+my_metric <- function(x) {
+  sum(x) + prod(x)
+}
+
+x <- 1:10
+x[2]
+seq_len(x) %>%
+  lapply(function(x) x * 2) %>%
+  head()
+
+message("single_quotes")
+
+x <- 42
+y <- 2 + (1:10)

.automation/test/r/subfolder_2/.lintr

@@ -0,0 +1,3 @@
+linters: linters_with_defaults(
+   assignment_linter = NULL
+  )

.automation/test/r/subfolder_2/r_good_with_lints.r

@@ -0,0 +1,3 @@
+# This file fails the assignment_linter
+
+f = function(x, y = 1) {}

.cspell.json

@@ -161,6 +161,7 @@
         "rulesetsoverridetype",
         "saishivarcr",
         "sanmai",
+        "setwd",
         "sffamily",
         "shelljs",
         "sisteransi",

CHANGELOG.md

@@ -23,6 +23,7 @@ Note: Can be used with `oxsecurity/megalinter@beta` in your GitHub Action mega-l
   - Trivy: handle retry if `failed to download Java DB` is detected
   - Salesforce linters: Add SF_CLI_DISABLE_AUTOUPDATE for SF CLI JIT plugins
   - Add message in PR comment if FAIL_IF_UPDATED_SOURCES is triggered
+  - Lintr: Support files in subdirectories, fix unit tests
 
 - Reporters
   - UpdatedSourcesReporter will git commit & push fixed files to source branch if APPLY_FIXES is set

megalinter/linters/RLinter.py

@@ -3,28 +3,31 @@
 Use lintr to lint R files
 https://github.com/r-lib/lintr
 """
-import os
-from shutil import copyfile
+from pathlib import Path
 
 from megalinter import Linter
 
 
 class RLinter(Linter):
     # Build the CLI command to call to lint a file
     def build_lint_command(self, file=None):
-        # lintr requires .lintr in folder: copy it there if necessary
-        dir_name = os.path.dirname(file)
-        if not os.path.isfile(dir_name + os.path.sep + self.config_file_name):
-            copyfile(self.config_file, dir_name + os.path.sep + self.config_file_name)
         # Build command in R format
         r_commands = [
-            f"lints <- lintr::lint('{file}');",
-            "print(lints);",
-            "errors <- purrr::keep(lints, ~ .type == 'error');",
-            "quit(save = 'no', status = if (length(errors) > 0) 1 else 0)",
+            # Change the working directory to match the file
+            f"setwd('{Path(file).parent}')",
+            # Instruct lintr to walk up the directory tree
+            f"lintr:::read_settings('{self.config_file_name}')",
+            f"lints <- lintr::lint('{Path(file).name}')",
+            "print(lints)",
+            "quit(save = 'no', status = if (length(lints) > 0) 1 else 0)",
         ]
+
+        if self.config_file:
+            # Instruct lintr to load an absolute filepath
+            r_commands.insert(0, f"options('lintr.linter_file' = '{self.config_file}')")
+
         # Build shell command
-        cmd = ["R", "--slave", "-e", "".join(r_commands)]
+        cmd = ["R", "--slave", "-e", ";".join(r_commands)]
         return cmd
 
     # Build the CLI command to request lintr version