Remove some tests of internal API

.gitignore

@@ -7,6 +7,7 @@ bad.R
 script.R
 *~
 \#*\#
+*.swp
 
 *.o
 *.so

NEWS.md

@@ -23,6 +23,7 @@
 * `indentation_linter()` handles `for` un-braced for loops correctly (#2564, @MichaelChirico).
 * Setting `exclusions` supports globs like `knitr*` to exclude files/directories with a pattern (#1554, @MichaelChirico).
 * `object_name_linter()` and `object_length_linter()` apply to objects assigned with `assign()` or generics created with `setGeneric()` (#1665, @MichaelChirico).
+* `expect_lint()` has a new argument `ignore_order` (default `FALSE`), which, if `TRUE`, allows the `checks=` to be provided in arbitary order vs. how `lint()` produces them (@MichaelChirico).
 
 ### Lint accuracy fixes: removing false positives
 

R/expect_lint.R

@@ -4,9 +4,9 @@
 #' * `expect_lint` asserts that specified lints are generated.
 #' * `expect_no_lint` asserts that no lints are generated.
 #'
-#' @param content a character vector for the file content to be linted, each vector element representing a line of
-#' text.
-#' @param checks checks to be performed:
+#' @param content A character vector for the file content to be linted, each vector element representing a line of
+#'   text.
+#' @param checks Checks to be performed:
 #' \describe{
 #'   \item{NULL}{check that no lints are returned.}
 #'   \item{single string or regex object}{check that the single lint returned has a matching message.}
@@ -16,11 +16,14 @@
 #'     corresponding named list (as described in the point above).}
 #' }
 #' Named vectors are also accepted instead of named lists, but this is a compatibility feature that
-#' is not recommended for new code.
-#' @param ... arguments passed to [lint()], e.g. the linters or cache to use.
-#' @param file if not `NULL`, read content from the specified file rather than from `content`.
-#' @param language temporarily override Rs `LANGUAGE` envvar, controlling localization of base R error messages.
-#' This makes testing them reproducible on all systems irrespective of their native R language setting.
+#'   is not recommended for new code.
+#' @param ... Arguments passed to [lint()], e.g. the linters or cache to use.
+#' @param file If not `NULL`, read content from the specified file rather than from `content`.
+#' @param language Temporarily override Rs `LANGUAGE` envvar, controlling localization of base R error messages.
+#'   This makes testing them reproducible on all systems irrespective of their native R language setting.
+#' @param ignore_order Logical, default `FALSE`. If `TRUE`, the order of the `checks` does not matter, e.g.
+#'   lints with higher line numbers can come before those with lower line numbers, and the order of linters
+#'   affecting the same line is also irrelevant.
 #' @return `NULL`, invisibly.
 #' @examples
 #' # no expected lint
@@ -41,7 +44,7 @@
 #'   trailing_blank_lines_linter()
 #' )
 #' @export
-expect_lint <- function(content, checks, ..., file = NULL, language = "en") {
+expect_lint <- function(content, checks, ..., file = NULL, language = "en", ignore_order = FALSE) {
   require_testthat()
 
   old_lang <- set_lang(language)
@@ -59,11 +62,11 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") {
 
   lints <- lint(file, ...)
   n_lints <- length(lints)
-  lint_str <- if (n_lints) paste(c("", lints), collapse = "\n") else ""
+  lint_fmt <- function() if (n_lints > 0L) paste(c("", lints), collapse = "\n") else ""
 
   wrong_number_fmt <- "got %d lints instead of %d%s"
   if (is.null(checks)) {
-    msg <- sprintf(wrong_number_fmt, n_lints, length(checks), lint_str)
+    msg <- sprintf(wrong_number_fmt, n_lints, length(checks), lint_fmt())
     return(testthat::expect(n_lints %==% 0L, msg))
   }
 
@@ -73,14 +76,26 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") {
   checks[] <- lapply(checks, fix_names, "message")
 
   if (n_lints != length(checks)) {
-    msg <- sprintf(wrong_number_fmt, n_lints, length(checks), lint_str)
+    msg <- sprintf(wrong_number_fmt, n_lints, length(checks), lint_fmt())
     return(testthat::expect(FALSE, msg))
   }
 
+  if (ignore_order) {
+    lint_order <- with(as.data.frame(lints), order(line_number, column_number, linter))
+    lints <- lints[lint_order]
+
+    check_order <- order(
+      vapply(checks, function(x) x$line_number %||% 0L, FUN.VALUE = integer(1L)),
+      vapply(checks, function(x) x$column_number %||% 0L, FUN.VALUE = integer(1L)),
+      vapply(checks, function(x) x$linter %||% "", FUN.VALUE = character(1L))
+    )
+    checks <- checks[check_order]
+  }
+
   local({
     itr <- 0L
-    # keep 'linter' as a field even if we remove the deprecated argument from Lint() in the future
-    lint_fields <- unique(c(names(formals(Lint)), "linter"))
+    # valid fields are those from Lint(), plus 'linter'
+    lint_fields <- c(names(formals(Lint)), "linter")
     Map(
       function(lint, check) {
         itr <<- itr + 1L

R/make_linter_from_regex.R

@@ -1,7 +1,7 @@
 make_linter_from_regex <- function(regex,
                                    lint_type,
                                    lint_msg) {
-  function() {
+  function() { # nocov: only run at namespace load time
     Linter(linter_level = "file", function(source_expression) {
       all_matches <- re_matches(
         source_expression[["file_lines"]],
@@ -29,7 +29,7 @@
       })
       lints[lengths(lints) > 0L]
     })
-  }
+  } # nocov: ditto opening brace
 }
 
 #' Determine if a regex match is covered by an expression in a source_expression

R/methods.R

@@ -85,39 +85,6 @@ print.lints <- function(x, ...) {
   invisible(x)
 }
 
-trim_output <- function(x, max = 65535L) {
-  # if x is less than the max, just return it
-  if (length(x) <= 0L || nchar(x) <= max) {
-    return(x)
-  }
-
-  # otherwise trim x to the max, then search for the lint starts
-  x <- substr(x, 1L, max)
-
-  re <- rex(
-    "[", except_some_of(":"), ":", numbers, ":", numbers, ":", "]",
-    "(", except_some_of(")"), ")",
-    space,
-    "*", or("style", "warning", "error"), ":", "*",
-    except_some_of("\r\n"), newline,
-    except_some_of("\r\n"), newline,
-    except_some_of("\r\n"), newline,
-    except_some_of("\r\n"), newline,
-    except_some_of("\r\n"), newline
-  )
-
-  lint_starts <- re_matches(x, re, global = TRUE, locations = TRUE)[[1L]]
-
-  # if at least one lint ends before the cutoff, cutoff there, else just use
-  # the cutoff
-  last_end <- lint_starts[NROW(lint_starts), "end"]
-  if (!is.na(last_end)) {
-    substr(x, 1L, last_end)
-  } else {
-    x
-  }
-}
-
 #' @export
 names.lints <- function(x, ...) {
   vapply(x, `[[`, character(1L), "filename")

R/path_utils.R

@@ -57,10 +57,6 @@ is_root_path <- function(path) {
   re_matches(path, root_path_regex)
 }
 
-is_relative_path <- function(path) {
-  re_matches(path, relative_path_regex)
-}
-
 is_path <- function(path) {
   re_matches(path, path_regex)
 }

tests/testthat/dummy_projects/project/mismatched_starts_ends.R

@@ -1,11 +1,11 @@
-#nolint end
+#TeSt_NoLiNt_EnD
 
-#nolint start
+#TeSt_NoLiNt_StArT
 
 c(1,2)
 
-#nolint start
+#TeSt_NoLiNt_StArT
 
-#nolint end
+#TeSt_NoLiNt_EnD
 
-#nolint start
+#TeSt_NoLiNt_StArT

tests/testthat/dummy_projects/project/one_start_no_end.R

@@ -1,5 +1,5 @@
 
 
-#nolint start
+#TeSt_NoLiNt_StArT
 
 c(1,2)

tests/testthat/test-absolute_path_linter.R

@@ -1,134 +1,3 @@
-# styler: off
-test_that("is_root_path", {
-  f <- lintr:::is_root_path
-
-  x <- character()
-  y <- logical()
-  expect_identical(f(x), y)
-
-  x <- c("",    "foo", "http://rseek.org/", "./",  " /",  "/foo", "'/'")
-  y <- c(FALSE, FALSE, FALSE,               FALSE, FALSE, FALSE,  FALSE)
-  expect_identical(f(x), y)
-
-  x <- c("/",  "//")
-  y <- c(TRUE, FALSE)
-  expect_identical(f(x), y)
-
-  x <- c("~",  "~/", "~//", "~bob2", "~foo_bar/")
-  y <- c(TRUE, TRUE, TRUE,  TRUE,    TRUE)
-  expect_identical(f(x), y)
-
-  x <- c("c:", "C:\\", "D:/", "C:\\\\", "D://")
-  y <- c(TRUE, TRUE,   TRUE,  FALSE,    FALSE)
-  expect_identical(f(x), y)
-
-  x <- c("\\\\", "\\\\localhost", "\\\\localhost\\")
-  y <- c(TRUE,   TRUE,            TRUE)
-  expect_identical(f(x), y)
-})
-
-
-test_that("is_absolute_path", {
-  f <- lintr:::is_absolute_path
-
-  x <- character()
-  y <- logical()
-  expect_identical(f(x), y)
-
-  x <- c("/",  "//",  "/foo", "/foo/")
-  y <- c(TRUE, FALSE, TRUE,   TRUE)
-  expect_identical(f(x), y)
-
-  x <- c("~",  "~/foo", "~/foo/", "~'")
-  y <- c(TRUE, TRUE,    TRUE,     FALSE)
-  expect_identical(f(x), y)
-
-  x <- c("c:", "C:\\foo\\", "C:/foo/")
-  y <- c(TRUE, TRUE,        TRUE)
-  expect_identical(f(x), y)
-
-  x <- c("\\\\", "\\\\localhost", "\\\\localhost\\c$", "\\\\localhost\\c$\\foo")
-  y <- c(TRUE,   TRUE,            TRUE,                TRUE)
-  expect_identical(f(x), y)
-})
-
-
-test_that("is_relative_path", {
-  f <- lintr:::is_relative_path
-
-  x <- character()
-  y <- logical()
-  expect_identical(f(x), y)
-
-  x <- c("/",   "c:\\", "~/",  "foo", "http://rseek.org/", "'./'")
-  y <- c(FALSE, FALSE,  FALSE, FALSE, FALSE,               FALSE)
-  expect_identical(f(x), y)
-
-  x <- c("/foo", "foo/", "foo/bar", "foo//bar", "./foo", "../foo")
-  y <- c(FALSE,  TRUE,   TRUE,      TRUE,       TRUE,    TRUE)
-  expect_identical(f(x), y)
-
-  x <- c("\\\\", "\\foo", "foo\\", "foo\\bar", ".\\foo", "..\\foo", ".",  "..", "../")
-  y <- c(FALSE,  FALSE,   TRUE,    TRUE,       TRUE,     TRUE,      TRUE, TRUE, TRUE)
-  expect_identical(f(x), y)
-})
-
-
-test_that("is_path", {
-  f <- lintr:::is_path
-
-  x <- character()
-  y <- logical()
-  expect_identical(f(x), y)
-
-  x <- c("",    "foo", "http://rseek.org/", "foo\nbar", "'foo/bar'", "'/'")
-  y <- c(FALSE, FALSE, FALSE,               FALSE,      FALSE,       FALSE)
-  expect_identical(f(x), y)
-
-  x <- c("c:", "..", "foo/bar", "foo\\bar", "~",  "\\\\localhost")
-  y <- c(TRUE, TRUE, TRUE,      TRUE,       TRUE, TRUE)
-  expect_identical(f(x), y)
-})
-
-
-test_that("is_valid_path", {
-  f <- lintr:::is_valid_path
-
-  x <- character()
-  y <- logical()
-  expect_identical(f(x), y)
-
-  x <- c("C:/asdf", "C:/asd*f", "a\\s:df", "a\\\nsdf")
-  y <- c(TRUE,      FALSE,      FALSE,     FALSE)
-  expect_identical(f(x), y)
-
-  x <- c("C:/asdf", "C:/asd*f", "a\\s:df", "a\\\nsdf")
-  y <- c(TRUE,      FALSE,      FALSE,     FALSE)
-  expect_identical(f(x, lax = TRUE), y)
-
-  x <- c("/asdf", "/asd*f", "/as:df", "/a\nsdf")
-  y <- c(TRUE,    TRUE,     TRUE,     TRUE)
-  expect_identical(f(x), y)
-
-  x <- c("/asdf", "/asd*f", "/as:df", "/a\nsdf")
-  y <- c(TRUE,    FALSE,    FALSE,    FALSE)
-  expect_identical(f(x, lax = TRUE), y)
-})
-
-
-test_that("is_long_path", {
-  f <- lintr:::is_long_path
-
-  x <- character()
-  y <- logical()
-  expect_identical(f(x), y)
-
-  x <- c("foo/", "/foo", "n/a", "Z:\\foo", "foo/bar", "~/foo", "../foo")
-  y <- c(FALSE,  FALSE,  FALSE, TRUE,      TRUE,      TRUE,    TRUE)
-  expect_identical(f(x), y)
-})
-# styler: on
-
 test_that("returns the correct linting", {
   lint_msg <- rex::escape("Do not use absolute paths.")