Remove some tests of internal API

.gitignore

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

NEWS.md

@@ -33,6 +33,7 @@
 * Setting `exclusions` supports globs like `knitr*` to exclude files/directories with a pattern (#1554, @MichaelChirico).
 * `get_source_expression()` captures warnings emitted by the R parser (currently always for mis-specified literal integers like `1.1L`) and `lint()` returns them as lints (#2065, @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).
 * `object_usage_linter()` gains argument `interpret_extensions` to govern which false positive-prone common syntaxes should be checked for used objects (#1472, @MichaelChirico). Currently `"glue"` (renamed from earlier argument `interpret_glue`) and `"rlang"` are supported. The latter newly covers usage of the `.env` pronoun like `.env$key`, where `key` was previously missed as being a used variable.
 * `boolean_arithmetic_linter()` finds many more cases like `sum(x | y) == 0` where the total of a known-logical vector is compared to 0 (#1580, @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).

R/expect_lint.R

@@ -62,11 +62,11 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en", igno
 
   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))
   }
 
@@ -76,7 +76,7 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en", igno
   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))
   }
 

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