R Under development (unstable) (2025-04-19 r88162 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.

> NAME <- "diffPrint"
> source(file.path('_helper', 'init.R'))
> 
> # Note, atomic prints happen in different test file
> 
> # - Matrices -------------------------------------------------------------------
> 
> mx.2 <- matrix(1:100, ncol=2)
> mx.4 <- mx.3 <- mx.2
> mx.3[31, 2] <- 111L
> 
> mx.3a <- mx.3[-31, ]
> set.seed(2)
> mx.4[cbind(sample(1:50, 6), sample(1:2, 6, replace=TRUE))] <-
+   sample(-(1:50), 6)
> 
> mx.5 <- matrix(1:9, 3)
> mx.6 <- matrix(12:1, 4)
> mx.6[4,] <- c(3L, 6L, 9L)
> 
> # single value difference
> all.equal(as.character(diffPrint(mx.2, mx.3)), rdsf(100))
[1] TRUE
> # single value unified
> all.equal(as.character(diffPrint(mx.2, mx.3, mode="unified")), rdsf(150))
[1] TRUE
> # single value context
> all.equal(as.character(diffPrint(mx.2, mx.3, mode="context")), rdsf(175))
[1] TRUE
> # missing row
> all.equal(as.character(diffPrint(mx.2, mx.3a)), rdsf(200))
[1] TRUE
> all.equal(as.character(diffPrint(mx.2, mx.3a, mode="unified")), rdsf(300))
[1] TRUE
> # More differences
> 
> all.equal(as.character(diffPrint(mx.2, mx.4)), rdsf(400))
[1] TRUE
> all.equal(as.character(diffPrint(mx.2, mx.4, mode="unified")), rdsf(500))
[1] TRUE
> # Testing alignments
> all.equal(as.character(diffPrint(mx.5, mx.6)), rdsf(600))
[1] TRUE
> all.equal(as.character(diffPrint(mx.5, mx.6, mode="unified")), rdsf(700))
[1] TRUE
> all.equal(as.character(diffPrint(mx.5, mx.6, mode="context")), rdsf(800))
[1] TRUE
> # More complex matrix
> set.seed(2)
> A <- B <- matrix(sample(1:80), nrow=16)
> B[cbind(sample(5:16, 4), sample(1:5, 4))] <- sample(30:80, 4)
> 
> all.equal(as.character(diffPrint(A, B)), rdsf(900))
[1] TRUE
> all.equal(as.character(diffPrint(A, B, mode="unified")), rdsf(1000))
[1] TRUE
> all.equal(as.character(diffPrint(A, B, mode="context")), rdsf(1100))
[1] TRUE
> # Style matrices
> 
> all.equal(as.character(diffPrint(diffobj:::.mx1, diffobj:::.mx2)), rdsf(1200))
[1] TRUE
> 
> # - Lists ----------------------------------------------------------------------
> 
> all.equal(as.character(diffPrint(lst.1, lst.3)), rdsf(1300))
[1] TRUE
> all.equal(as.character(diffPrint(lst.1, lst.3, mode="unified")), rdsf(1400))
[1] TRUE
> all.equal(as.character(diffPrint(lst.4, lst.5)), rdsf(1500))
[1] TRUE
> all.equal(as.character(diffPrint(lst.4, lst.5, mode="context")), rdsf(1600))
[1] TRUE
> # Nested first element (https://github.com/brodieG/diffobj/issues/46)
> all.equal(
+   as.character(diffPrint(list(1, list(2, list(1:3))), list(list(list(1:3))))),
+   rdsf(1650)
+ )
[1] TRUE
> # Interesting but relatively slow example so we don't actually run it in
> # tests
> 
> # diffPrint(unclass(mdl1), unclass(mdl2))
> # diffPrint(unclass(mdl1), unclass(mdl2), mode="unified")
> 
> # - Data Frames ----------------------------------------------------------------
> 
> all.equal(as.character(diffPrint(iris.s, iris.2)), rdsf(1700))
[1] TRUE
> all.equal(
+   as.character(diffPrint(iris.s, iris.2, mode="sidebyside")), rdsf(1800)
+ )
[1] TRUE
> all.equal(as.character(diffPrint(iris.s, iris.c)), rdsf(1900))
[1] TRUE
> all.equal(as.character(diffPrint(iris.s, iris.3)), rdsf(2000))
[1] TRUE
> 
> all.equal(
+   as.character(diffPrint(iris.s, iris.3, mode="sidebyside")), rdsf(2100)
+ )
[1] TRUE
> all.equal(as.character(diffPrint(iris.s, iris.4, mode="unified")), rdsf(2150))
[1] TRUE
> all.equal(
+   as.character(diffPrint(iris.s, iris.4, mode="sidebyside")), rdsf(2200)
+ )
[1] TRUE
> all.equal(
+   as.character(diffPrint(iris.5, iris.4, mode="sidebyside")), rdsf(2250)
+ )
[1] TRUE
> all.equal(as.character(diffPrint(iris.3a, iris.4a)), rdsf(2300))
[1] TRUE
> all.equal(
+   as.character(diffPrint(iris.s, iris.3, mode="sidebyside")), rdsf(2350)
+ )
[1] TRUE
> all.equal(as.character(diffPrint(iris.s, iris.s[-2])), rdsf(2370))
[1] TRUE
> # This one is interesting because the input is pathological because there
> # is one line that matches exactly between the two and as such creates a
> # matching hunk, but it really is matching by coincidence.
> 
> all.equal(
+   as.character(diffPrint(iris.s, iris.s[-2], mode="sidebyside")), rdsf(2383)
+ )
[1] TRUE
> # Possible example where we may not want to trim the row headers (Issue #39)
> all.equal(
+   as.character(diffPrint(cars[1:5,], mtcars[1:5,], mode="sidebyside")),
+   rdsf(2380)
+ )
[1] TRUE
> 
> # - Guides ---------------------------------------------------------------------
> 
> # Most guides tests are in the guides file, but this confirms interface works
> # when starting at `diffPrint` instead of internally
> 
> all.equal(
+   as.character(
+     diffPrint(
+       iris.s, iris.4, mode="sidebyside", guides=function(x, y) integer()
+   ) ),
+   rdsf(2400)
+ )
[1] TRUE
> all.equal(
+   as.character(diffPrint(iris.s, iris.4, mode="sidebyside", guides=FALSE)),
+   rdsf(2500)
+ )
[1] TRUE
> 
> # - Arrays
> arr.1 <- arr.2 <- array(1:24, c(4, 2, 3))
> arr.2[c(3, 20)] <- 99L
> all.equal(as.character(diffPrint(arr.1, arr.2)), rdsf(2600))
[1] TRUE
> 
> # - Mixed
> all.equal(
+   as.character(diffPrint(list(1, 2, 3), matrix(1:9, 3))),
+   rdsf(2700)
+ )
[1] TRUE
> all.equal(
+   as.character(diffPrint(list(25, 2, 3), matrix(1:9, 3))),
+   rdsf(2800)
+ )
[1] TRUE
> all.equal(
+   as.character(
+     diffPrint(list(c(1, 4, 7), c(2, 5, 8), c(3, 6, 9)), matrix(1:9, 3))
+   ),
+   rdsf(2900)
+ )
[1] TRUE
> # - `unitizer` corner case -----------------------------------------------------
> 
> res1 <- structure(
+   c(-1717, 101, 0.938678984853783),
+   .Names = c("intercept", "slope", "rsq"), class = "fastlm"
+ )
> res2 <- structure(
+   c(-3.541306e+13, 701248600000, 0.938679),
+   .Names = c("intercept", "slope", "rsq"), class = "fastlm"
+ )
> all.equal(as.character(diffPrint(res1, res2)), rdsf(3000))
[1] TRUE
> all.equal(
+   as.character(diffPrint(unname(res1), unname(res2))), rdsf(3100)
+ )
[1] TRUE
> 
> # - factors and other meta -----------------------------------------------------
> 
> # Thanks Frank
> 
> all.equal(
+   as.character(diffPrint(factor(1:100), factor(c(1:99, 101)))), rdsf(3200)
+ )
[1] TRUE
> f1 <- factor(1:100)
> f2 <- factor(c(1:20, 22:99, 101))
> all.equal(capture.output(diffPrint(f1, f2)), txtf(100))
[1] TRUE
> 
> f3 <- factor(letters[1:10])
> f4 <- factor(letters[1:10], levels=letters[1:11])
> all.equal(capture.output(diffPrint(f3, f4)), txtf(150))
[1] TRUE
> 
> # time series
> 
> nhtemp2 <- nhtemp
> nhtemp2[c(5, 30)] <- -999
> all.equal(capture.output(diffPrint(nhtemp, nhtemp2)), txtf(175))
[1] TRUE
> 
> # Meta on both sides
> 
> print.diffobj_test_c1 <- function(x, ...) {
+   writeLines(c("Header row 1", "header row 2"))
+   print(c(x))
+   writeLines(c("", "Footer row 1", "", "footer row2"))
+ }
> m1 <- structure(1:30, class='diffobj_test_c1')
> m2 <- structure(2:51, class='diffobj_test_c1')
> all.equal(capture.output(diffPrint(m1, m2)), txtf(200), print=TRUE)
[1] TRUE
> 
> # - Raw output -----------------------------------------------------------------
> 
> all.equal(
+   as.character(diffPrint(letters, LETTERS, format="raw", pager="off")),
+   rdsf(3300)
+ )
[1] TRUE
> # - Varying Widths -------------------------------------------------------------
> 
> all.equal(
+   as.character(diffPrint(letters, LETTERS, format="raw", disp.width=40)),
+   rdsf(3400)
+ )
[1] TRUE
> try(diffPrint(letters, LETTERS, disp.width=5))
Error in diffPrint(target = letters, current = LETTERS, disp.width = 5) : 
  Arugment `disp.width` must be integer(1L) and 0, or between 10 and 10000
> 
> # - covr workaround ------------------------------------------------------------
> 
> # Needed so that the function definition stuff is marked as covered; really
> # it shouldn't even be eligible for coverage, need to discuss further with
> # jhester
> 
> invisible(diffobj:::make_diff_fun())
> 
> # - Encoding Issues ------------------------------------------------------------
> 
> # issue81, mixed UTF-8 ASCII, encoding a-acute in hex to avoid cross platform
> # issues
> 
> a <- "G\xc3\xa1bor Cs\xc3\xa1rdi"
> b <- sprintf("%s wow", a)
> Encoding(a) <- 'UTF-8'
> Encoding(b) <- 'UTF-8'
> 
> # No error
> 
> new <- (as.character(diffPrint(list(hell=a, b=NULL), list(hell=b, b=list()))))
> 
> # can't store this in RDS b/c otherwise won't run properly on oses with
> # different encoding (e.g. windows)
> 
> ref <- structure(
+   c("\033[33m<\033[39m \033[33mlist(hell = a, b = N..\033[39m  \033[34m>\033[39m \033[34mlist(hell = b, b = l..\033[39m",
+     "\033[36m@@ 1,6 @@               \033[39m  \033[36m@@ 1,6 @@               \033[39m",
+     "  \033[90m\033[39m$hell\033[90m\033[39m                     \033[90m\033[39m$hell\033[90m\033[39m                 ",
+     "\033[33m<\033[39m \033[90m[1] \033[39m\033[33m\"G\xc3\xa1bor Cs\xc3\xa1rdi\"\033[39m\033[90m\033[39m      \033[34m>\033[39m \033[90m[1] \033[39m\033[34m\"G\xc3\xa1bor Cs\xc3\xa1rdi wow\"\033[39m\033[90m\033[39m",
+     "                                                  ", "  \033[90m\033[39m$b\033[90m\033[39m                        \033[90m\033[39m$b\033[90m\033[39m                    ",
+     "\033[33m<\033[39m \033[90m\033[39m\033[33mNULL\033[39m\033[90m\033[39m                    \033[34m>\033[39m \033[90m\033[39m\033[34mlist\033[39m\033[34m()\033[39m\033[90m\033[39m                ",
+     "                                                  "
+   ),
+   len = 8L
+ )
> Encoding(ref) <- 'UTF-8'
> all.equal(new, ref)
[1] TRUE
> 
> # issue 106, this used to fail when trying to check for an RDS with a bytes
> # encoded file name
> 
> bytes <- "\x81"
> Encoding(bytes) <- "bytes"
> isTRUE(!any(diffPrint(bytes, bytes)))
[1] TRUE
> 
> # - Quoted Objects -------------------------------------------------------------
> 
> all.equal(
+   as.character(diffPrint(quote(zz + 1), quote(zz + 3))),
+   structure(
+     c("\033[33m<\033[39m \033[33mquote(..\033[39m  \033[34m>\033[39m \033[34mquote(..\033[39m", "\033[36m@@ 1 @@   \033[39m  \033[36m@@ 1 @@   \033[39m", "\033[33m<\033[39m \033[90m\033[39mzz + \033[33m1\033[39m\033[90m\033[39m    \033[34m>\033[39m \033[90m\033[39mzz + \033[34m3\033[39m\033[90m\033[39m  "
+     ), len = 3L
+   )
+ )
[1] TRUE
> all.equal(
+   as.character(diffPrint(quote(x), quote(y))),
+   structure(
+     c("\033[33m<\033[39m \033[33mquote(x)\033[39m  \033[34m>\033[39m \033[34mquote(y)\033[39m", "\033[36m@@ 1 @@   \033[39m  \033[36m@@ 1 @@   \033[39m", "\033[33m<\033[39m \033[90m\033[39m\033[33mx\033[39m\033[90m\033[39m         \033[34m>\033[39m \033[90m\033[39m\033[34my\033[39m\033[90m\033[39m       "),
+     len = 3L
+   )
+ )
[1] TRUE
> # - par_frame ------------------------------------------------------------------
> 
> # check that par_frame is retrieved correctly
> env <- new.env()
> env$print <- function(x, ...) stop('boom')
> try(evalq(diffPrint(1:3, 1:4), env)) # "Failed attempting .*: boom"
Error in print(1:4) : boom
Error in .local(target, current, ...) : 
  Failed attempting to get text representation of object: boom
> 
> f <- function(a, b, ...) {
+   print <- function(x, ...) stop('boom2')
+   diffPrint(a, b, ...)
+ }
> try(f(1:3, 1:4, format='raw')) # "Failed attempting .*: boom2"
Error in print(1:4) : boom2
Error in .local(target, current, ...) : 
  Failed attempting to get text representation of object: boom2
> 
> 
> proc.time()
   user  system elapsed 
   5.06    0.34    7.17