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 <- "misc"
> source(file.path('_helper', 'init.R'))
> 
> # - trim_str -------------------------------------------------------------------
> 
> a <- structure("hello", class="A", xx="B")
> b <- structure(1:10, yy=a)
> long.string <- "I'm a string long enough to force wrapping under most cases so that I may be useful for tests andiamareallylongwordtoseehowwrappingbreakslongwordsthatexceed"
> obj <- list(
+   a=a, b=b, c=1:50,
+   d=long.string,
+   e=list(1, structure(2, zz=list(a=1, b=list("a", ls=long.string))), e=letters)
+ )
> # conditional because of issue113
> str.txt <- capture.output(str(obj))
> str.txt.w <- capture.output(str(obj, width=30L, strict.width="wrap"))
> 
> if(
+   getRversion() >= '3.5.0' && as.numeric(R.Version()[['svn rev']]) >= 73780
+ ) {
+   c(
+     all.equal(
+       diffobj:::str_levels(str.txt, wrap=FALSE),
+       c(0L, 1L, 2L, 1L, 2L, 3L, 1L, 1L, 1L, 2L, 2L, 3L, 4L, 4L, 5L, 5L, 2L)
+     ),
+     all.equal(
+       diffobj:::str_levels(str.txt.w, wrap=TRUE),
+       c(0L, 1L, 2L, 1L, 1L, 2L, 2L, 3L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
+         1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L,
+         2L, 2L
+       )
+   ) )
+ } else {
+   c(
+     all.equal(
+       diffobj:::str_levels(str.txt, wrap=FALSE),
+       c(0L, 1L, 3L, 1L, 2L, 4L, 1L, 1L, 1L, 2L, 2L, 3L, 4L, 4L, 5L,  5L, 2L)
+     ),
+     all.equal(
+       diffobj:::str_levels(str.txt.w, wrap=TRUE),
+       c(0L, 1L, 1L, 3L, 1L, 1L, 2L, 2L, 4L, 4L, 1L, 1L, 1L, 1L, 1L,  1L, 1L, 1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L,  5L, 5L, 2L, 2L)
+   ) )
+ }
[1] TRUE TRUE
> # cat(
> #   paste(
> #     format(substr(str.txt.w, 1, 20)), diffobj:::str_levels(str.txt.w, TRUE),
> #     sep=": "
> #   ),
> #   sep="\n"
> # )
> 
> # - rle_sub --------------------------------------------------------------------
> 
> x <- c(1, 1, 1, 2, 2, 1, 1, 3, 3, 4, 4, 4, 5, 2, 2)
> r <- rle(x)
> all.equal(diffobj:::rle_sub(r, r$values == 1L), list(1:3, 6:7))
[1] TRUE
> all.equal(diffobj:::rle_sub(r, r$values == 2L), list(4:5, 14:15))
[1] TRUE
> isTRUE(all(x[unlist(diffobj:::rle_sub(r, r$values == 1L))] == 1))
[1] TRUE
> isTRUE(all(x[unlist(diffobj:::rle_sub(r, r$values == 2L))] == 2))
[1] TRUE
> isTRUE(all(x[unlist(diffobj:::rle_sub(r, r$values == 3L))] == 3))
[1] TRUE
> 
> # - call funs ------------------------------------------------------------------
> 
> # Failure case; assumes no S4 dispatch in testthat
> calls <- list(quote(a()), quote(b()), quote(notafunctionblah()))
> all.equal(diffobj:::which_top(calls), length(calls))
[1] TRUE
> diffobj:::extract_call(calls, new.env()) # warn:  "Unable to find")
$call
NULL

$tar
NULL

$cur
NULL

Warning message:
In get_fun(found.call[[1L]], env = par.env) :
  Unable to find function `notafunctionblah` to match call with.
> 
> # missing param works
> 
> calls2 <- pairlist(
+   quote(diffChr("a")), quote(diffChr("a")), quote(.local(target, current, ...))
+ )
> all.equal(
+   diffobj:::extract_call(calls2, new.env()),
+   list(call = quote(diffChr(target = "a", NULL)), tar = "a", cur = NULL)
+ )
[1] TRUE
> # fallback parent frame; can't think of a good way to actually cause this to
> # happen
> 
> # all.equal(diffobj:::par_frame(), .GlobalEnv)
> 
> # - lines ----------------------------------------------------------------------
> 
> old.val <- Sys.getenv("LINES", unset=NA)
> Sys.setenv(LINES="25")
> all.equal(console_lines(), 25L)
[1] TRUE
> Sys.setenv(LINES="-25")
> all.equal(console_lines(), 48L)
[1] TRUE
> Sys.unsetenv("LINES")
> all.equal(console_lines(), 48L)
[1] TRUE
> 
> # - get_funs -------------------------------------------------------------------
> 
> identical(
+   diffobj:::get_fun(quote(diffobj::diffPrint), .BaseNamespaceEnv),
+   diffobj::diffPrint
+ )
[1] TRUE
> identical(
+   diffobj:::get_fun(quote(diffobj:::diffPrint), .BaseNamespaceEnv),
+   diffobj::diffPrint
+ )
[1] TRUE
> identical(
+   diffobj:::get_fun(quote(diffPrint), getNamespace("diffobj")),
+   diffobj::diffPrint
+ )
[1] TRUE
> gf <- diffobj:::get_fun(quote(notAFunction), getNamespace("diffobj")) # warn
Warning message:
In diffobj:::get_fun(quote(notAFunction), getNamespace("diffobj")) :
  Unable to find function `notAFunction` to match call with.
> 
> identical(gf, NULL)
[1] TRUE
> 
> # - trimws2 --------------------------------------------------------------------
> 
> all.equal(diffobj:::trimws2("hello world"),  "hello world")
[1] TRUE
> all.equal(diffobj:::trimws2("  hello world"),  "hello world")
[1] TRUE
> all.equal(diffobj:::trimws2("  hello world  "),  "hello world")
[1] TRUE
> all.equal(diffobj:::trimws2("  hello world  ", 'left'), "hello world  ")
[1] TRUE
> all.equal(diffobj:::trimws2("  hello world  ", 'right'), "  hello world")
[1] TRUE
> 
> try(diffobj:::trimws2("  hello world  ", 'banana')) # "is wrong"
Error in diffobj:::trimws2("  hello world  ", "banana") : 
  Argument which is wrong
> 
> # - string ---------------------------------------------------------------------
> 
> try(diffobj:::substr2("hello world", 1, 1:2)) # "same length"
Error in diffobj:::substr2("hello world", 1, 1:2) : 
  `start` and `stop` must be length 1 or the same length as `x`.
> 
> # - Gutters --------------------------------------------------------------------
> 
> etc <- new("Settings")
> etc@style <- StyleRaw()
> etc@style@funs@gutter <- function(x) stop("bad gutters")
> try(diffobj:::gutter_dat(etc)) # "Failed attempting to apply gutter."
Error in funs@gutter(paste0(gutt.dat.format, funs@gutter.pad(text@gutter.pad))) : 
  bad gutters
Error in diffobj:::gutter_dat(etc) : 
  Failed attempting to apply gutter formatting functions; if you did not customize them, contact maintainer.  See `?StyleFuns`.
> 
> # - Finalizer error handling ---------------------------------------------------
> 
> try(finalizeHtml(letters, NULL)) # "must be character"
Error in .local(x, ...) : Argument `x.chr` must be character
> try(finalizeHtml(letters, letters, letters)) # "must be character\\(1L"
Error in .local(x, ...) : Argument `js` must be character(1L) and not NA.
> 
> # - c.factor -------------------------------------------------------------------
> 
> all.equal(diffobj:::c.factor(), factor(character()))
[1] TRUE
> 
> # - strip_hz -------------------------------------------------------------------
> 
> # Can't trigger this directly because wrapper doesn't let this case through
> diffobj:::strip_hz_c_int(character(), 8L, TRUE)
character(0)
> 
> 
> 
> proc.time()
   user  system elapsed 
   0.56    0.15    0.68