Nothing
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)
) )
}
# 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))
all.equal(diffobj:::rle_sub(r, r$values == 2L), list(4:5, 14:15))
isTRUE(all(x[unlist(diffobj:::rle_sub(r, r$values == 1L))] == 1))
isTRUE(all(x[unlist(diffobj:::rle_sub(r, r$values == 2L))] == 2))
isTRUE(all(x[unlist(diffobj:::rle_sub(r, r$values == 3L))] == 3))
# - 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))
diffobj:::extract_call(calls, new.env()) # warn: "Unable to find")
# 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)
)
# 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)
Sys.setenv(LINES="-25")
all.equal(console_lines(), 48L)
Sys.unsetenv("LINES")
all.equal(console_lines(), 48L)
# - get_funs -------------------------------------------------------------------
identical(
diffobj:::get_fun(quote(diffobj::diffPrint), .BaseNamespaceEnv),
diffobj::diffPrint
)
identical(
diffobj:::get_fun(quote(diffobj:::diffPrint), .BaseNamespaceEnv),
diffobj::diffPrint
)
identical(
diffobj:::get_fun(quote(diffPrint), getNamespace("diffobj")),
diffobj::diffPrint
)
gf <- diffobj:::get_fun(quote(notAFunction), getNamespace("diffobj")) # warn
identical(gf, NULL)
# - trimws2 --------------------------------------------------------------------
all.equal(diffobj:::trimws2("hello world"), "hello world")
all.equal(diffobj:::trimws2(" hello world"), "hello world")
all.equal(diffobj:::trimws2(" hello world "), "hello world")
all.equal(diffobj:::trimws2(" hello world ", 'left'), "hello world ")
all.equal(diffobj:::trimws2(" hello world ", 'right'), " hello world")
try(diffobj:::trimws2(" hello world ", 'banana')) # "is wrong"
# - string ---------------------------------------------------------------------
try(diffobj:::substr2("hello world", 1, 1:2)) # "same length"
# - 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."
# - Finalizer error handling ---------------------------------------------------
try(finalizeHtml(letters, NULL)) # "must be character"
try(finalizeHtml(letters, letters, letters)) # "must be character\\(1L"
# - c.factor -------------------------------------------------------------------
all.equal(diffobj:::c.factor(), factor(character()))
# - strip_hz -------------------------------------------------------------------
# Can't trigger this directly because wrapper doesn't let this case through
diffobj:::strip_hz_c_int(character(), 8L, TRUE)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.