Nothing
test_that("session_diff", {
lines1 <- readLines(test_path("fixtures", "lines1.txt"))
lines2 <- readLines(test_path("fixtures", "lines2.txt"))
sd <- session_diff(lines1, lines2)
expect_equal(sd$old$si, lines1)
expect_equal(sd$old$arg, lines1)
expect_equal(sd$old$text, lines1)
expect_equal(sd$new$si, lines2)
expect_equal(sd$new$arg, lines2)
expect_equal(sd$new$text, lines2)
sd$old$si <- sd$old$arg <- sd$old$text <- NULL
sd$new$si <- sd$new$arg <- sd$new$text <- NULL
expect_snapshot(class(sd))
expect_snapshot(unclass(sd))
})
test_that("format.session_diff", {
# tested via print
expect_true(TRUE)
})
test_that("print.session_diff", {
lines1 <- readLines(test_path("fixtures", "lines1.txt"))
lines2 <- readLines(test_path("fixtures", "lines2.txt"))
expect_snapshot(print(session_diff(lines1, lines2)))
})
test_that("get_session_info 1", {
arg <- NULL
abort <- function(...) stop("test failure")
mockery::stub(get_session_info, "get_session_info_local", abort)
mockery::stub(get_session_info, "get_session_info_clipboard", abort)
mockery::stub(get_session_info, "get_session_info_url", abort)
mockery::stub(get_session_info, "get_session_info_literal", abort)
mockery::stub(
get_session_info,
"get_session_info_local",
function(...) arg <<- list(...)
)
get_session_info("local", pkgs = "foo")
expect_equal(arg, list(pkgs = "foo"))
arg <- NULL
mockery::stub(get_session_info, "get_session_info_local", abort)
mockery::stub(
get_session_info,
"get_session_info_clipboard",
function(...) arg <<- list(...)
)
get_session_info("clipboard", pkgs = "foo")
expect_equal(arg, list())
arg <- NULL
mockery::stub(get_session_info, "get_session_info_clipboard", abort)
mockery::stub(
get_session_info,
"get_session_info_url",
function(...) arg <<- list(...)
)
get_session_info("https://acme.com", pkgs = "foo")
expect_equal(arg, list("https://acme.com"))
arg <- NULL
mockery::stub(get_session_info, "get_session_info_url", abort)
mockery::stub(
get_session_info,
"get_session_info_literal",
function(...) arg <<- list(...)
)
get_session_info(c("foo", "bar"), pkgs = "foo")
expect_equal(arg, list(c("foo", "bar")))
})
test_that("get_session_info_local", {
expect_equal(
get_session_info_local()$text,
format(session_info())
)
})
test_that("get_session_info_clipboard", {
lines <- readLines(test_path("fixtures", "lines1.txt"))
mockery::stub(get_session_info_clipboard, "clipboard_read", lines)
clp <- get_session_info_clipboard()
expect_equal(clp$arg, "<clipboard>")
expect_equal(
clp$text,
get_session_info_literal(lines)$text
)
mockery::stub(get_session_info_clipboard, "clipboard_read", "clipboard")
expect_equal(get_session_info_clipboard()$text, "clipboard")
})
test_that("get_session_info_url", {
html <- readLines(
gz <- gzfile(test_path("fixtures", "gh.html.gz")),
encoding = "UTF-8"
)
close(gz)
mockery::stub(
get_session_info_url,
"utils::download.file",
function(url, destfile, ...) {
writeLines(html, destfile)
}
)
url <- "https://github.com/r-lib/sessioninfo/issues/6"
expect_equal(
get_session_info_url(url),
find_session_info_in_html(url, html)
)
})
test_that("find_session_info_in_html", {
# We skip this on old R, because it does not calculate the width
# of the emojis properly, and that messes up the output of the
# character vector of lines. We also cannot compare the UTF-8 text
# on Windows.
if (getRversion() < "4.0") skip("Needs R 4.0 at least")
skip_on_os("windows")
html <- readLines(
gz <- gzfile(test_path("fixtures", "gh.html.gz")),
encoding = "UTF-8"
)
close(gz)
url <- "https://github.com/r-lib/sessioninfo/issues/6"
expect_snapshot(
find_session_info_in_html(url, html)$text
)
url2 <- paste0(url, "#issuecomment-937782988")
expect_snapshot(
find_session_info_in_html(url2, html)$text
)
url3 <- paste0(url, "#dfgdfgdfgdfgdfgdfg")
expect_equal(
find_session_info_in_html(url, html)$text,
find_session_info_in_html(url3, html)$text
)
html <- html[
!grepl("^(#>)?[ ]*\\[[0-9]\\] ", html) &
!grepl("^(#>)?[ ]*[-\u2500]+$", html)
]
expect_error(
find_session_info_in_html(url, html),
"Cannot parse session info"
)
re_start <- "[-=\u2500\u2550][ ]Session info[ ]"
html <- html[!grepl(re_start, html)]
expect_error(
find_session_info_in_html(url, html),
"Cannot find session info"
)
})
test_that("parse_url", {
expect_snapshot(parse_url(
"https://github.com/r-lib/sessioninfo/issues/6"
))
expect_snapshot(parse_url(
"https://github.com/r-lib/sessioninfo/issues/6#issuecomment-937772467"
))
})
test_that("get_session_info_literal", {
si <- session_info()
expect_equal(
get_session_info_literal(si),
list(arg = si, si = si, text = format(si))
)
lines <- format(si)
expect_equal(
get_session_info_literal(lines),
list(arg = lines, si = lines, text = lines)
)
col <- paste0("\033[31m", lines, "\033[39m")
expect_equal(
get_session_info_literal(col),
list(arg = col, si = col, text = lines)
)
str <- paste0(lines, collapse = "\n")
expect_equal(
get_session_info_literal(str),
list(arg = str, si = str, text = lines)
)
ktr <- paste0("#> ", lines)
expect_equal(
get_session_info_literal(ktr),
list(arg = ktr, si = ktr, text = lines)
)
ktr2 <- paste0("#> ", lines)
expect_equal(
get_session_info_literal(ktr2),
list(arg = ktr2, si = ktr2, text = lines)
)
expect_error(
get_session_info_literal(structure(1, class = "foo")),
"Could not interpret"
)
})
test_that("strsplitx", {
expect_equal(strsplitx("", "\n"), list(""))
})
test_that("check_session_info", {
expect_warning(
check_session_info("foo"),
"This does not look like"
)
expect_silent(check_session_info("- Session info"))
expect_silent(check_session_info("= Session info"))
expect_silent(check_session_info("\u2500 Session info"))
expect_silent(check_session_info("\u2550 Session info"))
})
test_that("beginning", {
expect_snapshot(beginning("foo\nbar\nfoobar\nnotthis"))
expect_snapshot(beginning(c("foo", "bar", "foobar", "notthis")))
expect_snapshot(beginning(strrep("123456789 ", 20)))
})
test_that("session_diff_text", {
x <- c("", " ", " date 2020-01-01", "foo", "bar", " ", "")
y <- c(" date 2010-01-01", "foo", "baz", "")
expect_snapshot(print(session_diff_text(x, y)))
# if matching packages fails, we still have meaningful output
mockery::stub(session_diff_text, "expand_diff_text", function(...) stop())
expect_snapshot(print(session_diff_text(x, y)))
})
test_that("diff_drop_empty", {
cases <- list(
list(character(), character()),
list("foo", "foo"),
list(c("", "foo"), "foo"),
list(c(" ", "", "foo"), "foo"),
list(c("", "foo", ""), "foo"),
list(c(" ", "", "foo", "", " "), "foo"),
list(c("foo", "", " "), "foo")
)
for (c in cases) {
expect_equal(diff_drop_empty(c[[1]]), c[[2]], info = c[[1]])
}
})
test_that("diff_no_date", {
x <- c("foo", "date 2000-01-01", "date 2000-01-01")
expect_equal(diff_no_date(x), x[-2])
x2 <- c("foo", " date 2000-01-01", "date 2000-01-01")
expect_equal(diff_no_date(x2), x2[-2])
x3 <- c("foo", "bar")
expect_equal(diff_no_date(x3), x3)
})
test_that("diff_min_line", {
x <- c("= 3456 ============", "- 345678 -----------", strrep("x", 1000))
x2 <- gsub("=", "\u2550", gsub("-", "\u2500", x))
expect_equal(diff_min_line(x), 19)
expect_equal(diff_min_line(x2), 19)
expect_equal(diff_min_line(strrep("-", 100)), 80)
})
test_that("diff_fix_lines", {
x <- c("= 3456 ============", "foo", "- 345678 ----------", "bar")
x2 <- gsub("=", "\u2550", gsub("-", "\u2500", x))
exp <- c("= 3456 ===", "foo", "- 345678 -", "bar")
exp2 <- gsub("=", "\u2550", gsub("-", "\u2500", exp))
expect_equal(diff_fix_lines(x, 10), exp)
expect_equal(diff_fix_lines(x2, 10), exp)
withr::local_options(cli.unicode = TRUE)
expect_equal(diff_fix_lines(x, 10), exp2)
expect_equal(diff_fix_lines(x2, 10), exp2)
})
test_that("expand_diff_text", {
lines1 <- readLines(test_path("fixtures", "lines1.txt"))
lines2 <- readLines(test_path("fixtures", "lines2.txt"))
xp1 <- expand_diff_text(lines1, lines2)
expect_snapshot(xp1)
xp2 <- expand_diff_text(lines2, lines1)
expect_equal(xp1$old, xp2$new)
expect_equal(xp1$new, xp2$old)
expect_equal(
expand_diff_text(lines1, "foobar"),
list(old = lines1, new = "foobar")
)
})
test_that("insert_instead", {
cases <- list(
list(1:10, 1, 1, 11:15, c(11:15, 2:10)),
list(1:10, 1, 3, 11:15, c(11:15, 4:10)),
list(1:10, 2, 2, 11:15, c(1, 11:15, 3:10)),
list(1:10, 2, 5, 11:15, c(1, 11:15, 6:10)),
list(1:10, 5, 10, 11:15, c(1:4, 11:15)),
list(1:10, 10, 10, 11:15, c(1:9, 11:15)),
list(1:10, 1, 10, 11:15, c(11:15)),
list(1, 1, 1, 11:15, c(11:15)),
list(1:10, 0, 0, 11:15, c(11:15, 1:10)),
list(1:10, 11, 11, 11:15, c(1:10, 11:15)),
list(1:10, 2, 1, 11:15, c(1, 11:15, 2:10))
)
for (i in seq_along(cases)) {
c <- cases[[i]]
expect_equal(
insert_instead(c[[1]], c[[2]], c[[3]], c[[4]]),
c[[5]],
info = i
)
}
})
test_that("parse_pkgs", {
lines <- readLines(test_path("fixtures", "lines4.txt"))
pkgs <- parse_pkgs(lines)
expect_equal(pkgs$begin, 17)
expect_equal(pkgs$end, 40)
expect_snapshot(names(pkgs$pkgs))
expect_snapshot(pkgs$pkgs[["!"]])
expect_snapshot(pkgs$pkgs$package)
expect_snapshot(pkgs$pkgs)
pkgs2 <- parse_pkgs(lines[1:40])
expect_equal(pkgs, pkgs2)
expect_null(parse_pkgs("foobar"))
})
test_that("parse_pkgs_section", {
lines <- readLines(test_path("fixtures", "lines3.txt"))
pkgs <- parse_pkgs_section(lines)
expect_snapshot(names(pkgs))
expect_snapshot(pkgs[["!"]])
expect_snapshot(pkgs$package)
expect_snapshot(pkgs)
lines2 <- c(
" package * version date (UTC) lib source",
" cli 3.0.1.9000 2021-10-11 [1] local",
" crayon 1.4.1 2021-02-08 [1] CRAN (R 4.1.0)",
" prettycode 1.1.0 2019-12-16 [1] CRAN (R 4.1.0)",
" prompt 1.0.0 2021-03-02 [1] local",
" ps 1.6.0 2021-02-28 [1] CRAN (R 4.1.0)",
" sessioninfo 1.1.1.9000 2021-10-12 [1] local",
" withr 2.4.2 2021-04-18 [1] CRAN (R 4.1.0)"
)
pkgs2 <- parse_pkgs_section(lines2)
expect_snapshot(names(pkgs2))
expect_snapshot(pkgs2[["!"]])
expect_snapshot(pkgs2$package)
expect_snapshot(pkgs2)
})
test_that("find_word_lengths", {
cases <- list(
list("", numeric()),
list(" ", numeric()),
list(" ", numeric()),
list("x", 2),
list(" x", 3),
list(" x ", 4),
list("foo bar", c(4, 4)),
list("foo bar", c(7, 4)),
list(" foo", 5),
list(" foo bar", c(8, 4))
)
for (c in cases) {
expect_equal(find_word_lengths(c[[1]]), c[[2]], info = c[[1]])
}
})
test_that("get_symbol_name", {
expect_equal(get_symbol_name(as.symbol("x")), "x")
expect_equal(get_symbol_name("x"), "x")
expect_null(get_symbol_name(call("foo", "bar")))
})
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.