make old R ver code testable

brodieG · Dec 19, 2021 · 7e13b66 · 7e13b66
1 parent 3521152
commit 7e13b66
Show file tree

Hide file tree

Showing 4 changed files with 54 additions and 34 deletions.
diff --git a/R/internal.R b/R/internal.R
@@ -13,9 +13,13 @@
 ##
 ## Go to <https://www.r-project.org/Licenses/GPL-2> for a copy of the license.
 
-## Tracks whether we are running in R > 3.2.2 or not (see .onLoad)
+## Internal environment (mostly just to store version)
 
-R.ver.gte.3.2.2 <- NA
+FANSI.ENV <- new.env()
+
+## Global variables
+
+utils::globalVariables(c())
 
 ## Internal functions, used primarily for testing
 
@@ -45,6 +49,13 @@ get_warn_utf8 <- function() .Call(FANSI_get_warn_utf8)
 get_warn_worst <- function() bitwOr(get_warn_mangled(), get_warn_utf8())
 get_warn_error <- function() .Call(FANSI_get_warn_error)
 
+## For testing version specific code
+set_rver <- function(x=getRversion()) {
+  old <- FANSI.ENV[['r.ver']]
+  FANSI.ENV[['r.ver']] <- x
+  invisible(old)
+}
+
 ## exposed internals for testing
 
 check_enc <- function(x, i) .Call(FANSI_check_enc, x, as.integer(i)[1])

diff --git a/R/load.R b/R/load.R
@@ -13,16 +13,14 @@
 ##
 ## Go to <https://www.r-project.org/Licenses/GPL-2> for a copy of the license.
 
-
 # nocov start
 .onLoad <- function(libname, pkgname) {
   # Scheme defaults are fairly complex...
-
   check_assumptions()
-  R.ver.gte.3.2.2 <<- getRversion() >= "3.2.2"
+  FANSI.ENV[['r.ver']] <- getRversion()
 }
 .onAttach <- function(libname, pkgname) {
-  if(!R.ver.gte.3.2.2) {
+  if(FANSI.ENV[['r.ver']] < "3.2.2") {
     packageStartupMessage(
       "`fansi` capabilities are degraded with R versions less than 3.2.2.  In ",
       "particular string width calculations will be incorrect for wide and/or ",

diff --git a/R/nchar.R b/R/nchar.R
@@ -68,46 +68,51 @@ nchar_ctl <- function(
     ctl <- strip
   }
   ## modifies / creates NEW VARS in fun env
-  VAL_IN_ENV(
-    x=x, ctl=ctl, warn=warn, type=type, allowNA=allowNA, keepNA=keepNA,
-    valid.types=c('chars', 'width', 'graphemes', 'bytes'),
-    warn.mask=if(isTRUE(allowNA)) get_warn_mangled() else get_warn_worst()
-  )
-  nchar_ctl_internal(
-    x=x, type.int=TYPE.INT, allowNA=allowNA, keepNA=keepNA, ctl.int=CTL.INT,
-    warn.int=WARN.INT, z=FALSE
-  )
+  if(FANSI.ENV[['r.ver']] >= "3.2.2") {
+    VAL_IN_ENV(
+      x=x, ctl=ctl, warn=warn, type=type, allowNA=allowNA, keepNA=keepNA,
+      valid.types=c('chars', 'width', 'graphemes', 'bytes'),
+      warn.mask=if(isTRUE(allowNA)) get_warn_mangled() else get_warn_worst()
+    )
+    nchar_ctl_internal(
+      x=x, type.int=TYPE.INT, allowNA=allowNA, keepNA=keepNA, ctl.int=CTL.INT,
+      warn.int=WARN.INT, z=FALSE
+    )
+  } else {
+    nchar(
+      strip_ctl(x, ctl=ctl, warn=warn),
+      type=type, allowNA=allowNA, keepNA=keepNA
+    )
+  }
 }
 #' @export
 #' @rdname nchar_ctl
 
 nzchar_ctl <- function(
   x, keepNA=FALSE, ctl='all', warn=getOption('fansi.warn', TRUE)
 ) {
-  ## modifies / creates NEW VARS in fun env
-  VAL_IN_ENV(
-    x=x, ctl=ctl, warn=warn, type='chars', keepNA=keepNA,
-    valid.types=c('chars', 'width', 'bytes'),
-    warn.mask=get_warn_mangled()
-  )
-  nchar_ctl_internal(
-    x=x, type.int=TYPE.INT, allowNA=TRUE, keepNA=keepNA, ctl.int=CTL.INT,
-    warn.int=WARN.INT, z=TRUE
-  )
+  if(FANSI.ENV[['r.ver']] >= "3.2.2") {
+    ## modifies / creates NEW VARS in fun env
+    VAL_IN_ENV(
+      x=x, ctl=ctl, warn=warn, type='chars', keepNA=keepNA,
+      valid.types=c('chars', 'width', 'bytes'),
+      warn.mask=get_warn_mangled()
+    )
+    nchar_ctl_internal(
+      x=x, type.int=TYPE.INT, allowNA=TRUE, keepNA=keepNA, ctl.int=CTL.INT,
+      warn.int=WARN.INT, z=TRUE
+    )
+  } else nzchar(strip_ctl(x, ctl=ctl, warn=warn), keepNA=keepNA)
 }
 nchar_ctl_internal <- function(
   x, type.int, allowNA, keepNA, ctl.int, warn.int, z
 ) {
   term.cap.int <- 1L
-  R.ver.gte.3.2.2 <- R.ver.gte.3.2.2 # "import" symbol from namespace
-  res <- if(R.ver.gte.3.2.2)
-    .Call(
-      FANSI_nchar_esc,
-      x, type.int, keepNA, allowNA,
-      warn.int, term.cap.int, ctl.int, z
-    )
-  else nchar(stripped, type=type, allowNA=allowNA) # nocov
-
+  res <- .Call(
+    FANSI_nchar_esc,
+    x, type.int, keepNA, allowNA,
+    warn.int, term.cap.int, ctl.int, z
+  )
   dim(res) <- dim(x)
   dimnames(res) <- dimnames(x)
   names(res) <- names(x)

diff --git a/tests/unitizer/nchar.R b/tests/unitizer/nchar.R
@@ -88,6 +88,12 @@ unitizer_sect('corner cases', {
   nchar_ctl("\033[31;\x80p")
   nchar_ctl("\033]8;\x80;a.b\033\\")
   nchar_ctl("\033];\x80;a.b\033\\")
+
+  ## Old R version behavior
+  fansi:::set_rver(numeric_version("3.2.1"))
+  nzchar_ctl(c("\033[31mA", "\033[31m"))
+  nchar_ctl(c("\033[31mA", "\033[31m"))
+  fansi:::set_rver()
 })
 unitizer_sect('bad inputs', {
   nchar_ctl(9:10, warn=1:3)