From dbff7ca0ead763dfee10de9eebbdd943badc5a70 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 29 Nov 2020 02:06:35 -0500 Subject: [PATCH 1/7] first pass at implementing a backport_linter --- NEWS.md | 1 + R/backport_linter.R | 83 +++++++++++++++++++++++++++ tests/testthat/test-backport_linter.R | 28 +++++++++ 3 files changed, 112 insertions(+) create mode 100644 R/backport_linter.R create mode 100644 tests/testthat/test-backport_linter.R diff --git a/NEWS.md b/NEWS.md index a91a788a2..65a007ec7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -15,6 +15,7 @@ * New `sprintf_linter()` (#544, #578, @renkun-ken) * Exclusions specified in the `.lintr` file are now relative to the location of that file and support excluding entire directories (#158, #438, @AshesITR) +* New `backport_linter()` for detecting mismatched R version dependencies (#506, @MichaelChirico) # lintr 2.0.1 diff --git a/R/backport_linter.R b/R/backport_linter.R new file mode 100644 index 000000000..a102b1717 --- /dev/null +++ b/R/backport_linter.R @@ -0,0 +1,83 @@ +#' @describeIn linters that checks for usage of unavailable functions. Not reliable for testing r-devel dependencies. +#' @export +backport_linter <- function(r_version = "4.0.3") { + function(source_file) { + if (is.null(source_file$xml_parsed_content) || r_version >= "r-devel") return(list()) + + xml <- source_file$xml_parsed_content + + #browser() + + 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)] + + # not sapply, which may over-simplify -- cbind makes sure apply works + needs_backport <- do.call(cbind, lapply(needs_backport_names, function(nm) all_names %in% nm)) + bad_idx <- apply(needs_backport, 1L, any) + + lapply(which(bad_idx), function(ii) { + node <- all_names_nodes[[ii]] + line1 <- xml2::xml_attr(node, "line1") + col1 <- as.integer(xml2::xml_attr(node, "col1")) + if (xml2::xml_attr(node, "line2") == line1) { + col2 <- as.integer(xml2::xml_attr(node, "col2")) + } else { + col2 <- nchar(source_file$lines[line1]) + } + Lint( + filename = source_file$filename, + line_number = as.integer(line1), + column_number = col1, + 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 + ), + line = source_file$lines[[line1]], + ranges = list(c(col1, col2)), + linter = "backport_linter" + ) + }) + } +} + +backports = list( + `r-devel` = c("...names", "checkRdContents", "numToBits", "numToInts", "packBits"), + `4.0.0` = c( + ".class2", ".S3method", "activeBindingFunction", "deparse1", "globalCallingHandlers", + "infoRDS", "list2DF", "marginSums", "proportions", "R_user_dir", "socketTimeout", "tryInvokeRestart" + ), + `3.6.0` = c( + "asplit", "hcl.colors", "hcl.pals", "mem.maxNsize", "mem.maxVsize", "nullfile", "str2lang", + "str2expression", "update_PACKAGES" + ), + `3.5.0` = c("...elt", "...length", "askYesNo", "getDefaultCluster", "packageDate", "warnErrList"), + `3.4.0` = c( + "check_packages_in_dir_details", "CRAN_package_db", "debugcall", "hasName", + "isS3stdgeneric", "strcapture", "Sys.setFileTime", "undebugcall" + ), + `3.3.0` = c( + ".traceback", "chkDots", "curlGetHeaders", "endsWith", "grouping", "isS3method", + "makevars_site", "makevars_user", "Rcmd", "sigma", "startsWith", "strrep", "validEnc", "validUTF8" + ), + `3.2.0` = c( + ".getNamespaceInfo", "check_packages_in_dir_changes", "debuggingState", + "dir.exists", "dynGet", "extSoftVersion", "get0", "grSoftVersion", "hsearch_db", + "isNamespaceLoaded", "lengths", "libcurlVersion", "returnValue", "tclVersion", "toTitleCase", "trimws" + ), + `3.1.3` = "pcre_config", + `3.1.2` = "icuGetCollate", + `3.1.1` = c(".nknots.smspl", "promptImport"), + `3.1.0` = c("agrepl", "anyNA", "changedFiles", "cospi", "fileSnapshot", "find_gs_cmd", "sinpi", "tanpi"), + `3.0.3` = "La_version", + `3.0.2` = c("assertCondition", "assertError", "assertWarning", "getVignetteInfo"), + `3.0.0` = c( + ".onDetach", "bitwAnd", "bitwNot", "bitwOr", "bitwShiftL", "bitwShiftR", "bitwXor", + "check_packages_in_dir", "cite", "citeNatbib", "clearPushBack", "packageName", + "process.events", "provideDimnames", "quartz.save", "rep_len" + ) +) diff --git a/tests/testthat/test-backport_linter.R b/tests/testthat/test-backport_linter.R new file mode 100644 index 000000000..bc6a79d97 --- /dev/null +++ b/tests/testthat/test-backport_linter.R @@ -0,0 +1,28 @@ +test_that("backport_linter detects backwards-incompatibility", { + # this test may be too fragile? + expect_lint("numToBits(1)", NULL, backport_linter("r-devel")) + + # 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( + "numToBits(2)", + rex("numToBits (R r-devel) 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 r-devel) 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 r-devel) is not available for dependency R >= 3.0.0.") + ), + backport_linter("3.0.0") + ) +}) From 8662f647c7c4fd5321c40967e870a761e0480328 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 29 Nov 2020 02:15:12 -0500 Subject: [PATCH 2/7] need Collate order --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index b75973c71..0fed759e3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -45,6 +45,7 @@ Collate: 'addins.R' 'assignment_linter.R' 'assignment_spaces_linter.R' + 'backport_linter.R' 'cache.R' 'closed_curly_linter.R' 'commas_linter.R' From 7fcda6a2795a124d99b2e880f0b2d041d7ba6db7 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 29 Nov 2020 02:22:02 -0500 Subject: [PATCH 3/7] good job lintr bot --- R/backport_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/backport_linter.R b/R/backport_linter.R index a102b1717..35bdcf422 100644 --- a/R/backport_linter.R +++ b/R/backport_linter.R @@ -45,7 +45,7 @@ backport_linter <- function(r_version = "4.0.3") { } } -backports = list( +backports <- list( `r-devel` = c("...names", "checkRdContents", "numToBits", "numToInts", "packBits"), `4.0.0` = c( ".class2", ".S3method", "activeBindingFunction", "deparse1", "globalCallingHandlers", From 99f03f0999cd17dec13bbb1a050e828da6b33e8d Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 29 Nov 2020 12:48:30 -0500 Subject: [PATCH 4/7] incorporate some feedback --- R/backport_linter.R | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/R/backport_linter.R b/R/backport_linter.R index 35bdcf422..700d5dc0e 100644 --- a/R/backport_linter.R +++ b/R/backport_linter.R @@ -1,13 +1,12 @@ #' @describeIn linters that checks for usage of unavailable functions. Not reliable for testing r-devel dependencies. #' @export -backport_linter <- function(r_version = "4.0.3") { +backport_linter <- function(r_version = getRversion()) { function(source_file) { - if (is.null(source_file$xml_parsed_content) || r_version >= "r-devel") return(list()) + if (inherits(r_version, "numeric_version")) r_version <- format(r_version) + if (is.null(source_file$xml_parsed_content) || r_version >= "r") return(list()) xml <- source_file$xml_parsed_content - #browser() - 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) @@ -15,9 +14,9 @@ backport_linter <- function(r_version = "4.0.3") { # 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)] - # not sapply, which may over-simplify -- cbind makes sure apply works + # 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)) - bad_idx <- apply(needs_backport, 1L, any) + bad_idx <- rowSums(needs_backport) > 0L lapply(which(bad_idx), function(ii) { node <- all_names_nodes[[ii]] @@ -46,7 +45,7 @@ backport_linter <- function(r_version = "4.0.3") { } backports <- list( - `r-devel` = c("...names", "checkRdContents", "numToBits", "numToInts", "packBits"), + `r` = c("...names", "checkRdContents", "numToBits", "numToInts", "packBits"), `4.0.0` = c( ".class2", ".S3method", "activeBindingFunction", "deparse1", "globalCallingHandlers", "infoRDS", "list2DF", "marginSums", "proportions", "R_user_dir", "socketTimeout", "tryInvokeRestart" @@ -55,7 +54,7 @@ backports <- list( "asplit", "hcl.colors", "hcl.pals", "mem.maxNsize", "mem.maxVsize", "nullfile", "str2lang", "str2expression", "update_PACKAGES" ), - `3.5.0` = c("...elt", "...length", "askYesNo", "getDefaultCluster", "packageDate", "warnErrList"), + `3.5.0` = c("...elt", "...length", "askYesNo", "getDefaultCluster", "isFALSE", "packageDate", "warnErrList"), `3.4.0` = c( "check_packages_in_dir_details", "CRAN_package_db", "debugcall", "hasName", "isS3stdgeneric", "strcapture", "Sys.setFileTime", "undebugcall" From 2e299803f5a3d54b5e0d7749ee41618d2a56d6a6 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 29 Nov 2020 13:58:23 -0500 Subject: [PATCH 5/7] rename to devel per good suggestion --- R/backport_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/backport_linter.R b/R/backport_linter.R index 700d5dc0e..a13ae7fda 100644 --- a/R/backport_linter.R +++ b/R/backport_linter.R @@ -45,7 +45,7 @@ backport_linter <- function(r_version = getRversion()) { } backports <- list( - `r` = c("...names", "checkRdContents", "numToBits", "numToInts", "packBits"), + `devel` = c("...names", "checkRdContents", "numToBits", "numToInts", "packBits"), `4.0.0` = c( ".class2", ".S3method", "activeBindingFunction", "deparse1", "globalCallingHandlers", "infoRDS", "list2DF", "marginSums", "proportions", "R_user_dir", "socketTimeout", "tryInvokeRestart" From 51173cc8ad9b2f5114295b8dd84ec4806b8240f3 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 29 Nov 2020 15:34:16 -0500 Subject: [PATCH 6/7] update tests --- tests/testthat/test-backport_linter.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-backport_linter.R b/tests/testthat/test-backport_linter.R index bc6a79d97..67eb424ce 100644 --- a/tests/testthat/test-backport_linter.R +++ b/tests/testthat/test-backport_linter.R @@ -7,13 +7,13 @@ test_that("backport_linter detects backwards-incompatibility", { expect_lint( "numToBits(2)", - rex("numToBits (R r-devel) is not available for dependency R >= 4.0.0."), + rex("numToBits (R devel) 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 r-devel) is not available for dependency R >= 4.0.0."), + rex("numToBits (R devel) is not available for dependency R >= 4.0.0."), backport_linter("4.0.0") ) @@ -21,7 +21,7 @@ test_that("backport_linter detects backwards-incompatibility", { "trimws(...names())", list( rex("trimws (R 3.2.0) is not available for dependency R >= 3.0.0."), - rex("...names (R r-devel) is not available for dependency R >= 3.0.0.") + rex("...names (R devel) is not available for dependency R >= 3.0.0.") ), backport_linter("3.0.0") ) From d6ca8d584a3c1139763caee97facd1b37a5f5d9f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 29 Nov 2020 15:43:14 -0500 Subject: [PATCH 7/7] add test of really old version; remove test of r-devel --- R/backport_linter.R | 6 +++++- tests/testthat/test-backport_linter.R | 10 +++++++--- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/R/backport_linter.R b/R/backport_linter.R index a13ae7fda..85cf2c828 100644 --- a/R/backport_linter.R +++ b/R/backport_linter.R @@ -3,7 +3,11 @@ backport_linter <- function(r_version = getRversion()) { function(source_file) { if (inherits(r_version, "numeric_version")) r_version <- format(r_version) - if (is.null(source_file$xml_parsed_content) || r_version >= "r") return(list()) + 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()) xml <- source_file$xml_parsed_content diff --git a/tests/testthat/test-backport_linter.R b/tests/testthat/test-backport_linter.R index 67eb424ce..02a3739ed 100644 --- a/tests/testthat/test-backport_linter.R +++ b/tests/testthat/test-backport_linter.R @@ -1,10 +1,14 @@ test_that("backport_linter detects backwards-incompatibility", { - # this test may be too fragile? - expect_lint("numToBits(1)", NULL, backport_linter("r-devel")) - # 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()) + # don't allow dependencies older than we've recorded + writeLines("x <- x + 1", tmp <- tempfile()) + on.exit(unlink(tmp)) + + expect_warning(l <- lint(tmp, backport_linter("2.0.0")), "version older than 3.0.0", fixed = TRUE) + expect_identical(l, lint(tmp, backport_linter("3.0.0"))) + expect_lint( "numToBits(2)", rex("numToBits (R devel) is not available for dependency R >= 4.0.0."),