R Under development (unstable) (2024-05-17 r86565 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 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.

> source(file.path("_helper", "init.R"))
> source(file.path("aammrtf", "mock.R"))
> 
> toy.path <- file.path("_helper", "unitizers", "misc.unitizer")
> toy.stor <- readRDS(file.path(toy.path, "data.rds"))
> 
> # - "Error Cases" --------------------------------------------------------------
> 
> try(get_unitizer(1))
Error in get_unitizer.default(1) : 
  No method defined for object of class "numeric"; make sure that the specified `store.id` is a reference to a valid unitizer store and had defined `get_unitizer` and `set_unitizer` methods.
> try(get_unitizer(letters))
Error in get_unitizer.character(letters) : 
  Argument `store.id` must be a 1 length character vector
> try(get_unitizer("_helper"))
Error in get_unitizer.character("_helper") : 
  Argument `store.id` does not appear to refer to a unitizer directory
> try(get_unitizer("t-get.R"))
Error in get_unitizer.character("t-get.R") : 
  Argument `store.id` does not appear to refer to a unitizer directory
> try(set_unitizer(1))
Error in set_unitizer.default(1) : 
  No method defined for object of class "numeric"; make sure that the specified `store.id` is a reference to a valid unitizer store and had defined `get_unitizer` and `set_unitizer` methods.
> try(set_unitizer(letters))
Error in set_unitizer.character(letters) : 
  Argument `store.id` must be a 1 length character vector
> # 4.3 changed reporting of missing argument errors
> tryCatch(set_unitizer("a"), error=function(e) conditionMessage(e))
[1] "argument \"unitizer\" is missing, with no default"
> try(set_unitizer("a", "blergh"))
Error in set_unitizer.character("a", "blergh") : 
  Argument `unitizer` must be a unitizer
> !file.exists("a") # TRUE
[1] TRUE
> try(suppressWarnings(set_unitizer("tests/# ;!./# \\/", toy.stor)))
Error in set_unitizer.character("tests/# ;!./# \\/", toy.stor) : 
  Could not create `store.id`; make sure it is a valid file name; see warning for details
> 
> # - "Get works as expected" ----------------------------------------------------
> 
> tmp.dir <- tempfile()
> dir.create(tmp.dir)
> tmp.sub.dir <- paste0(tmp.dir, "/get.test.dir")
> tmp.fake.utz <- paste0(tmp.dir, "/fake.unitizer")
> 
> # expect_false(get_unitizer("asldkfjskfa"))
> get_unitizer("asldkfjskfa") # FALSE
[1] FALSE
> all.equal(get_unitizer(toy.path), toy.stor)
[1] TRUE
> is(toy.stor, "unitizer")
[1] TRUE
> dir.create(tmp.fake.utz)
> fake.utz <- file.path(tmp.fake.utz, "data.rds")
> cat("# this is not an RDS\n", file = fake.utz)
> # expect_error(capture.output(get_unitizer(tmp.fake.utz), type = "message"),
> #     "Failed loading unitizer")
> try(capture.output(get_unitizer(tmp.fake.utz), type = "message"))
Error in get_unitizer.character(tmp.fake.utz) : 
  Failed loading unitizer; see prior error messages for details
> 
> tmp.sub.dir <- paste0(tmp.dir, "/get.test.dir")
> tmp.sub.dir2 <- paste0(tmp.dir, "/get.test.dir2")
> tmp.sub.dir3 <- paste0(tmp.dir, "/load.dirs")
> 
> # - "Set works as expected" ----------------------------------------------------
> 
> dir.create(tmp.sub.dir)
> set_unitizer(tmp.sub.dir, toy.stor)
[1] TRUE
> all.equal(readRDS(paste0(tmp.sub.dir, "/data.rds")), toy.stor)
[1] TRUE
> just.a.file <- tempfile()
> on.exit(unlink(just.a.file))
> cat("just a file\n", file = just.a.file)
> err <- capture.output(try(set_unitizer(just.a.file, toy.stor)), type='message')
> any(grepl('not a directory', err))
[1] TRUE
> 
> # - "load/store_unitizer" ------------------------------------------------------
> 
> # Several different stores in different states (i.e. requiring upgrade,
> # not unitizers, etc.)
> dir.create(tmp.sub.dir3)
> make.path <- lapply(file.path(tmp.sub.dir3, dir("_helper/ref-objs/load/")),
+     dir.create)
> if (!all(unlist(make.path))) stop("Failed making paths")
> file.copy(list.files("_helper/ref-objs/load", full.names = TRUE), tmp.sub.dir3,
+     recursive = TRUE)
[1] TRUE TRUE TRUE TRUE TRUE TRUE
> par.frame <- new.env()
> store.ids <- as.list(list.files(tmp.sub.dir3, full.names = TRUE))
> 
> # must be upgraded, but cannot
> load.try <- unitizer:::capture_output(
+   try(
+     unitizer:::load_unitizers(store.ids, rep(NA_character_,
+       length(store.ids)), par.frame = par.frame, interactive.mode = FALSE,
+       mode = "unitize", force.upgrade = FALSE, show.progress=0L, transcript=FALSE
+ ) ) )
> any(grepl('could not be loaded', load.try$message))
[1] TRUE
> any(grepl('could not be upgraded', load.try$message))
[1] TRUE
> any(grepl('Cannot proceed', load.try$message))
[1] TRUE
> 
> # handle failure in store_unitizer, we just try this on one of the store ids
> 
> out <- unitizer:::capture_output(
+   unitizer:::load_unitizers(
+     store.ids[4], rep(NA_character_, length(store.ids))[4],
+     par.frame = par.frame, interactive.mode = FALSE, mode = "unitize",
+     force.upgrade = TRUE, show.progress=0L, transcript=FALSE
+   )
+ )
> any(grepl('Upgraded test file does not match original', out$message))
[1] TRUE
> 
> # try weird store ids
> out <- unitizer:::capture_output(
+   invalid.store <- try(
+     unitizer:::load_unitizers(
+       list(structure("hello", class = "unitizer_error_store")),
+       NA_character_, par.frame = par.frame,
+       interactive.mode = FALSE, mode = "unitize", force.upgrade = FALSE,
+       show.progress=0L, transcript=FALSE
+   ) )
+ )
> inherits(invalid.store, "try-error")
[1] TRUE
> any(grepl("returned something other than", out$message))
[1] TRUE
> 
> # Load mix of loadable and not loadable objects
> glob <- suppressWarnings(unitizer:::unitizerGlobal$new())
> # with warning: "does not exist|test file does not")
> out <- unitizer:::capture_output(
+   untzs <- try(
+     unitizer:::load_unitizers(
+       store.ids, rep(NA_character_, length(store.ids)), par.frame = par.frame,
+       interactive.mode = FALSE, mode = "unitize", force.upgrade = TRUE,
+       global = glob, show.progress=0L, transcript=FALSE
+ ) ) )
> inherits(untzs, "try-error")
[1] TRUE
> any(grepl('could not be loaded', out$message))
[1] TRUE
> any(grepl('could not be upgraded', out$message))
[1] TRUE
> any(grepl('Cannot proceed', out$message))
[1] TRUE
> 
> # Test failure of storage of a loaded and upgraded unitizers
> 
> untzs <- unitizer:::load_unitizers(
+   store.ids[4], NA_character_, par.frame = par.frame,
+   interactive.mode = FALSE, mode = "unitize", force.upgrade = TRUE,
+   global = glob, show.progress=0L, transcript=FALSE
+ )
Warning in addSlot(object, "cons", NULL) :
  Slot `cons` does not exist in current version of `unitizer` so not added to object.
Warning in addSlot(object, "jump.to.test", 0L) :
  Slot `jump.to.test` does not exist in current version of `unitizer` so not added to object.
Warning in unitizer:::load_unitizers(store.ids[4], NA_character_, par.frame = par.frame,  :
  Upgraded test file does not match original test file ('internals.R' vs 'NA').
> mock(unitizer:::set_unitizer, quote(stop("set fail")))
> try(unitizer:::store_unitizer(untzs[[1]]))
Error in set_unitizer(unitizer@id, unitizer) : set fail
Error in unitizer:::store_unitizer(untzs[[1]]) : 
  Error attempting to save unitizer, see previous messages.
> unmock(unitizer:::set_unitizer)
> 
> # Try reloading already loaded unitisers
> reload <- unitizer:::as.list(untzs)
> # this creates a global object, hence warning
> untzs1a <- unitizer:::load_unitizers(
+   reload, rep(NA_character_, length(reload)), par.frame = par.frame,
+   interactive.mode = FALSE, mode = "unitize", force.upgrade = FALSE,
+   show.progress=0L, transcript=FALSE
+ )
Warning in .Object$initialize(...) :
  Instantiated global object without global namespace registry; you should only see this warning you are using `repair_environments`.
> all(vapply(unitizer:::as.list(untzs1a), is, logical(1L), "unitizer"))
[1] TRUE
> 
> # misc tests
> # warning Instantiated global object without
> 
> untzs2 <- unitizer:::load_unitizers(
+   list(tmp.sub.dir2), NA_character_, par.frame, interactive.mode = FALSE,
+   mode = "unitize", force.upgrade = FALSE, show.progress=0L, transcript=FALSE
+ )
Warning in .Object$initialize(...) :
  Instantiated global object without global namespace registry; you should only see this warning you are using `repair_environments`.
> is(untzs2[[1L]], "unitizer")
[1] TRUE
> identical(parent.env(untzs2[[1L]]@zero.env), par.frame)
[1] TRUE
> 
> # something that won't get reset on load so we can check our re-load
> untzs2[[1L]]@eval.time <- 33
> unitizer:::store_unitizer(untzs2[[1L]])
| unitizer updated.

> 
> # warning Instantiated global object without
> untzs2.1 <- unitizer:::load_unitizers(
+   list(tmp.sub.dir2), NA_character_, par.frame, interactive.mode = FALSE,
+   mode = "unitize", force.upgrade = FALSE, show.progress=0L, transcript=FALSE
+ )
Warning in .Object$initialize(...) :
  Instantiated global object without global namespace registry; you should only see this warning you are using `repair_environments`.
> untzs2.1[[1L]]@eval.time # 33
[1] 33
> unlink(c(tmp.sub.dir2, tmp.sub.dir3, tmp.sub.dir), recursive = TRUE)
> 
> # - "is_package" ---------------------------------------------------------------
> 
> unitizer:::is_package_dir(system.file(package = "stats"))
[1] TRUE
> unitizer:::is_package_dir(system.file(package = "methods"))
[1] TRUE
> 
> ## Seems like some change now tests no longer installed by default with
> ## packages, at least in the unix distros, so can't easily test with
> ## has.tests==TRUE
> 
> unitizer:::pretty_path(file.path(system.file(package = "stats"),
+     "DESCRIPTION"))
[1] "package:stats/DESCRIPTION"
> old.wd <- getwd()
> setwd(system.file(package = "stats"))
> unitizer:::pretty_path(file.path(system.file(package = "stats"), "DESCRIPTION"))
[1] "DESCRIPTION"
> unitizer:::pretty_path(file.path(system.file(package = "stats")))
[1] "."
> setwd(old.wd)
> 
> # just picked some folder we know will not work (No Desc)
> unitizer:::is_package_dir(file.path(system.file(package = "stats"), "R"))
[1] "No DESCRIPTION file"
> unitizer:::is_package_dir("ASDFASDF")
[1] "not an existing directory"
> unitizer:::is_package_dir(file.path(system.file(package = "unitizer"),
+     "expkg", "baddescription1"))
[1] "DESCRIPTION file did not have a package name entry"
> # *get_*package_dir
> pkg.f <- file.path(system.file(package = "unitizer"), "tests",
+     "interactive", "run.R")
> length(unitizer:::get_package_dir(pkg.f)) == 1L
[1] TRUE
> length(unitizer:::get_package_dir(dirname(pkg.f))) == 1L
[1] TRUE
> f <- tempfile()
> cat("helloworld", file = f)
> length(unitizer:::get_package_dir(f)) == 0L
[1] TRUE
> unlink(f)
> 
> # some more tests moved to t-demo.R to avoid reloading pkgs
> 
> # - "is_unitizer_dir" ----------------------------------------------------------
> 
> base.dir <- file.path(system.file(package = "unitizer"), "expkg", "infer")
> unitizer:::is_unitizer_dir(base.dir) # FALSE
[1] FALSE
> unitizer:::is_unitizer_dir(
+   file.path(base.dir, "tests", "unitizer", "infer.unitizer")
+ )
[1] TRUE
> # - "infer_unitizer_location" --------------------------------------------------
> 
> infer <- function(...) infer_unitizer_location(..., interactive.mode = FALSE)
> base.dir <- file.path(system.file(package = "unitizer"), "expkg", "infer")
> 
> # Verify package is still in state we built tests on; need to sort b/c
> # different platforms have different lexical sorts
> identical(
+   sort(c("aaa.R", "aaa.unitizer", "abc.R", "abc.unitizer", "inf.R",
+       "inf.unitizer", "infer.R", "infer.unitizer", "zzz.R", "zzz.unitizer")),
+   list.files(file.path(base.dir, "tests", "unitizer"))
+ )
[1] TRUE
> # Package dir
> unitizer:::capture_output(inf <- infer(base.dir))
> basename(inf)
[1] "infer.R"
> unitizer:::capture_output(inf <- infer(base.dir, type = "d"))
> basename(inf)
[1] "unitizer"
> unitizer:::capture_output(inf <- infer(base.dir, type = "u"))
> basename(inf)
[1] "infer.unitizer"
> 
> inf.dir <- infer(file.path(base.dir, "*")) # warn
Warning in infer_unitizer_location.character(..., interactive.mode = FALSE) :
  5 possible targets; too many to unambiguously infer desired file
> identical(file.path(base.dir, "*"), inf.dir)
[1] TRUE
> 
> unitizer:::capture_output(inf <- infer(file.path(base.dir, "z")))
> basename(inf)
[1] "zzz.R"
> unitizer:::capture_output(inf <- infer(file.path(base.dir, "z"), type = "u"))
> basename(inf)
[1] "zzz.unitizer"
> 
> # Normal dir
> base.dir2 <- file.path(base.dir, "tests", "unitizer")
> # note don't need * to generate warning
> out <- unitizer:::capture_output(inf.dir2 <- infer(base.dir2))  # warn
> any(grepl("5 possible targets", out$message))
[1] TRUE
> identical(base.dir2, inf.dir2)
[1] TRUE
> out <- unitizer:::capture_output(infer(file.path(base.dir2, "a")))
> any(grepl("2 possible targets", out$message))
[1] TRUE
> out <- unitizer:::capture_output(infer(file.path(base.dir2, "a"), type = "u"))
> any(grepl("2 possible targets", out$message))
[1] TRUE
> out <-
+   unitizer:::capture_output(fname <- basename(infer(file.path(base.dir2, "z"))))
> fname
[1] "zzz.R"
> any(grepl('Inferred test file location:', out))
[1] TRUE
> out <- unitizer:::capture_output(
+   fname <- basename(infer(file.path(base.dir2, "z"), type="u"))
+ )
> fname
[1] "zzz.unitizer"
> any(grepl('Inferred unitizer location:', out))
[1] TRUE
> 
> # Random file without setting working dir first, in order for this to work
> # non-interactivel we need it to work with the R CMD check dir structure,
> # and possibly with the covr dir structure
> if (interactive())  infer("tests2")
> 
> # Interactive mode
> unitizer:::read_line_set_vals(c("26", "Q"))
> # warn/output
> select <- unitizer:::infer_unitizer_location(
+   file.path(base.dir, "*"), type = "f", interactive.mode = TRUE
+ )
Possible matching files from "tests/unitizer":
  1: aaa.R
  2: abc.R
  3: inf.R
  4: infer.R
  5: zzz.R
unitizer> 26
| Type a number in `1:5` at the prompt
[1] 26
unitizer> Q

No file selected
Warning in infer_unitizer_location.character(file.path(base.dir, "*"), type = "f",  :
  Invalid user selection
> identical(select, file.path(base.dir, "*"))
[1] TRUE
> 
> unitizer:::read_line_set_vals(c("5"))
> # output
> sel.loc <- unitizer:::infer_unitizer_location(file.path(base.dir,
+     "*"), type = "f", interactive.mode = TRUE)
Possible matching files from "tests/unitizer":
  1: aaa.R
  2: abc.R
  3: inf.R
  4: infer.R
  5: zzz.R
unitizer> 5
Selected file: zzz.R
> basename(sel.loc)
[1] "zzz.R"
> unitizer:::read_line_set_vals(NULL)
> 
> # Non standard inferences
> # warn
> out <- unitizer:::capture_output(
+   unitizer:::infer_unitizer_location(NULL, interactive = FALSE)
+ )
> any(grepl("too many to unambiguously", out$message))
[1] TRUE
> 
> fake.class <- structure(list(), class = "thisclassdoesn'texist")
> identical(infer(fake.class), fake.class)
[1] TRUE
> 
> # no match since file can't exist (warn)
> f <- tempfile()
> out <- capture.output(
+   invisible(unitizer:::infer_unitizer_location(f)), type='message'
+ )
> any(grepl("No possible matching files", out))
[1] TRUE
> 
> 
> unlink(tmp.dir, recursive = TRUE)
> 
> 
> proc.time()
   user  system elapsed 
   1.21    0.14    1.35