R Under development (unstable) (2025-04-15 r88147 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 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] "0x000002ac70c7cd80" > 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] "0x000002ac70d17d10" > 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] "0x000002ac6bf91d70" > 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") > oopts <- options(globals.debug = TRUE) > mdebug("Message B") Message B > options(oopts) > message("* mdebug() ... DONE") * mdebug() ... 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=207] '!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/2025_04_16_07_20_17_20184' Sourcing 5 epilogue scripts ... done Test time: user.self=0.1s, sys.self=0.01s, elapsed=0.1s, user.child=NAs, sys.child=NAs Test 'utils' ... success > > proc.time() user system elapsed 0.31 0.15 0.42