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"))
> 
> options(unitizer.color = FALSE, width = 80L)
> 
> # - "Random Seed" --------------------------------------------------------------
> 
> old.seed <- if (!exists(".Random.seed")) NULL else .Random.seed
> seed.dat <- getOption("unitizer.seed")
> 
> suppressWarnings(
+   untz.glob <-
+     unitizer:::unitizerGlobal$new(enable.which = setNames(2L, "random.seed"))
+ )
> do.call(set.seed, seed.dat)
> new.seed <- .Random.seed
> state <- untz.glob$state()
> invisible(runif(10))    # see if we can reset state after this
> untz.glob$reset(state)
An object of class "unitizerGlobalIndices"
Slot "search.path":
[1] 0

Slot "options":
[1] 0

Slot "working.directory":
[1] 0

Slot "random.seed":
[1] 2

Slot "namespaces":
[1] 0

> identical(.Random.seed, new.seed)
[1] TRUE
> untz.glob$resetFull()
An object of class "unitizerGlobalIndices"
Slot "search.path":
[1] 1

Slot "options":
[1] 1

Slot "working.directory":
[1] 1

Slot "random.seed":
[1] 1

Slot "namespaces":
[1] 1

> 
> if (is.null(old.seed)) {
+   !isTRUE(exists(".Random.seed"))
+ } else identical(old.seed, .Random.seed)
[1] TRUE
> 
> # - "State Show" ---------------------------------------------------------------
> 
> show(unitizer:::unitizerStatePristine())
           Settings Values
1           par.env <auto>
2       search.path      2
3           options      2
4 working.directory      2
5       random.seed      2
6        namespaces      2
-----
0: off
1: track starting with initial state
2: track starting with clean state
<auto>: use special unitizer environment as 'par.env'
See `?unitizerState` for more details.
> 
> # - "all.equal.unitizerDummy" --------------------------------------------------
> 
> dummy <- new("unitizerDummy")
> blah <- "hello"
> ref.txt <- "`.REF` value was not recorded, but `.NEW` value was; they are likely different"
> identical(all.equal(dummy, blah), ref.txt)
[1] TRUE
> all.equal(dummy, dummy)
[1] TRUE
> identical(
+   all.equal(blah, dummy),
+   "`.NEW` value was not recorded, but `.REF` value was; they are likely different"
+ )
[1] TRUE
> # testing S4 / S3 methods, first works, second doesn't since we can't
> # have an S3 generic with dispatch on 2nd arg
> 
> identical(
+   evalq(all.equal(new("unitizerDummy"), "hello"), getNamespace("stats")),
+   ref.txt
+ )
[1] TRUE
> evalq(all.equal("hello", new("unitizerDummy")), getNamespace("stats"))
[1] "Modes: character, S4"                           
[2] "Attributes: < target is NULL, current is list >"
[3] "target is character, current is unitizerDummy"  
> 
> # - "All Equal States" ---------------------------------------------------------
> 
> # Doesn't seem like we're comparing these to anything?  Maybe should look into
> # doing so?
> 
> state.A <- new("unitizerGlobalState", search.path = letters[1:3],
+     options = list(a = 5:7, b = new("unitizerDummy"), c = "hello"),
+     working.directory = "a/b/c")
> state.B <- new("unitizerGlobalState", search.path = letters[1:3],
+     options = list(a = 5:7, b = new("unitizerDummy"), d = "goodbye",
+         c = new("unitizerDummy")), working.directory = new("unitizerDummy"),
+     random.seed = 1:3)
> state.C <- new("unitizerGlobalState", search.path = letters,
+     options = list(a = list(5, 6, 7), c = LETTERS), working.directory = new("unitizerDummy"),
+     random.seed = 1:3)
> # just compare to A
> state.D <- new("unitizerGlobalState", search.path = letters[1:3],
+     options = list(a = list(1, 2, 3), b = new("unitizerDummy"),
+         c = "hello"), working.directory = "a/b/c")
> state.E <- new("unitizerGlobalState", options = setNames(as.list(1:20),
+     head(letters, 20)))
> state.F <- new("unitizerGlobalState", options = setNames(as.list(1:20),
+     tail(letters, 20)))
> # This one is supposed to return something non-character or TRUE when used
> # with the provided all.equal
> state.G <- new("unitizerGlobalState", options = list(a = structure(TRUE,
+     class = "unitizer_glob_state_test"), b = 0))
> state.H <- new("unitizerGlobalState", options = list(a = structure(FALSE,
+     class = "unitizer_glob_state_test"), b = 2))
> 
> # - "as.state" -----------------------------------------------------------------
> 
> identical(
+   unitizer:::as.state("recommended"),
+   unitizer:::as.state(unitizer:::unitizerStateSuggested())
+ )
[1] TRUE
> identical(
+   unitizer:::as.state("suggested"),
+   unitizer:::as.state(unitizer:::unitizerStateSuggested())
+ )
[1] TRUE
> identical(
+   unitizer:::as.state("pristine"),
+   unitizer:::as.state(unitizer:::unitizerStatePristine())
+ )
[1] TRUE
> 
> # unitizerStateProcessed should produce the default object (which currently
> # is "off")
> 
> all.equal(
+   unitizer:::as.state(.GlobalEnv),
+   unitizer:::as.state(unitizer:::unitizerStateSuggested(par.env = .GlobalEnv))
+ )
[1] TRUE
> all.equal(
+   unitizer:::as.state(in_pkg("stats")),
+   unitizer:::as.state(
+     unitizer:::unitizerStateSuggested(par.env = getNamespace("stats"))
+ ) )
[1] TRUE
> 
> stats.lib <- file.path(system.file(package = "stats"), "R")
> all.equal(
+   unitizer:::as.state(in_pkg(), test.files = stats.lib),
+   unitizer:::as.state(
+     unitizer:::unitizerStateSuggested(par.env = getNamespace("stats"))
+ ) )
[1] TRUE
> try(unitizer:::as.state(200))
Error in as.state_raw(x) : 
  Argument `x` must be character(1L) %in% c("pristine", "recommended", "suggested"
, "basic", "off", "safe"), NULL, an environment, or must inherit from S4 classes
`unitizerStateRaw`, `unitizerStateProcessed` or `unitizerInPkg` in order to be 
interpreted as a unitizer state object.
> state <- unitizer:::unitizerStateOff()
> # bypass validity method
> state@options <- 2L
> try(validObject(state))
Error in validObject(state) : 
  invalid class "unitizerStateOff" object: Argument `state` is an invalid state: 'options' is set to 2, but 'search.path' and 'namespaces' are not
> # state raw conversions
> identical(
+   unitizer:::as.state(unitizer:::unitizerStateRaw()),
+   unitizer:::unitizerStateProcessed()
+ )
[1] TRUE
> identical(
+   unitizer:::as.state(unitizer:::unitizerStateRaw(par.env = "stats")),
+   unitizer:::unitizerStateProcessed(par.env = getNamespace("stats"))
+ )
[1] TRUE
> state@options <- 0L
> state.proc <- unitizer:::as.unitizerStateProcessed(state)
> state.raw <- unitizer:::as.unitizerStateRaw(state.proc)
> is(state.raw, "unitizerStateRaw")
[1] TRUE
> all.equal(
+   lapply(slotNames(state), slot, object = state.proc),
+   lapply(slotNames(state.raw), slot, object = state.raw)
+ )
[1] TRUE
> try(unitizer:::as.state(unitizer:::unitizerStateRaw(par.env = in_pkg())))
Error in in_pkg_to_env(x.raw@par.env, test.files) : 
  Unable to detect package to use namespace of as parent environment; see `?
unitizerState` for how to specify a package namespace explicitly as a parent 
environment.
Error in unitizer:::as.state(unitizer:::unitizerStateRaw(par.env = in_pkg())) : 
  Unable to convert `par.env` value to a namespace environment
> 
> identical(
+   unitizer:::as.state(unitizer:::unitizerStateRaw(par.env = in_pkg("stats"))),
+   unitizer:::unitizerStateProcessed(par.env = getNamespace("stats"))
+ )
[1] TRUE
> try(
+   unitizer:::as.state(
+     unitizer:::unitizerStateRaw(par.env = in_pkg("asdfalkdfasd"))
+ ) )
Error in loadNamespace(name) : there is no package called 'asdfalkdfasd'
Error in in_pkg_to_env(x.raw@par.env, test.files) : 
  Unable to load "asdfalkdfasd" namespace to use as parent environment; see 
`?unitizerState` for instructions on how to specify a package namespace as a 
parent environment for tests.
Error in unitizer:::as.state(unitizer:::unitizerStateRaw(par.env = in_pkg("asdfalkdfasd"))) : 
  Unable to convert `par.env` value to a namespace environment
> try(
+   unitizer:::as.state(
+     unitizer:::unitizerStateRaw(par.env = in_pkg("")), test.files = getwd()
+ ) )
Error in in_pkg("") : Argument `package` may not be an empty string
> # impossible states
> state.obj <- unitizer:::unitizerStateRaw()
> state.obj@options <- 2L
> try(unitizer:::as.state(state.obj))
Error in unitizer:::as.state(state.obj) : 
  Options state tracking (2) must be less than namespace state tracking (0).
> state.obj@namespaces <- 2L
> state.obj@search.path <- 1L
> try(unitizer:::as.state(state.obj))
Error in unitizer:::as.state(state.obj) : 
  Namespace state tracking (2) must be less than or equal to search path state 
tracking (1).
> 
> # - "as.state_raw" -------------------------------------------------------------
> 
> old.opt.loc <- options(unitizer.state = .GlobalEnv)
> try(unitizer:::as.state_raw(.GlobalEnv))
Error in unitizer:::as.state_raw(.GlobalEnv) : 
  Value for `getOption('unitizer.state')` is incompatible with using an environment or an 'unitizerInPkg' object as the value for the `state` argument because it also is an environment or a 'unitizerInPkg' object; you must change the option or the `state` argument to be compatible.
> options(unitizer.state = 42L)
> try(unitizer:::as.state_raw(.GlobalEnv))
Error in unitizer:::as.state_raw(.GlobalEnv) : 
  `getOption('unitizer.state')` must be character(1L) %in% c("pristine", "recom-
mended", "suggested", "basic", "off", "safe"), NULL, an environment, or must 
inherit from S4 classes `unitizerStateRaw`, `unitizerStateProcessed` or `
unitizerInPkg` in order to be interpreted as a unitizer state object.
> state.raw <- unitizer:::as.unitizerStateRaw(unitizer:::unitizerStateOff())
> state.proc <- unitizer:::as.unitizerStateProcessed(state.raw)
> my.env <- new.env()
> options(unitizer.state = state.raw)
> state.raw@par.env <- my.env
> all.equal(unitizer:::as.state_raw(my.env), state.raw)
[1] TRUE
> options(unitizer.state = state.proc)
> my.env <- new.env()
> state.proc@par.env <- my.env
> all.equal(
+   unitizer:::as.state_raw(my.env),
+   unitizer:::as.unitizerStateRaw(state.proc)
+ )
[1] TRUE
> options(old.opt.loc)
> 
> # - "state" --------------------------------------------------------------------
> 
> # all these assume we set the options to be in recommended mode
> 
> all.equal(state("stats"), unitizer:::unitizerStateSuggested(par.env = "stats"))
[1] TRUE
> 
> all.equal(
+   state(in_pkg("stats")),
+   unitizer:::unitizerStateSuggested(par.env = in_pkg("stats"))
+ )
[1] TRUE
> all.equal(
+   state(in_pkg()), unitizer:::unitizerStateSuggested(par.env = in_pkg())
+ )
[1] TRUE
> all.equal(
+   state(search.path = 1), unitizer:::unitizerStateSuggested(search.path = 1L)
+ )
[1] TRUE
> s1 <- unitizer:::unitizerStateSuggested(par.env = .GlobalEnv)
> for (i in setdiff(slotNames(s1), "par.env")) slot(s1, i) <- 0L
> s2 <- unitizer:::unitizerStateOff()
> all.equal(s1, s2)
[1] TRUE
> # invalid state
> try(state(search.path = 3))
Error in state(search.path = 3) : 
  Argument `search.path` must be integer(1L)  in 0:2
> try(state(options = 2, namespaces = 1))
Error in state(options = 2, namespaces = 1) : 
  Unable to create valid `unitizerStateRaw` object: Argument `state` is an invalid state: 'options' is set to 2, but 'search.path' and 'namespaces' are not
> try(state(namespaces = 2, search.path = 1))
Error in state(namespaces = 2, search.path = 1) : 
  Unable to create valid `unitizerStateRaw` object: Argument `state` is an invalid state: 'namespaces' is set to 2, but 'search.path' is not
> state.inv <- unitizer:::unitizerStateProcessed()
> state.inv@options <- 2L
> try(unitizer:::as.state(state.inv))
Error in unitizer:::as.state(state.inv) : 
  Options state tracking (2) must be less than namespace state tracking (0).
> state.inv@namespaces <- 2L
> try(unitizer:::as.state(state.inv))
Error in unitizer:::as.state(state.inv) : 
  Namespace state tracking (2) must be less than or equal to search path state 
tracking (0).
> # captured <in: >
> any(grepl("<in: .*>", capture.output(show(state(in_pkg())))))
[1] TRUE
> any(grepl("<in: package:stats>", capture.output(show(state(in_pkg("stats"))))))
[1] TRUE
> any(grepl("namespace:stats", capture.output(show(state(asNamespace("stats"))))))
[1] TRUE
> 
> # - "in_pkg" -------------------------------------------------------------------
> 
> try(in_pkg(""))
Error in in_pkg("") : Argument `package` may not be an empty string
> identical(as.character(in_pkg()), "<in: auto-detect-pkg>")
[1] TRUE
> identical(as.character(in_pkg("stats")), "<in: package:stats>")
[1] TRUE
> identical(capture.output(show(in_pkg())), "<in: auto-detect-pkg>")
[1] TRUE
> try(unitizer:::in_pkg_to_env(in_pkg(), "/"))
Error in unitizer:::in_pkg_to_env(in_pkg(), "/") : 
  Unable to detect package to use namespace of as parent environment; see `?
unitizerState` for how to specify a package namespace explicitly as a parent 
environment.
> 
> # - "merge states" -------------------------------------------------------------
> 
> trk.new <- new("unitizerGlobalTrackingStore", search.path = list(1,
+     2, 3), options = list("a", "b"))
> trk.ref <- new("unitizerGlobalTrackingStore", search.path = list(4,
+     5, 6), options = list("c", "d"))
> items <- new("unitizerItems")
> items <- items + new("unitizerItem", call = quote(1 + 1), glob.indices = new("unitizerGlobalIndices",
+     search.path = 1L, options = 2L))
> items <- items + new("unitizerItem", call = quote(2 + 1), glob.indices = new("unitizerGlobalIndices",
+     search.path = 2L, options = 1L))
> items <- items + new("unitizerItem", call = quote(1 * 1), reference = TRUE,
+     glob.indices = new("unitizerGlobalIndices", search.path = 1L,
+         options = 1L))
> items <- items + new("unitizerItem", call = quote(2 * 1), reference = TRUE,
+     glob.indices = new("unitizerGlobalIndices", search.path = 3L,
+         options = 2L))
> res <- unitizer:::mergeStates(items, trk.new, trk.ref)
> 
> sapply(res$items, function(x) as.integer(slot(x, "glob.indices")))
                  [,1] [,2] [,3] [,4]
search.path          1    2    4    5
options              2    1    3    4
working.directory    0    0    0    0
random.seed          0    0    0    0
namespaces           0    0    0    0
> s.n.to.check <- c("search.path", "options", "working.directory",
+     "random.seed", "namespaces")
> sapply(s.n.to.check, slot, object = res$states)
$search.path
$search.path[[1]]
[1] 1

$search.path[[2]]
[1] 2

$search.path[[3]]
[1] 3

$search.path[[4]]
[1] 4

$search.path[[5]]
[1] 6


$options
$options[[1]]
[1] "a"

$options[[2]]
[1] "b"

$options[[3]]
[1] "c"

$options[[4]]
[1] "d"


$working.directory
list()

$random.seed
list()

$namespaces
list()

> # No reference items
> items.no.ref <- items[1:2]
> identical(
+   unitizer:::mergeStates(items.no.ref, trk.new, trk.ref), 
+   list(items = items.no.ref, states = trk.new)
+ )
[1] TRUE
> # No new items; note that we only remap the used states to the new state
> # which is why we need all the .mod objects
> 
> items.no.new <- items[3:4]
> items.no.new.mod <- items.no.new
> items.no.new.mod[[2L]]@glob.indices@search.path <- 2L
> trk.ref.mod <- trk.ref
> trk.ref.mod@search.path[[2L]] <- NULL
> 
> identical(
+   unitizer:::mergeStates(
+     items.no.new, new("unitizerGlobalTrackingStore"),trk.ref
+   ),
+   list(items = items.no.new.mod, states = trk.ref.mod)
+ )
[1] TRUE
> 
> 
> proc.time()
   user  system elapsed 
   0.57    0.07    0.65