adapt backport linter to R 4.1.0 and make versioning more robust (#974)

* adapt backport linter to R 4.1.0 and make versioning more robust

* incorporate feedback

* use logical indexing instead of tricky head() call, rename variable to clarify purpose

Author: AshesITR

R/backport_linter.R

@@ -7,25 +7,22 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 backport_linter <- function(r_version = getRversion()) {
+  r_version <- normalize_r_version(r_version)
+
   Linter(function(source_file) {
-    if (inherits(r_version, "numeric_version")) r_version <- format(r_version)
-    if (r_version < "3.0.0") {
-      warning("It is not recommended to depend on an R version older than 3.0.0. Resetting 'r_version' to 3.0.0.")
-      r_version <- "3.0.0"
-    }
     if (is.null(source_file$xml_parsed_content)) return(list())
+    if (all(r_version >= R_system_version(names(backports)))) return(list())
 
     xml <- source_file$xml_parsed_content
 
     names_xpath <- "//*[self::SYMBOL or self::SYMBOL_FUNCTION_CALL]"
     all_names_nodes <- xml2::xml_find_all(xml, names_xpath)
     all_names <- xml2::xml_text(all_names_nodes)
 
-    # guaranteed to include 1 by early return above; which.min fails if all TRUE (handled by nomatch)
-    needs_backport_names <- backports[1:(match(FALSE, r_version < names(backports), nomatch = length(backports)) - 1L)]
+    backport_blacklist <- backports[r_version < R_system_version(names(backports))]
 
     # not sapply/vapply, which may over-simplify to vector -- cbind makes sure we have a matrix so rowSums works
-    needs_backport <- do.call(cbind, lapply(needs_backport_names, function(nm) all_names %in% nm))
+    needs_backport <- do.call(cbind, lapply(backport_blacklist, function(nm) all_names %in% nm))
     bad_idx <- rowSums(needs_backport) > 0L
 
     lapply(which(bad_idx), function(ii) {
@@ -42,7 +39,7 @@ backport_linter <- function(r_version = getRversion()) {
         type = "warning",
         message = sprintf(
           "%s (R %s) is not available for dependency R >= %s.",
-          all_names[ii], names(needs_backport_names)[which(needs_backport[ii, ])], r_version
+          all_names[ii], names(backport_blacklist)[which(needs_backport[ii, ])], r_version
         ),
         line = source_file$lines[[line1]],
         ranges = list(c(col1, col2))
@@ -51,8 +48,45 @@ backport_linter <- function(r_version = getRversion()) {
   })
 }
 
+normalize_r_version <- function(r_version) {
+  if (is.character(r_version) &&
+    re_matches(r_version, rex(start, "release" %or%
+      list("oldrel", maybe("-", digits)) %or%
+      "devel", end))) {
+    # Support devel, release, oldrel, oldrel-1, ...
+
+    all_versions <- names(backports)
+    minor_versions <- unique(re_substitutes(all_versions, rex(".", digits, end), ""))
+    version_names <- c("devel", "release", "oldrel", paste0("oldrel-", seq_len(length(minor_versions) - 3L)))
+    if (!r_version %in% version_names) {
+      # This can only trip if e.g. oldrel-99 is requested
+      stop("`r_version` must be a version number or one of ", toString(sQuote(version_names)))
+    }
+    requested_version <- minor_versions[match(r_version, table = version_names)]
+    available_patches <- all_versions[startsWith(all_versions, requested_version)]
+    selected_patch <- which.max(as.integer(
+      substr(available_patches, start = nchar(requested_version) + 2L, stop = nchar(available_patches))
+    ))
+
+    r_version <- R_system_version(available_patches[selected_patch])
+  } else if (is.character(r_version)) {
+    r_version <- R_system_version(r_version, strict = TRUE)
+  } else if (!inherits(r_version, "R_system_version")) {
+    stop("`r_version` must be a R version number, returned by R_system_version(), or a string.")
+  }
+  if (r_version < "3.0.0") {
+    warning("It is not recommended to depend on an R version older than 3.0.0. Resetting 'r_version' to 3.0.0.")
+    r_version <- R_system_version("3.0.0")
+  }
+  r_version
+}
+
+# Sources:
+# devel NEWS https://cran.rstudio.com/doc/manuals/r-devel/NEWS.html
+# release NEWS https://cran.r-project.org/doc/manuals/r-release/NEWS.html
 backports <- list(
-  `devel` = c("...names", "checkRdContents", "numToBits", "numToInts", "packBits"),
+  `4.2.0` = c(".pretty", ".LC.categories", "Sys.setLanguage()"), # R devel needs to be ahead of all other versions
+  `4.1.0` = c("numToBits", "numToInts", "gregexec", "charClass", "checkRdContents", "...names"),
   `4.0.0` = c(
     ".class2", ".S3method", "activeBindingFunction", "deparse1", "globalCallingHandlers",
     "infoRDS", "list2DF", "marginSums", "proportions", "R_user_dir", "socketTimeout", "tryInvokeRestart"

tests/testthat/test-backport_linter.R

@@ -1,6 +1,8 @@
 test_that("backport_linter detects backwards-incompatibility", {
   # default should be current R version; all of these are included on our dependency
   expect_lint(".getNamespaceInfo(dir.exists(lapply(x, toTitleCase)))", NULL, backport_linter())
+  expect_lint(".getNamespaceInfo(dir.exists(lapply(x, toTitleCase)))", NULL, backport_linter("release"))
+  expect_lint(".getNamespaceInfo(dir.exists(lapply(x, toTitleCase)))", NULL, backport_linter("devel"))
 
   # don't allow dependencies older than we've recorded
   writeLines("x <- x + 1", tmp <- tempfile())
@@ -11,22 +13,38 @@ test_that("backport_linter detects backwards-incompatibility", {
 
   expect_lint(
     "numToBits(2)",
-    rex("numToBits (R devel) is not available for dependency R >= 4.0.0."),
+    rex("numToBits (R 4.1.0) is not available for dependency R >= 4.0.0."),
     backport_linter("4.0.0")
   )
   # symbols as well as calls
   expect_lint(
     "lapply(1:10, numToBits)",
-    rex("numToBits (R devel) is not available for dependency R >= 4.0.0."),
+    rex("numToBits (R 4.1.0) is not available for dependency R >= 4.0.0."),
     backport_linter("4.0.0")
   )
 
   expect_lint(
     "trimws(...names())",
     list(
       rex("trimws (R 3.2.0) is not available for dependency R >= 3.0.0."),
-      rex("...names (R devel) is not available for dependency R >= 3.0.0.")
+      rex("...names (R 4.1.0) is not available for dependency R >= 3.0.0.")
     ),
     backport_linter("3.0.0")
   )
+
+  # oldrel specification
+  expect_lint(
+    "numToBits(2)",
+    rex("numToBits (R 4.1.0) is not available for dependency R >= 4.0.0."),
+    backport_linter("oldrel")
+  )
+
+  expect_error(backport_linter("oldrel-99"), "`r_version` must be a version number or one of")
+
+  # NB: oldrel-1 could be 3.6.3, but we don't have any backports listed for 3.6.3
+  expect_lint(
+    "numToBits(2)",
+    rex("numToBits (R 4.1.0) is not available for dependency R >= 3.6.0."),
+    backport_linter("oldrel-1")
+  )
 })