R Under development (unstable) (2026-03-12 r89611 ucrt) -- "Unsuffered Consequences" Copyright (C) 2026 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## This runs testme test script inst/testme/test-utils.R > ## Don't edit - it was autogenerated by inst/testme/deploy.R > globals:::testme("utils") Test 'utils' ... Sourcing 9 prologue scripts ... 01/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/_prologue/001.load.R' 02/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/_prologue/005.globals.R' 03/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/_prologue/010.record-state.R' 04/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/_prologue/030.imports.R' 05/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/_prologue/050.utils.R' 06/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/_prologue/090.context.R' 07/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/_prologue/090.options.R' 08/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/_prologue/091.envvars.R' 09/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/_prologue/995.detrius-connections.R' Sourcing 9 prologue scripts ... done Running test script: 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/test-utils.R' > library(globals) > message("*** utils ...") *** utils ... > message("- envname() ...") - envname() ... > name <- envname(NULL) > print(name) [1] NA > stopifnot(is.character(name), length(name) == 1, is.na(name)) > env <- new.env() > print(env) > name <- utils::capture.output(print(env)) > stopifnot(is.character(name), length(name) == 1) > name <- envname(env) > print(name) [1] "0x00000282bfe5df80" > stopifnot(is.character(name), length(name) == 1, !is.na(name), + class(env) == "environment") > env <- structure(new.env(), class = "foo") > print.foo <- function(x, ...) { + str(as.list(letters[1:3])) + invisible(x) + } > print(env) List of 3 $ : chr "a" $ : chr "b" $ : chr "c" > name <- utils::capture.output(print(env)) > stopifnot(is.character(name), length(name) > 1) > name <- envname(env) > print(name) [1] "0x00000282bfeba960" > stopifnot(is.character(name), length(name) == 1, !is.na(name), + class(env) == "foo") > env <- structure(new.env(), handlers = "foo") > print(env) attr(,"handlers") [1] "foo" > name <- utils::capture.output(print(env)) > stopifnot(is.character(name), length(name) > 1) > name <- envname(env) > print(name) [1] "0x00000282be460290" > stopifnot(is.character(name), length(name) == 1, !is.na(name)) > message("- envname() ... DONE") - envname() ... DONE > message("* hpaste() ...") * hpaste() ... > printf <- function(...) cat(sprintf(...)) > hpaste <- globals:::hpaste > x <- 1:6 > y <- 10:1 > z <- LETTERS[x] > printf("x = %s.\n", hpaste(x)) x = 1, 2, 3, ..., 6. > printf("x = %s.\n", hpaste(x, max_head = 2)) x = 1, 2, ..., 6. > printf("x = %s.\n", hpaste(x, max_head = 3)) x = 1, 2, 3, ..., 6. > printf("x = %s.\n", hpaste(x, max_head = 4)) x = 1, 2, 3, 4, 5, 6. > printf("x = %s.\n", hpaste(x, max_head = 1, max_tail = 2)) x = 1, ..., 5, 6. > printf("y = %s.\n", hpaste(y, max_head = Inf)) y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1. > printf("y = %s.\n", paste(y, collapse = ", ")) y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1. > printf("x = %s.\n", hpaste(x, last_collapse = " and ")) x = 1, 2, 3, 4, 5 and 6. > stopifnot(all(hpaste(x, collapse = NULL) == x)) > stopifnot(identical(hpaste(character(0)), character(0))) > message("* hpaste() ... DONE") * hpaste() ... DONE > message("* as_function() ...") * as_function() ... > fcn <- as_function({ + 1 + }) > print(fcn()) [1] 1 > stopifnot(fcn() == 1) > message("* is_base_pkg() ...") * is_base_pkg() ... > base_pkgs <- c("base") > for (pkg in base_pkgs) { + stopifnot(is_base_pkg(pkg)) + } > stopifnot(!is_base_pkg("globals")) > message("* isPackageNamespace() ... Bug #80") * isPackageNamespace() ... Bug #80 > `$.strict_env` <- function(x, name) get(name, envir = x, + inherits = FALSE) > env <- structure(new.env(), class = "strict_env") > res <- globals:::isPackageNamespace(env) > stopifnot(!res) > message("* is.base() & is_internal() ...") * is.base() & is_internal() ... > stopifnot(is.base(base::library)) > stopifnot(!is.base(globals::globalsOf)) > stopifnot(!is.base(NULL)) > stopifnot(is_internal(print.default)) > stopifnot(!is_internal(globals::globalsOf)) > stopifnot(!is_internal(NULL)) > message("* where() ...") * where() ... > env <- where("sample", where = 1) > str(env) > env <- where("sample", frame = 1) > str(env) > message("- where('sample') ...") - where('sample') ... > env <- where("sample", mode = "function") > print(env) > if (!"covr" %in% loadedNamespaces()) { + stopifnot(identical(env, baseenv())) + } > obj <- get("sample", mode = "function", envir = env, + inherits = FALSE) > stopifnot(identical(obj, base::sample)) > message("- where('sample', mode = 'integer') ...") - where('sample', mode = 'integer') ... > env <- where("sample", mode = "integer") > print(env) NULL > stopifnot(is.null(env)) > message("- where('sample2') ...") - where('sample2') ... > sample2 <- base::sample > env <- where("sample2", mode = "function") > print(env) > stopifnot(identical(env, environment())) > obj <- get("sample2", mode = "function", envir = env, + inherits = FALSE) > stopifnot(identical(obj, sample2)) > message("- where() - objects inside functions ...") - where() - objects inside functions ... > aa <- 1 > foo <- function() { + bb <- 2 + list(aa = where("aa"), bb = where("bb"), cc = where("cc"), + envir = environment()) + } > envs <- foo() > str(envs) List of 4 $ aa : $ bb : $ cc : NULL $ envir: > stopifnot(identical(envs$aa, globalenv())) > stopifnot(identical(envs$bb, envs$envir)) > stopifnot(is.null(envs$cc)) > message("- where() - missing ...") - where() - missing ... > env <- where("non-existing-object", inherits = FALSE) > stopifnot(is.null(env)) > rm(list = c("aa", "envs", "foo", "env", "obj", "where")) Warning in rm(list = c("aa", "envs", "foo", "env", "obj", "where")) : object 'where' not found > message("* where() ... DONE") * where() ... DONE > message("- mdebug() ...") - mdebug() ... > mdebug("Message A") NULL > oopts <- options(globals.debug = TRUE) > mdebug("Message B") [08:09:56.690] Message B > options(oopts) > message("- debug functions ...") - debug functions ... > mdebugf <- globals:::mdebugf > mdebug_push <- globals:::mdebug_push > mdebug_pop <- globals:::mdebug_pop > mdebugf_push <- globals:::mdebugf_push > mdebugf_pop <- globals:::mdebugf_pop > mprint <- globals:::mprint > mstr <- globals:::mstr > debug_indent <- globals:::debug_indent > oopts <- options(globals.debug = TRUE) > mdebug_push("test push") [08:09:56.693] test push > indent <- debug_indent() > stopifnot(nzchar(indent)) > mdebug_pop("test pop") [08:09:56.694] test push done > mdebugf_push("test push %d", 1) [08:09:56.694] test push 1 > mdebugf_pop("test pop %d", 1) [08:09:56.695] test push 1 done > mdebugf("hello %s", "world") [08:09:56.696] hello world > mprint(1:3) [08:09:56.696] [1] 1 2 3 > mstr(list(a = 1, b = "x")) [08:09:56.697] List of 2 [08:09:56.697] $ a: num 1 [08:09:56.697] $ b: chr "x" > options(oopts) > message("- debug functions ... DONE") - debug functions ... DONE > message("- where() - debug path ...") - where() - debug path ... > where <- globals:::where > oopts <- options(globals.future = TRUE) > test_env_dbg <- new.env(parent = emptyenv()) > test_env_dbg$my_var <- 1 > env <- where("my_var", envir = test_env_dbg, inherits = FALSE) > stopifnot(identical(env, test_env_dbg)) > env <- where("no_such_var", envir = test_env_dbg, + inherits = FALSE) > stopifnot(is.null(env)) > env <- where("no_such_var_at_all_xyz", envir = test_env_dbg, + inherits = TRUE) > stopifnot(is.null(env)) > options(oopts) > rm(list = c("where", "test_env_dbg")) > message("- where() - debug path ... DONE") - where() - debug path ... DONE > message("* mdebug() ... DONE") * mdebug() ... DONE > message("* is_native_symbol_info() ...") * is_native_symbol_info() ... > is_native_symbol_info <- globals:::is_native_symbol_info > stopifnot(!is_native_symbol_info(42)) > stopifnot(!is_native_symbol_info(NULL)) > mock_bad <- structure("not_a_list", class = "NativeSymbolInfo") > stopifnot(!is_native_symbol_info(mock_bad)) > mock_bad2 <- structure(list(address = "foo"), class = "NativeSymbolInfo") > stopifnot(!is_native_symbol_info(mock_bad2)) > mock_ok <- structure(list(name = "test", address = structure(TRUE, + class = "RegisteredNativeSymbol"), numParameters = 1), class = "NativeSymb ..." ... [TRUNCATED] > stopifnot(is_native_symbol_info(mock_ok)) > message("* is_native_symbol_info() ... DONE") * is_native_symbol_info() ... DONE > message("* isPackageNamespace() ...") * isPackageNamespace() ... > isPackageNamespace <- globals:::isPackageNamespace > stopifnot(!isPackageNamespace(NULL)) > stopifnot(!isPackageNamespace(42)) > stopifnot(isPackageNamespace(baseenv())) > stopifnot(isPackageNamespace(as.environment("package:base"))) > message("* isPackageNamespace() ... DONE") * isPackageNamespace() ... DONE > message("* stop_if_not() ...") * stop_if_not() ... > stop_if_not <- globals:::stop_if_not > stop_if_not() NULL > stop_if_not(TRUE) > stop_if_not(TRUE, TRUE) > res <- tryCatch(stop_if_not(FALSE), error = identity) > stopifnot(inherits(res, "simpleError")) > res <- tryCatch(stop_if_not(NA), error = identity) > stopifnot(inherits(res, "simpleError")) > res <- tryCatch(stop_if_not(c(TRUE, TRUE)), error = identity) > stopifnot(inherits(res, "simpleError")) > res <- tryCatch(stop_if_not(identical(1:100, 2:101)), + error = identity) > stopifnot(inherits(res, "simpleError")) > message("- stop_if_not() - long deparsed expression ...") - stop_if_not() - long deparsed expression ... > res <- tryCatch(stop_if_not(identical(list(alpha = 1, + beta = 2, gamma = 3, delta = 4, epsilon = 5, zeta = 6), list(alpha = 1, + beta = 2 .... [TRUNCATED] > stopifnot(inherits(res, "simpleError")) > stopifnot(grepl("[.][.][.]", conditionMessage(res))) > message("* stop_if_not() ... DONE") * stop_if_not() ... DONE > message("* .length() ...") * .length() ... > .length <- globals:::.length > stopifnot(.length(1:5) == 5) > stopifnot(.length(list(a = 1, b = 2)) == 2) > obj <- structure(1:3, class = "myclass") > stopifnot(.length(obj) == 3) > message("* .length() ... DONE") * .length() ... DONE > message("* list_apply() ...") * list_apply() ... > list_apply <- globals:::list_apply > res <- list_apply(list(1, 2, 3), FUN = function(x) x * + 2) > stopifnot(identical(res, list(2, 4, 6))) > res <- list_apply(list(10, 20, 30), subset = c(1, + 3), FUN = function(x) x + 1) > stopifnot(res[[1]] == 11, res[[3]] == 31) > env <- new.env(parent = emptyenv()) > env$a <- 1 > env$b <- 2 > res <- list_apply(env, FUN = function(x) x * 10) > stopifnot(res[["a"]] == 10, res[["b"]] == 20) > message("* list_apply() ... DONE") * list_apply() ... DONE > message("* stopf() ...") * stopf() ... > stopf <- globals:::stopf > res <- tryCatch(stopf("error %d", 42), error = identity) > stopifnot(inherits(res, "simpleError")) > stopifnot(grepl("error 42", conditionMessage(res))) > message("- stopf() with call. = FALSE ...") - stopf() with call. = FALSE ... > res <- tryCatch(stopf("error %d", 42, call. = FALSE), + error = identity) > stopifnot(inherits(res, "simpleError")) > stopifnot(is.null(res$call)) > message("- stopf() with call. = ...") - stopf() with call. = ... > res <- tryCatch(stopf("error %d", 42, call. = quote(my_function(x))), + error = identity) > stopifnot(inherits(res, "simpleError")) > stopifnot(identical(res$call, quote(my_function(x)))) > message("* stopf() ... DONE") * stopf() ... DONE > message("* is_base_pkg() edge cases ...") * is_base_pkg() edge cases ... > stopifnot(!is_base_pkg("")) > stopifnot(is_base_pkg("utils")) > stopifnot(is_base_pkg("package:base")) > message("* is_base_pkg() ... DONE") * is_base_pkg() ... DONE > message("* setOption() ...") * setOption() ... > setOption <- globals:::setOption > old <- setOption("globals.test.dummy", 42) > stopifnot(is.null(old)) > stopifnot(identical(getOption("globals.test.dummy"), + 42)) > old <- setOption("globals.test.dummy", NULL) > stopifnot(identical(old, 42)) > message("* setOption() ... DONE") * setOption() ... DONE > message("* update_package_option() ...") * update_package_option() ... > update_package_option <- globals:::update_package_option > options(globals.test.opt1 = "existing") > res <- update_package_option("globals.test.opt1", + force = FALSE) > stopifnot(identical(res, "existing")) > options(globals.test.opt2 = NULL) > Sys.unsetenv("R_GLOBALS_TEST_OPT2") > res <- update_package_option("globals.test.opt2", + default = "mydefault") > stopifnot(identical(res, "mydefault")) > options(globals.test.opt3 = NULL) > Sys.setenv(R_GLOBALS_TEST_OPT3 = "") > res <- update_package_option("globals.test.opt3", + default = "fallback") > stopifnot(identical(res, "fallback")) > Sys.unsetenv("R_GLOBALS_TEST_OPT3") > options(globals.test.opt4 = NULL) > Sys.setenv(R_GLOBALS_TEST_OPT4 = "a, b, c") > res <- update_package_option("globals.test.opt4", + split = ",") > stopifnot(identical(res, c("a", "b", "c"))) > Sys.unsetenv("R_GLOBALS_TEST_OPT4") > options(globals.test.opt5 = NULL) > Sys.setenv(R_GLOBALS_TEST_OPT5 = "TRUE") > res <- update_package_option("globals.test.opt5", + mode = "logical") > stopifnot(identical(res, TRUE)) > Sys.unsetenv("R_GLOBALS_TEST_OPT5") > options(globals.test.opt6 = NULL) > Sys.setenv(R_GLOBALS_TEST_OPT6 = "not_a_number") > res <- tryCatch(update_package_option("globals.test.opt6", + mode = "integer", disallow = "NA"), error = identity) > stopifnot(inherits(res, "simpleError")) > Sys.unsetenv("R_GLOBALS_TEST_OPT6") > options(globals.test.opt7 = NULL) > Sys.setenv(R_GLOBALS_TEST_OPT7 = "-1") > res <- tryCatch(update_package_option("globals.test.opt7", + mode = "integer", disallow = c("NA", "non-positive")), error = identity) > stopifnot(inherits(res, "simpleError")) > Sys.unsetenv("R_GLOBALS_TEST_OPT7") > options(globals.test.opt8 = NULL) > Sys.setenv(R_GLOBALS_TEST_OPT8 = "-5") > res <- tryCatch(update_package_option("globals.test.opt8", + mode = "integer", disallow = c("NA", "negative")), error = identity) > stopifnot(inherits(res, "simpleError")) > Sys.unsetenv("R_GLOBALS_TEST_OPT8") > options(globals.test.opt9 = NULL) > oopts <- options(globals.debug = TRUE) > Sys.setenv(R_GLOBALS_TEST_OPT9 = "hello") > res <- update_package_option("globals.test.opt9", + debug = TRUE) [08:09:56.720] update_package_option() ... [08:09:56.721] | R_GLOBALS_TEST_OPT9='hello' [08:09:56.721] | => options("globals.test.opt9" = 'hello') [n=1, mode=character] [08:09:56.722] update_package_option() ... done > stopifnot(identical(res, "hello")) > Sys.unsetenv("R_GLOBALS_TEST_OPT9") > options(oopts) > options(globals.test.opt10 = NULL) > oopts <- options(globals.debug = TRUE) > Sys.unsetenv("R_GLOBALS_TEST_OPT10") > res <- update_package_option("globals.test.opt10", + debug = TRUE, default = "def") [08:09:56.723] update_package_option() ... [08:09:56.723] | Environment variable 'R_GLOBALS_TEST_OPT10' not set [08:09:56.724] update_package_option() ... done > stopifnot(identical(res, "def")) > options(oopts) > options(globals.test.opt11 = NULL) > oopts <- options(globals.debug = TRUE) > Sys.setenv(R_GLOBALS_TEST_OPT11 = "42") > res <- update_package_option("globals.test.opt11", + mode = "integer", debug = TRUE) [08:09:56.725] update_package_option() ... [08:09:56.725] | R_GLOBALS_TEST_OPT11='42' [08:09:56.726] | Coercing from character to integer: '42' [08:09:56.727] | => options("globals.test.opt11" = '42') [n=1, mode=integer] [08:09:56.727] update_package_option() ... done > stopifnot(identical(res, 42)) > Sys.unsetenv("R_GLOBALS_TEST_OPT11") > options(oopts) > options(globals.test.opt1 = NULL, globals.test.opt2 = NULL, + globals.test.opt3 = NULL, globals.test.opt4 = NULL, globals.test.opt5 = NULL, + .... [TRUNCATED] > message("* update_package_option() ... DONE") * update_package_option() ... DONE > message("*** utils ... DONE") *** utils ... DONE Sourcing 5 epilogue scripts ... 01/05 epilogue script 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/_epilogue/002.undo-state.R' Failed to undo environment variables: - Expected environment variables: [n=212] '!ExitCode', 'ALLUSERSPROFILE', 'APPDATA', ..., 'tempdirname' - Environment variables still there: [n=0] - Environment variables missing: [n=1] 'MAKEFLAGS' Differences environment variable by environment variable: 02/05 epilogue script 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/_epilogue/090.gc.R' 03/05 epilogue script 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/_epilogue/099.session_info.R' 04/05 epilogue script 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/_epilogue/995.detritus-connections.R' 05/05 epilogue script 'D:/RCompile/CRANincoming/R-devel/lib/globals/testme/_epilogue/999.detritus-files.R' Skipping, because path appears not to be an 'R CMD check' folder: 'D:/temp/2026_03_13_07_10_17_31522' Sourcing 5 epilogue scripts ... done Test time: user.self=0.09s, sys.self=0.01s, elapsed=0.1s, user.child=NAs, sys.child=NAs Test 'utils' ... success > > proc.time() user system elapsed 0.23 0.07 0.28