Be nice about length zero and missing character inputs.

git-svn-id: https://svn.r-project.org/R/trunk@84718 00db46b3-68df-0310-9c12-caf00c1e9a41
r-devel · Jul 21, 2023 · 50bffbb · 50bffbb
1 parent 20a80b8
commit 50bffbb
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 53 deletions.
diff --git a/src/library/base/R/version.R b/src/library/base/R/version.R
@@ -42,30 +42,33 @@ function(x, strict = TRUE, regexp, classes = NULL)
  ## Internal creator for numeric version objects.
 
  nms <- names(x)
- if(!is.character(x)) {
- msg <- gettextf("invalid non-character version specification 'x' (type: %s)",
- typeof(x))
- warning(msg, domain = NA, immediate. = TRUE) 
- if(nzchar(Sys.getenv("_R_CALLS_INVALID_NUMERIC_VERSION_"))) {
- ## Showing the call stack as part of warning() may truncate,
- ## so do it via message() ...
- calls <- sys.calls()
- msg <- paste0(gettext("Calls"), ":\n",
- paste0(sprintf("%2i: ", seq_along(calls)),
- vapply(calls, deparse1, "",
- collapse = "\n "),
- collapse = "\n"))
- message(msg, domain = NA)
+
+ if(!length(x)) {
+ y <- list()
+ } else {
+ if(!is.character(x)) {
+ msg <- gettextf("invalid non-character version specification 'x' (type: %s)",
+ typeof(x))
+ warning(msg, domain = NA, immediate. = TRUE) 
+ if(nzchar(Sys.getenv("_R_CALLS_INVALID_NUMERIC_VERSION_"))) {
+ ## Showing the call stack as part of warning() may
+ ## truncate, so do it via message() ...
+ calls <- sys.calls()
+ msg <- paste0(gettext("Calls"), ":\n",
+ paste0(sprintf("%2i: ", seq_along(calls)),
+ vapply(calls, deparse1, "",
+ collapse = "\n "),
+ collapse = "\n"))
+ message(msg, domain = NA)
+ }
  }
- }
- x <- as.character(x)
- y <- rep.int(list(integer()), length(x))
- valid_numeric_version_regexp <- sprintf("^%s$", regexp)
- if(length(x)) {
+ x <- as.character(x)
+ y <- rep.int(list(integer()), length(x))
+ valid_numeric_version_regexp <- sprintf("^%s$", regexp)
  ok <- grepl(valid_numeric_version_regexp, x)
- if(!all(ok) && strict)
+ if(strict && !all(i <- (ok | is.na(x))))
  stop(gettextf("invalid version specification %s",
- paste(sQuote(unique(x[!ok])), collapse = ", ")),
+ paste(sQuote(unique(x[!i])), collapse = ", ")),
  call. = FALSE, domain = NA)
  y[ok] <- lapply(strsplit(x[ok], "[.-]"), as.integer)
  }

diff --git a/tests/isas-tests.Rout.save b/tests/isas-tests.Rout.save
@@ -1,5 +1,5 @@
 
-R Under development (unstable) (2023-06-27 r84609) -- "Unsuffered Consequences"
+R Under development (unstable) (2023-07-20 r84714) -- "Unsuffered Consequences"
 Copyright (C) 2023 The R Foundation for Statistical Computing
 Platform: x86_64-pc-linux-gnu
 
@@ -74,16 +74,12 @@ Type 'q()' to quit R.
 > if(!inherits(res, 'try-error')) report(is.numeric(res))
 [1] TRUE
 > res <- try(as.numeric_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_numeric_version) :
- invalid non-character version specification 'x' (type: integer)
 > if(!inherits(res, 'try-error')) report(is.numeric_version(res))
 [1] TRUE
 > res <- try(as.ordered( x ), silent = TRUE)
 > if(!inherits(res, 'try-error')) report(is.ordered(res))
 [1] TRUE
 > res <- try(as.package_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_package_version, :
- invalid non-character version specification 'x' (type: integer)
 > if(!inherits(res, 'try-error')) report(is.package_version(res))
 [1] TRUE
 > res <- try(as.pairlist( x ), silent = TRUE)
@@ -189,8 +185,6 @@ IS: [1] TRUE
 + } else !isall.equal(x, res)})
 IS: [1] TRUE
 > res <- try(as.numeric_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_numeric_version) :
- invalid non-character version specification 'x' (type: integer)
 > if(!inherits(res, 'try-error'))
 + report({if(is.numeric_version(x)) { cat('IS: ');all.equal(x, res, tolerance=0)
 + } else !isall.equal(x, res)})
@@ -201,8 +195,6 @@ Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_numeric_ve
 + } else !isall.equal(x, res)})
 [1] TRUE
 > res <- try(as.package_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_package_version, :
- invalid non-character version specification 'x' (type: integer)
 > if(!inherits(res, 'try-error'))
 + report({if(is.package_version(x)) { cat('IS: ');all.equal(x, res, tolerance=0)
 + } else !isall.equal(x, res)})
@@ -305,8 +297,6 @@ IS: [1] TRUE
 > if(!inherits(f, 'try-error')) report(identical(f, as.numeric( f )))
 [1] TRUE
 > f <- try(as.numeric_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_numeric_version) :
- invalid non-character version specification 'x' (type: integer)
 > if(!inherits(f, 'try-error')) report(identical(f, as.numeric_version( f )))
 [1] TRUE
 > f <- try(as.octmode( x ), silent = TRUE)
@@ -316,8 +306,6 @@ Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_numeric_ve
 > if(!inherits(f, 'try-error')) report(identical(f, as.ordered( f )))
 [1] TRUE
 > f <- try(as.package_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_package_version, :
- invalid non-character version specification 'x' (type: integer)
 > if(!inherits(f, 'try-error')) report(identical(f, as.package_version( f )))
 [1] TRUE
 > f <- try(as.pairlist( x ), silent = TRUE)
@@ -403,16 +391,12 @@ In as.dist.default(x) : non-square matrix
 > if(!inherits(res, 'try-error')) report(is.numeric(res))
 [1] TRUE
 > res <- try(as.numeric_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_numeric_version) :
- invalid non-character version specification 'x' (type: NULL)
 > if(!inherits(res, 'try-error')) report(is.numeric_version(res))
 [1] TRUE
 > res <- try(as.ordered( x ), silent = TRUE)
 > if(!inherits(res, 'try-error')) report(is.ordered(res))
 [1] TRUE
 > res <- try(as.package_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_package_version, :
- invalid non-character version specification 'x' (type: NULL)
 > if(!inherits(res, 'try-error')) report(is.package_version(res))
 [1] TRUE
 > res <- try(as.pairlist( x ), silent = TRUE)
@@ -517,8 +501,6 @@ IS: [1] TRUE
 + } else !isall.equal(x, res)})
 [1] TRUE
 > res <- try(as.numeric_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_numeric_version) :
- invalid non-character version specification 'x' (type: NULL)
 > if(!inherits(res, 'try-error'))
 + report({if(is.numeric_version(x)) { cat('IS: ');all.equal(x, res, tolerance=0)
 + } else !isall.equal(x, res)})
@@ -529,8 +511,6 @@ Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_numeric_ve
 + } else !isall.equal(x, res)})
 [1] TRUE
 > res <- try(as.package_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_package_version, :
- invalid non-character version specification 'x' (type: NULL)
 > if(!inherits(res, 'try-error'))
 + report({if(is.package_version(x)) { cat('IS: ');all.equal(x, res, tolerance=0)
 + } else !isall.equal(x, res)})
@@ -631,8 +611,6 @@ Calls: report -> stopifnot
 > if(!inherits(f, 'try-error')) report(identical(f, as.numeric( f )))
 [1] TRUE
 > f <- try(as.numeric_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_numeric_version) :
- invalid non-character version specification 'x' (type: NULL)
 > if(!inherits(f, 'try-error')) report(identical(f, as.numeric_version( f )))
 [1] TRUE
 > f <- try(as.octmode( x ), silent = TRUE)
@@ -641,8 +619,6 @@ Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_numeric_ve
 > if(!inherits(f, 'try-error')) report(identical(f, as.ordered( f )))
 [1] TRUE
 > f <- try(as.package_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_package_version, :
- invalid non-character version specification 'x' (type: NULL)
 > if(!inherits(f, 'try-error')) report(identical(f, as.package_version( f )))
 [1] TRUE
 > f <- try(as.pairlist( x ), silent = TRUE)
@@ -734,8 +710,6 @@ Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_package_ve
 > if(!inherits(res, 'try-error')) report(is.ordered(res))
 [1] TRUE
 > res <- try(as.package_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_package_version, :
- invalid non-character version specification 'x' (type: list)
 > if(!inherits(res, 'try-error')) report(is.package_version(res))
 [1] TRUE
 > res <- try(as.pairlist( x ), silent = TRUE)
@@ -851,8 +825,6 @@ IS: [1] TRUE
 + } else !isall.equal(x, res)})
 [1] TRUE
 > res <- try(as.package_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_package_version, :
- invalid non-character version specification 'x' (type: list)
 > if(!inherits(res, 'try-error'))
 + report({if(is.package_version(x)) { cat('IS: ');all.equal(x, res, tolerance=0)
 + } else !isall.equal(x, res)})
@@ -959,8 +931,6 @@ IS: [1] TRUE
 > if(!inherits(f, 'try-error')) report(identical(f, as.ordered( f )))
 [1] TRUE
 > f <- try(as.package_version( x ), silent = TRUE)
-Warning in .make_numeric_version(x, strict, .standard_regexps()$valid_package_version, :
- invalid non-character version specification 'x' (type: list)
 > if(!inherits(f, 'try-error')) report(identical(f, as.package_version( f )))
 [1] TRUE
 > f <- try(as.pairlist( x ), silent = TRUE)
@@ -2671,6 +2641,6 @@ In as.dist.default(x) : non-square matrix
 > f <- try(as.ts( x ), silent = TRUE)
 > if(!inherits(f, 'try-error')) report(identical(f, as.ts( f )))
 > cat('Time elapsed: ', proc.time() - .proctime00,'\n')
-Time elapsed: 0.122 0.012 0.133 0 0 
+Time elapsed: 0.102 0.017 0.118 0 0 
 > 
 >