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", "ref.R")); make_ref_obj_funs("refobjs")
> 
> options(unitizer.color = FALSE)
> zero.env <- parent.env(.GlobalEnv)
> obj.item <- new("unitizerItem", call = quote(1 + 1), env = new.env())
> obj.item@data@value <- list(2)
> obj.item@data@output <- c("two", "dos", "due")
> obj.item@data@conditions <- new("conditionList", .items = list(simpleError("hello"),
+     simpleWarning("What a warning")))
> obj.item@data@message <- vapply(unitizer:::as.list(obj.item@data@conditions),
+     conditionMessage, character(1L))
> obj.item@data@aborted <- TRUE
> 
> # - "unitizerItem accessor functions work" -------------------------------------
> 
> obj.item$value
[1] 2
> obj.item$output
[1] "two" "dos" "due"
> obj.item$conditions
Condition list with 2 conditions:
1. Error: hello
2. Warning: What a warning
> 
> # Create a bunch of expressions for testing
> 
> exps1 <- expression(
+   library(stats),
+   unitizer_sect("Section 1", {
+     1 + 1
+     runif(20)
+     stop("woohoo")
+     "I'll be removed"
+     "I too will be removed"
+   }),
+   unitizer_sect("Section 2", {
+     "I three will be removed"
+     sample(20)
+ }))
> exps2 <- expression(
+   library(stats),
+   unitizer_sect("Section 1", {
+     1 + 1
+     runif(20)
+     stop("woohoo")
+     var <- 200
+     matrix(1:9, 3)
+     }),
+   unitizer_sect("Section 2", {
+     1 + 20
+     var1 <- list(1, 2, 3)
+     sample(20)
+     matrix(1:9, ncol = 3)
+     lm(x ~ y, data.frame(x = 1:10, y = c(5, 3, 3, 2, 1, 8, 2,
+         1, 4, 1.5)))
+ }))
> my.unitizer <- new("unitizer", id = 1, zero.env = zero.env)
> coi(my.unitizer <- my.unitizer + exps1)
> my.unitizer2 <- new("unitizer", id = 2, zero.env = zero.env)
> # make previous items into reference items
> my.unitizer2 <- my.unitizer2 + my.unitizer@items.new
> # now add back items to compare
> coi(my.unitizer2 <- my.unitizer2 + exps2)
> unitizer.prepped <- unitizer:::browsePrep(my.unitizer2, mode = "unitize")
> 
> # NOTE: for some reason, changes in between revisions d9619db and a46e941
> # should have caused the tests to fail, but didn't.  We did not notice
> # failures until we ran tests quite a bit later at ca9f540364.  Not sure why
> # this happened.  The failures were due to the order of tests changing because
> # we moved ignored tests to be in the same sub-section as the subsequent non-
> # ignored tests
> 
> # - "Can convert to data.frame" ------------------------------------------------
> 
> all.equal(unitizer:::as.data.frame(unitizer.prepped), rds("browse_df1"))
[1] TRUE
> 
> # - "unitizerBrowse correctly processes unitizer for display" ------------------
> 
> # force all tests to be reviewed so they will be shown
> unitizer.prepped@mapping@reviewed <-
+   rep(TRUE, length(unitizer.prepped@mapping@reviewed))
> unitizer.prepped@mapping@review.val <-
+   rep("Y", length(unitizer.prepped@mapping@reviewed))
> all.equal(as.character(unitizer.prepped, 60), rds("browse_aschar1"))
[1] TRUE
> 
> # Alternating tests
> unitizer.prepped@mapping@reviewed <-
+   as.logical(seq(length(unitizer.prepped@mapping@reviewed))%%2)
> all.equal(as.character(unitizer.prepped, 60), rds("browse_aschar2"))
[1] TRUE
> 
> # Errors / warnings
> try(as.character(unitizer.prepped, -1))           # positive
Error in .local(x, ...) : 
  Argument `width` must be a positive scalar numeric.
> prep.narrow <- as.character(unitizer.prepped, 5)  # too small
Warning in .local(x, ...) :
  Selected display width too small, will be ignored
> 
> all.equal(prep.narrow, rds("browse_ascharnarrow"))
[1] TRUE
> 
> # Colors work (should be last in this section) since the reference @global
> 
> unitizer.prepped@global$unitizer.opts[["unitizer.color"]] <- TRUE
> old.opt <- options(crayon.enabled = TRUE)
> prep.color <- as.character(unitizer.prepped, 60)
> all.equal(prep.color, rds("browse_aschar3"))
[1] TRUE
> unitizer.prepped@global$unitizer.opts[["unitizer.color"]] <- FALSE
> options(old.opt)
> 
> # - "processInput generates Correct Item Structure" ----------------------------
> 
> # Here we just test that the calls of each item are what we expect, making
> # sure that different behavior for Y or N depending on sub-section type is
> # observed correctly (e.g. a Y for new test means keep it, where as for
> # removed test means don't keep it)
> # For debugging:
> # cbind(substr(unitizer:::deparseCalls(unitizer.prepped), 1, 15), as.character(unitizer.prepped@mapping@review.type), unitizer.prepped@mapping@review.val, unitizer.prepped@mapping@reviewed)
> # cat(deparse(width=500,
> #   lapply(
> #     unitizer:::as.list(unitizer:::processInput(unitizer.prepped)),
> #     function(x) call("quote", slot(x, "call")))
> # ) )
> unitizer.prepped@mapping@reviewed <-
+   rep(TRUE, length(unitizer.prepped@mapping@reviewed))
> unitizer.prepped@mapping@review.val <-
+   rep("Y", length(unitizer.prepped@mapping@reviewed))
> 
> # Assume user accepted all tests
> 
> lapply(
+   unitizer:::as.list(unitizer:::processInput(unitizer.prepped)), slot, "call"
+ )
[[1]]
library(stats)

[[2]]
runif(20)

[[3]]
var <- 200

[[4]]
matrix(1:9, 3)

[[5]]
1 + 1

[[6]]
stop("woohoo")

[[7]]
var1 <- list(1, 2, 3)

[[8]]
sample(20)

[[9]]
1 + 20

[[10]]
matrix(1:9, ncol = 3)

[[11]]
lm(x ~ y, data.frame(x = 1:10, y = c(5, 3, 3, 2, 1, 8, 2, 1, 
    4, 1.5)))

> # Assume user accepted all but 1, 4, 6 and 11, note it isn't completely
> # obvious what should be kept since an N for anything but a new and passed
> # test will result in some object remaining in the list (typically the
> # reference copy thereof)
> unitizer.prepped@mapping@review.val[] <- "N"
> unitizer.prepped@mapping@review.val[c(2, 6, 8, 12)] <- "Y"
> lapply(
+   unitizer:::as.list(unitizer:::processInput(unitizer.prepped)), slot, "call"
+ )
[[1]]
runif(20)

[[2]]
stop("woohoo")

[[3]]
[1] "I'll be removed"

[[4]]
sample(20)

[[5]]
matrix(1:9, ncol = 3)

[[6]]
[1] "I three will be removed"

> # - "unitizerBrowse subsetting works" ------------------------------------------
> 
> # note single bracket subsetting for `unitizerBrowse` overrides the `unitizerList`
> # subsetting
> unitizer:::deparseCalls(unitizer:::extractItems(unitizer.prepped[c(4, 8, 10)]))
[1] "matrix(1:9, 3)"            "\"I too will be removed\""
[3] "sample(20)"               
> unitizer:::deparseCalls(unitizer:::extractItems(unitizer.prepped[c(2, 3, 11)]))
[1] "runif(20)"  "var <- 200" "1 + 20"    
> 
> # - "Reference section mapping works" ------------------------------------------
> 
> # Copy over just two sections
> my.unitizer3 <- new("unitizer", id = 3, zero.env = zero.env) +
+     my.unitizer2@items.new[-(2:6)]
> # Exclude section two tests
> # sections should copy over
> my.unitizer3 <- unitizer:::refSections(my.unitizer3, my.unitizer2)
> # just copy over 1st and 3rd sections
> identical(my.unitizer3@sections.ref, my.unitizer2@sections[-2])
[1] TRUE
> my.unitizer3@section.ref.map
[1] 1 2 2 2 2 2
> 
> # Make sure "removed" sections are NA when kept
> unitizer.prepped@mapping@reviewed <-
+   rep(TRUE, length(unitizer.prepped@mapping@reviewed))
> # don't delete removed
> unitizer.prepped@mapping@review.val <-
+   ifelse(unitizer.prepped@mapping@review.type %in% c("Removed"), "N", "Y")
> items.processed <- unitizer:::processInput(unitizer.prepped)
> vapply(unitizer:::as.list(items.processed), slot, 1L, "section.id")
 [1]  1  2  2  2  2  2 NA NA  3  3  3  3  3 NA
> 
> # Now try to re-establish sections with removed tests
> my.unitizer4 <-
+   new("unitizer", id = 4, zero.env = zero.env) + items.processed
> # sections should copy over
> my.unitizer4 <- unitizer:::refSections(my.unitizer4, my.unitizer2)
> is(my.unitizer4@sections.ref[[4L]], "unitizerSectionNA")
[1] TRUE
> my.unitizer4@section.ref.map
 [1] 1 2 2 2 2 2 4 4 3 3 3 3 3 4
> 
> # - "Item Extraction" ----------------------------------------------------------
> 
> items <- unitizer:::extractItems(unitizer.prepped)
> item.calls <- vapply(
+   unitizer:::as.list(items),
+   function(x)
+     paste0(deparse(x@call, width.cutoff = 500), collapse = ""), character(1L)
+ )
> item.types <- vapply(unitizer:::as.list(items), slot, FALSE, "reference")
> item.ids <- vapply(unitizer:::as.list(items), slot, 1L, "id")
> item.df <- data.frame(item.calls, item.types, item.ids, stringsAsFactors = FALSE)
> 
> all.equal(item.df[order(item.types, item.ids),], rds("browse_itemord"))
[1] TRUE
> 
> proc.time()
   user  system elapsed 
   0.84    0.06    0.89