pkgdown/ 0000755 0001762 0000144 00000000000 14672377072 011742 5 ustar ligges users pkgdown/tests/ 0000755 0001762 0000144 00000000000 14672347601 013077 5 ustar ligges users pkgdown/tests/testthat/ 0000755 0001762 0000144 00000000000 14672377072 014744 5 ustar ligges users pkgdown/tests/testthat/test-highlight.R 0000644 0001762 0000144 00000003506 14642014746 020010 0 ustar ligges users test_that("highlight_examples captures dependencies", {
withr::defer(try(file_delete(test_path("Rplot001.png")), TRUE))
dummy_dep <- htmltools::htmlDependency("dummy", "1.0.0", "dummy.js")
widget <- htmlwidgets::createWidget("test", list(), dependencies = dummy_dep)
out <- highlight_examples("widget", env = environment())
# htmlwidgets always get dependency on htmlwidgets.js
expect_equal(attr(out, "dependencies")[-1], list(dummy_dep))
})
test_that("highlight_examples runs and hides DONTSHOW calls()", {
out <- highlight_examples("DONTSHOW(x <- 1)\nx")
expect_snapshot(cat(strip_html_tags(out)))
})
test_that("highlight_text & highlight_examples include sourceCode div", {
withr::defer(try(file_delete(test_path("Rplot001.png")), TRUE))
html <- xml2::read_html(highlight_examples("a + a", "x"))
expect_equal(xpath_attr(html, "./body/div", "class"), "sourceCode")
html <- xml2::read_html(highlight_text("a + a"))
expect_equal(xpath_attr(html, "./body/div", "class"), "sourceCode")
})
test_that("pre() can produce needed range of outputs", {
expect_snapshot({
cat(pre("x"))
cat(pre("x", r_code = TRUE))
})
})
test_that("tweak_highlight_other() renders generic code blocks for roxygen2 >= 7.2.0", {
html <- xml2::read_html('
')
div <- xml2::xml_find_first(html, "//div")
tweak_highlight_other(div)
expect_equal(xpath_text(div, "pre/code"), "1+1")
})
test_that("tweak_highlight_other() renders nested code blocks for roxygen2 >= 7.2.0", {
html <- xml2::read_html(dedent("
blablabla
```{r results='asis'}
lalala
```
"))
div <- xml2::xml_find_first(html, "//div")
tweak_highlight_other(div)
expect_snapshot(cat(xpath_text(div, "pre/code")))
})
pkgdown/tests/testthat/test-tweak-tags.R 0000644 0001762 0000144 00000017744 14633374223 020120 0 ustar ligges users # tables -------------------------------------------------------------
test_that("tables get additional table class", {
html <- xml2::read_html("
")
tweak_tables(html)
expect_equal(
xpath_attr(html, ".//table", "class"),
c("table", "table a", "table b")
)
})
test_that("except in the argument list", {
html <- xml2::read_html("
")
tweak_tables(html)
expect_equal(xpath_attr(html, ".//table", "class"), "ref-arguments")
})
# anchors -------------------------------------------------------------
test_that("ids move from div to headings", {
html <- xml2::read_xml('
abc
abc
abc
abc
abc
abc
')
tweak_anchors(html)
expect_equal(xpath_attr(html, ".//h1|//h2|//h3|//h4|//h5|//h6", "id"), as.character(1:6))
expect_equal(xpath_attr(html, ".//div", "id"), rep(NA_character_, 6))
})
test_that("must be in div with section an class and id", {
html <- xml2::read_xml('
abc
abc
abc
')
tweak_anchors(html)
expect_equal(xpath_attr(html, ".//h1", "id"), rep(NA_character_, 3))
})
test_that("anchor html added to headings", {
html <- xml2::read_xml('
abc
')
tweak_anchors(html)
expect_snapshot_output(xpath_xml(html, ".//h1"))
})
test_that("deduplicates ids", {
html <- xml2::read_xml('
abc
abc
abc
')
tweak_anchors(html)
expect_equal(xpath_attr(html, ".//h1", "id"), c("x", "x-1", "x-2"))
})
test_that("can process multiple header levels", {
html <- xml2::read_xml('
abc
abc
abc
abc
')
tweak_anchors(html)
expect_equal(xpath_attr(html, ".//a", "href"), c("#1", "#2", "#3", "#4"))
})
test_that("can handle multiple header", {
html <- xml2::read_xml('
one two
')
tweak_anchors(html)
expect_equal(xpath_attr(html, ".//div", "id"), NA_character_)
expect_equal(xpath_attr(html, ".//h1", "id"), c("x", "x-1"))
expect_equal(xpath_attr(html, ".//h1/a", "href"), c("#x", "#x-1"))
})
test_that("anchors don't get additional newline", {
html <- xml2::read_xml('
abc
')
tweak_anchors(html)
expect_equal(xpath_text(html, ".//h1"), "abc")
})
test_that("empty headings are skipped", {
html <- xml2::read_xml('
')
tweak_anchors(html)
expect_equal(xpath_length(html, ".//h1/a"), 0)
})
test_that("docs with no headings are left unchanged", {
html <- xml2::read_xml('Nothing
')
tweak_anchors(html)
expect_equal(as.character(xpath_xml(html, ".")), 'Nothing
')
})
# links -----------------------------------------------------------------
test_that("local md links are replaced with html", {
html <- xml2::read_html('
')
tweak_link_md(html)
expect_equal(
xpath_attr(html, "//a", "href"),
c("local.html", "local.html#fragment", "http://remote.com/remote.md")
)
})
test_that("tweak_link_external() add the external-link class if needed", {
html <- xml2::read_html('
')
pkg <- list(meta = list(url = "http://example.com"))
tweak_link_external(html, pkg = pkg)
expect_equal(
xpath_attr(html, "//a", "class"),
c(NA, "external-link", "external-link", "external-link thumbnail", NA)
)
})
test_that("tweak_link_absolute() fixes relative paths in common locations", {
html <- xml2::read_html('
')
pkg <- list(meta = list(url = "https://example.com"))
tweak_link_absolute(html, pkg)
expect_equal(xpath_attr(html, "//a", "href"), "https://example.com/a")
expect_equal(xpath_attr(html, "//link", "href"), "https://example.com/link")
expect_equal(xpath_attr(html, "//img", "src"), "https://example.com/img")
})
test_that("tweak_link_absolute() leaves absolute paths alone", {
html <- xml2::read_html(' ')
pkg <- list(list(url = "https://example.com"))
tweak_link_absolute(html, pkg)
expect_equal(xpath_attr(html, "//a", "href"), "https://a.com")
})
test_that("tweak_link_r6() correctly modifies link to inherited R6 classes", {
skip_on_cran() # in case downlit url changes
html <- xml2::read_html("
text
text
text
")
tweak_link_R6(html, "pkgdown")
expect_equal(
xpath_attr(html, "//a", "href"),
c(
"Animal.html#method-x",
"leave-me.html",
"https://downlit.r-lib.org/reference/autolink.html#method-x"
)
)
})
test_that("tweak_img_src() updates img and source tags", {
html <- xml2::read_html('
')
tweak_img_src(html)
expect_equal(xpath_attr(html, ".//img", "src"), "reference/figures/bar.png")
expect_equal(xpath_attr(html, ".//source", "srcset"), "reference/figures/foo.png")
})
test_that("tweak_img_src() doesn't modify absolute links", {
html <- xml2::read_html('
')
urls_before <- xpath_attr(html, ".//img", "src")
tweak_img_src(html)
expect_equal(
xpath_attr(html, ".//img", "src"),
urls_before
)
})
# stripped divs etc -------------------------------------------------------
test_that("selectively remove hide- divs", {
html <- xml2::read_xml("
devel
release
all
")
tweak_strip(html, in_dev = TRUE)
expect_equal(xpath_text(html, ".//div"), "devel")
html <- xml2::read_xml("
devel
release
all
")
tweak_strip(html, in_dev = FALSE)
expect_equal(xpath_text(html, ".//div"), "release")
})
# footnotes ---------------------------------------------------------------
test_that("can process footnote with code", {
skip_if_no_pandoc("2.17.1")
pkg <- local_pkgdown_site()
html <- markdown_to_html(pkg, "
Hooray[^1]
[^1]: Including code:
```
1 +
2 +
```
And more text
")
tweak_footnotes(html)
expect_equal(xpath_length(html, "//a[@class='footnote-back']"), 0)
expect_equal(xpath_attr(html, ".//a", "class"), "footnote-ref")
expect_equal(xpath_attr(html, ".//a", "tabindex"), "0")
expect_snapshot(xpath_attr(html, ".//a", "data-bs-content"))
})
pkgdown/tests/testthat/test-utils.R 0000644 0001762 0000144 00000001205 14634573316 017177 0 ustar ligges users test_that("pkgdown.internet can be set and read", {
options(pkgdown.internet = FALSE)
expect_false(has_internet())
})
test_that("is_internal_link() works", {
pkg=list(meta=list(url="https://pkgdown.r-lib.org"))
expect_false(is_internal_link("https://github.com", pkg = pkg))
expect_false(is_internal_link("http://github.com", pkg = pkg))
expect_true(is_internal_link("https://pkgdown.r-lib.org/articles", pkg = pkg))
expect_true(is_internal_link("reference/index.html", pkg = pkg))
expect_true(
all.equal(
is_internal_link(c("reference/index.html", "https://github.com"), pkg = pkg),
c(TRUE, FALSE)
)
)
})
pkgdown/tests/testthat/test-topics-external.R 0000644 0001762 0000144 00000000563 14633374223 021161 0 ustar ligges users test_that("can get info about external function", {
expect_snapshot(str(ext_topics("base::mean")))
# and column names match
pkg <- as_pkgdown(test_path("assets/reference"))
expect_equal(names(ext_topics("base::mean")), names(pkg$topics))
})
test_that("fails if documentation not available", {
expect_snapshot(ext_topics("base::doesntexist"), error = TRUE)
})
pkgdown/tests/testthat/test-preview.R 0000644 0001762 0000144 00000001110 14634573316 017513 0 ustar ligges users test_that("checks its inputs", {
pkg <- local_pkgdown_site()
expect_snapshot(error = TRUE, {
preview_site(pkg, path = 1)
preview_site(pkg, path = "foo")
preview_site(pkg, preview = 1)
})
})
test_that("local_path adds index.html if needed", {
pkg <- local_pkgdown_site()
file_create(path(pkg$dst_path, "test.html"))
expect_equal(
local_path(pkg, "test.html"),
path(pkg$dst_path, "test.html")
)
dir_create(path(pkg$dst_path, "reference"))
expect_equal(
local_path(pkg, "reference"),
path(pkg$dst_path, "reference", "index.html")
)
})
pkgdown/tests/testthat/test-tweak-homepage.R 0000644 0001762 0000144 00000007371 14633374223 020742 0 ustar ligges users test_that("first header is wrapped in page-header div", {
html <- xml2::read_html('
First
Second
')
tweak_homepage_html(html)
expect_equal(xpath_attr(html, ".//div", "class"), "page-header")
})
test_that("removes dummy page-header", {
html <- xml2::read_html('
Header
')
tweak_homepage_html(html)
expect_equal(xpath_text(html, ".//h1"), "Header")
})
test_that("can remove first header", {
html <- xml2::read_html('
First
Second
')
tweak_homepage_html(html, strip_header = TRUE)
expect_equal(xpath_length(html, ".//div"), 0)
})
test_that("can remove logo", {
# Without link
html <- xml2::read_html('
First
')
tweak_homepage_html(html, bs_version = 5, logo = "mylogo.png")
expect_snapshot(xpath_xml(html, ".//div"))
# With link
html <- xml2::read_html('
First
')
tweak_homepage_html(html, bs_version = 5, logo = "mylogo.png")
expect_snapshot(xpath_xml(html, ".//div"))
})
# badges -------------------------------------------------------------------
test_that("can move badges to sidebar", {
html <- xml2::read_html('
Title
')
tweak_sidebar_html(html)
expect_snapshot(xpath_xml(html, ".//div"))
})
test_that("remove badges even if no dev-status div", {
html <- xml2::read_html('
Title
')
tweak_sidebar_html(html)
expect_snapshot(html)
})
test_that("remove dev-status & badges if badges suppress", {
html <- xml2::read_html('
Title
')
tweak_sidebar_html(html, show_badges = FALSE)
expect_equal(xpath_length(html, "//div"), 0)
})
test_that("doesn't find badges when they don't exist", {
expect_equal(badges_extract_text(" "), character())
expect_equal(badges_extract_text("
"), character())
# first paragraph contains non-image components
expect_equal(
badges_extract_text(' Hi!
'),
character()
)
})
test_that("finds single badge", {
expect_equal(
badges_extract_text('
'),
' '
)
})
test_that("finds badges in #badges div", {
expect_equal(
badges_extract_text('
'),
' '
)
# even if there's extra text
expect_equal(
badges_extract_text('
Hi!
'),
' '
)
})
test_that("can find badges in comments", {
html <- '
blop
I am the first paragraph!
'
expect_equal(badges_extract_text(html), ' ')
# produced by usethis
html <- '
blop
I am the first paragraph!
'
expect_equal(badges_extract_text(html), ' ')
})
test_that("ignores extraneous content", {
html <- '
blop
I am the first paragraph!
a
B
'
expect_equal(badges_extract_text(html), ' ')
})
pkgdown/tests/testthat/test-build.R 0000644 0001762 0000144 00000000212 14633374223 017126 0 ustar ligges users test_that("both versions of build_site have same arguments", {
expect_equal(formals(build_site_local), formals(build_site_external))
})
pkgdown/tests/testthat/test-rd-example.R 0000644 0001762 0000144 00000005710 14634573316 020102 0 ustar ligges users # run_examples() -----------------------------------------------------------
test_that("warns if unparseable", {
expect_warning(
run_examples("1 + \\dontrun{2 + }"),
"Failed to parse"
)
})
# as_example() ------------------------------------------------------------
test_that("dontrun{} wrapped in if(FALSE)", {
expect_equal(rd2ex("\\dontrun{1}"), "if (FALSE) 1 # \\dontrun{}")
expect_equal(
rd2ex("\\dontrun{\n 1\n}"),
c("if (FALSE) { # \\dontrun{", " 1", "} # }")
)
# unless run_dont_run is true
expect_equal(rd2ex("\\dontrun{1}", run_dont_run = TRUE), "1")
expect_equal(
rd2ex("\\dontrun{\n 1\n}", run_dont_run = TRUE),
c("# \\dontrun{", " 1", "# }")
)
})
test_that("block donttest{} gets a comment to preserve spacing", {
expect_equal(rd2ex("\\donttest{1}"), "1")
expect_equal(
rd2ex("\\donttest{\n 1\n}"),
c("# \\donttest{", " 1", "# }")
)
})
test_that("dontshow{} becomes DONTSHOW", {
expect_equal(rd2ex("\\dontshow{1}"), "DONTSHOW({1})")
expect_equal(rd2ex("\\dontshow{\n 1\n}"), c("DONTSHOW({", " 1", "})"))
})
test_that("testonly{} becomes TESTONLY", {
expect_equal(rd2ex("\\testonly{1}"), "TESTONLY({1})")
expect_equal(rd2ex("\\testonly{\n 1\n}"), c("TESTONLY({", " 1", "})"))
})
test_that("handles nested tags", {
expect_equal(
rd2ex("if(TRUE {\n \\dontrun{\n 1 + 2\n }\n}"),
c(
"if(TRUE {",
" if (FALSE) { # \\dontrun{",
" 1 + 2",
" } # }",
"}"
)
)
})
test_that("translate dots and ldots to ...", {
expect_equal(rd2ex("\\ldots"), "...")
expect_equal(rd2ex("\\dots"), "...")
})
test_that("ignores out", {
expect_equal(rd2ex("\\out{1 + 2}"), "1 + 2")
})
test_that("extracts conditions from if", {
expect_equal(rd2ex("\\if{html}{1 + 2}"), "1 + 2")
expect_equal(rd2ex("\\if{latex}{1 + 2}"), "")
expect_equal(rd2ex("\\ifelse{html}{1 + 2}{3 + 4}"), "1 + 2")
expect_equal(rd2ex("\\ifelse{latex}{1 + 2}{3 + 4}"), "3 + 4")
})
test_that("@examplesIf", {
rd <- paste0(
"\\dontshow{if (1 == 0) (if (getRversion() >= \"3.4\") withAutoprint else force)(\\{ # examplesIf}\n",
"answer <- 43\n",
"\\dontshow{\\}) # examplesIf}"
)
exp <- c(
"if (FALSE) { # 1 == 0",
"answer <- 43",
"}"
)
expect_warning(
expect_equal(rd2ex(rd), exp),
"@examplesIf condition"
)
rd2 <- paste0(
"\\dontshow{if (TRUE) (if (getRversion() >= \"3.4\") withAutoprint else force)(\\{ # examplesIf}\n",
"answer <- 43\n",
"\\dontshow{\\}) # examplesIf}"
)
exp2 <- c(
"answer <- 43"
)
expect_equal(rd2ex(rd2), exp2)
cnd <- paste0(strrep("TRUE && ", 100), "FALSE")
rd3 <- paste0(
"\\dontshow{if (", cnd, ") (if (getRversion() >= \"3.4\") withAutoprint else force)(\\{ # examplesIf}\n",
"answer <- 43\n",
"\\dontshow{\\}) # examplesIf}"
)
exp3 <- c(
paste0("if (FALSE) { # ", cnd),
"answer <- 43",
"}"
)
expect_snapshot(
expect_equal(strtrim(rd2ex(rd3), 40), strtrim(exp3, 40))
)
})
pkgdown/tests/testthat/test-usage.R 0000644 0001762 0000144 00000014213 14653152407 017141 0 ustar ligges users
# Reference --------------------------------------------------------------------
test_that("usage escapes special characters", {
# parseable
expect_equal(usage2text("# <"), "# <")
#unparseable
expect_equal(usage2text("<"), "<")
})
test_that("usage re-renders non-syntactic calls", {
expect_equal(usage2text("`<`(x, y)"), "x < y")
expect_equal(usage2text("`[`(x, y)"), "x[y]")
})
test_that("usage doesn't re-renders syntactic calls", {
expect_equal(usage2text("foo(x , y) # hi"), "foo(x , y) # hi")
multi_line <- "foo(\n x # x,\n y = 1 # y,\n)"
expect_equal(usage2text(multi_line), multi_line)
})
test_that("usage generates user facing code for S3/S4 infix/replacement methods", {
expect_snapshot({
cat(usage2text("\\S3method{$}{indexed_frame}(x, name)"))
cat(usage2text("\\method{[[}{indexed_frame}(x, i) <- value"))
cat(usage2text("\\S4method{>=}{MyType,numeric}(e1, e2)"))
})
})
test_that("S4 methods gets comment", {
out <- rd2html("\\S4method{fun}{class}(x, y)")
expect_equal(out[1], "# S4 method for class 'class'")
expect_equal(out[2], "fun(x, y)")
})
test_that("S3 methods gets comment", {
out <- rd2html("\\S3method{fun}{class}(x, y)")
expect_equal(out[1], "# S3 method for class 'class'")
expect_equal(out[2], "fun(x, y)")
out <- rd2html("\\method{fun}{class}(x, y)")
expect_equal(out[1], "# S3 method for class 'class'")
expect_equal(out[2], "fun(x, y)")
})
test_that("Methods for class function work", {
out <- rd2html("\\S3method{fun}{function}(x, y)")
expect_equal(out[1], "# S3 method for class 'function'")
expect_equal(out[2], "fun(x, y)")
out <- rd2html("\\method{fun}{function}(x, y)")
expect_equal(out[1], "# S3 method for class 'function'")
expect_equal(out[2], "fun(x, y)")
out <- rd2html("\\S4method{fun}{function,function}(x, y)")
expect_equal(out[1], "# S4 method for class 'function,function'")
expect_equal(out[2], "fun(x, y)")
})
test_that("default methods get custom text", {
out <- rd2html("\\S3method{fun}{default}(x, y)")
expect_equal(out[1], "# Default S3 method")
out <- rd2html("\\S4method{fun}{default}(x, y)")
expect_equal(out[1], "# Default S4 method")
})
test_that("non-syntactic functions get backquoted, not escaped", {
out <- rd2html("\\S3method{<}{foo}(x, y)")
expect_equal(out[[2]], "`<`(x, y)")
out <- rd2html("\\S4method{bar<-}{foo}(x, y)")
expect_equal(out[[2]], "`bar<-`(x, y)")
})
# Reference index --------------------------------------------------------------
test_that("can parse data", {
usage <- parse_usage("f")[[1]]
expect_equal(usage, list(type = "data", name = "f"))
usage <- parse_usage("data(f)")[[1]]
expect_equal(usage, list(type = "data", name = "f"))
})
test_that("can parse function/methods", {
usage <- parse_usage("f(x)")[[1]]
expect_equal(usage$type, "fun")
expect_equal(usage$name, "f")
usage <- parse_usage("\\method{f}{bar}(x)")[[1]]
expect_equal(usage$type, "s3")
expect_equal(usage$name, "f")
expect_equal(usage$signature, "bar")
usage <- parse_usage("\\S3method{f}{bar}(x)")[[1]]
expect_equal(usage$type, "s3")
expect_equal(usage$name, "f")
expect_equal(usage$signature, "bar")
usage <- parse_usage("\\S3method{f}{`foo bar`}(x)")[[1]]
expect_equal(usage$type, "s3")
expect_equal(usage$name, "f")
expect_equal(usage$signature, "foo bar")
usage <- parse_usage("\\S4method{f}{bar,baz}(x)")[[1]]
expect_equal(usage$type, "s4")
expect_equal(usage$name, "f")
expect_equal(usage$signature, c("bar", "baz"))
usage <- parse_usage("\\S4method{f}{NULL}(x)")[[1]]
expect_equal(usage$type, "s4")
expect_equal(usage$name, "f")
expect_equal(usage$signature, c("NULL"))
usage <- parse_usage("\\S4method{f}{function,function}(x, y)")[[1]]
expect_equal(usage$type, "s4")
expect_equal(usage$name, "f")
expect_equal(usage$signature, c("function", "function"))
usage <- parse_usage("\\S4method{f}{function,foo bar}(x, y)")[[1]]
expect_equal(usage$type, "s4")
expect_equal(usage$name, "f")
expect_equal(usage$signature, c("function", "foo bar"))
usage <- parse_usage("pkg::func()")[[1]]
expect_equal(usage$type, "fun")
expect_equal(usage$name, "func")
usage <- parse_usage("pkg:::func()")[[1]]
expect_equal(usage$type, "fun")
expect_equal(usage$name, "func")
})
test_that("can parse replacement functions", {
usage <- parse_usage("f() <- value")[[1]]
expect_true(usage$replacement)
expect_equal(usage$name, "f<-")
usage <- parse_usage("\\S3method{f}{bar}(x) <- value")[[1]]
expect_true(usage$replacement)
expect_equal(usage$name, "f<-")
usage <- parse_usage("\\S4method{f}{bar,baz}(x) <- value")[[1]]
expect_true(usage$replacement)
expect_equal(usage$name, "f<-")
})
test_that("can parse infix functions", {
usage <- parse_usage("x \\%f\\% y")[[1]]
expect_true(usage$infix)
expect_equal(usage$name, "%f%")
usage <- parse_usage("\\S3method{[}{bar}(x)")[[1]]
expect_true(usage$infix)
expect_equal(usage$name, "[")
usage <- parse_usage("\\S4method{[}{bar,baz}(x)")[[1]]
expect_true(usage$infix)
expect_equal(usage$name, "[")
})
test_that("can parse infix replacement functions", {
usage <- parse_usage("\\S3method{[}{bar}(x) <- value")[[1]]
expect_true(usage$infix)
expect_true(usage$replacement)
expect_equal(usage$name, "[<-")
usage <- parse_usage("\\S4method{[}{bar,baz}(x) <- value")[[1]]
expect_true(usage$infix)
expect_true(usage$replacement)
expect_equal(usage$name, "[<-")
})
test_that("can parse multistatement usages", {
usage <- parse_usage("f()\n%This is a comment\ng(\n\n)")
expect_length(usage, 2)
expect_equal(usage[[1]]$name, "f")
expect_equal(usage[[2]]$name, "g")
})
test_that("can parse dots", {
usage <- parse_usage("f(\\dots)")[[1]]
expect_equal(usage$name, "f")
})
test_that("usage2text can parse symbols (#2727)", {
expect_no_error(usage2text("viridisLite::viridis(21)"))
})
# short_name --------------------------------------------------------------
test_that("infix functions left as", {
expect_equal(short_name("%||%", "fun"), "`%||%`")
})
test_that("function name and signature is escaped", {
expect_equal(short_name("%<%", "fun"), "`%<%`")
expect_equal(short_name("f", "S3", "<"), "f(<<> )")
})
pkgdown/tests/testthat/test-rd-html.R 0000644 0001762 0000144 00000030434 14671042466 017412 0 ustar ligges users test_that("special characters are escaped", {
out <- rd2html("a & b")
expect_equal(out, "a & b")
})
test_that("converts Rd unicode shortcuts", {
expect_snapshot(rd2html("``a -- b --- c''"))
})
test_that("simple tags translated to known good values", {
# Simple insertions
expect_equal(rd2html("\\ldots"), "...")
expect_equal(rd2html("\\dots"), "...")
expect_equal(rd2html("\\R"), "R ")
expect_equal(rd2html("\\cr"), " ")
"Macros"
expect_equal(rd2html("\\newcommand{\\f}{'f'} \\f{}"), "'f'")
expect_equal(rd2html("\\renewcommand{\\f}{'f'} \\f{}"), "'f'")
})
test_that("comments converted to html", {
expect_equal(rd2html("a\n%b\nc"), c("a", "", "c"))
})
test_that("simple wrappers work as expected", {
expect_equal(rd2html("\\strong{x}"), "x ")
expect_equal(rd2html("\\strong{\\emph{x}}"), "x ")
})
test_that("subsection generates h3", {
expect_snapshot(cli::cat_line(rd2html("\\subsection{A}{B}")))
})
test_that("subsection generates h3", {
expect_snapshot(cli::cat_line(rd2html("\\subsection{A}{
p1
p2
}")))
})
test_that("subsection generates generated anchor", {
text <- c("", rd2html("\\subsection{A}{B}"), "")
html <- xml2::read_xml(paste0(text, collapse = "\n"))
tweak_anchors(html)
expect_equal(xpath_attr(html, ".//h3", "id"), "a")
expect_equal(xpath_attr(html, ".//a", "href"), "#a")
})
test_that("nested subsection generates h4", {
expect_snapshot(cli::cat_line(rd2html("\\subsection{H3}{\\subsection{H4}{}}")))
})
test_that("if generates html", {
expect_equal(rd2html("\\if{html}{\\bold{a}}"), "a ")
expect_equal(rd2html("\\if{latex}{\\bold{a}}"), character())
})
test_that("ifelse generates html", {
expect_equal(rd2html("\\ifelse{html}{\\bold{a}}{x}"), "a ")
expect_equal(rd2html("\\ifelse{latex}{x}{\\bold{a}}"), "a ")
})
test_that("out is for raw html", {
expect_equal(rd2html("\\out{ }"), " ")
})
test_that("support platform specific code", {
os_specific <- function(command, os, output) {
rd2html(paste0(
"#", command, " ", os, "\n",
output, "\n",
"#endif"
))
}
expect_equal(os_specific("ifdef", "windows", "X"), character())
expect_equal(os_specific("ifdef", "unix", "X"), "X")
expect_equal(os_specific("ifndef", "windows", "X"), "X")
expect_equal(os_specific("ifndef", "unix", "X"), character())
})
# tables ------------------------------------------------------------------
test_that("tabular generates complete table html", {
table <- "\\tabular{ll}{a \\tab b \\cr}"
expectation <- c("")
expect_equal(rd2html(table), expectation)
})
test_that("internal \\crs are stripped", {
table <- "\\tabular{l}{a \\cr b \\cr c \\cr}"
expectation <- c("")
expect_equal(rd2html(table), expectation)
})
test_that("can convert single row", {
expect_equal(
rd2html("\\tabular{lll}{A \\tab B \\tab C \\cr}")[[2]],
"A B C "
)
})
test_that("don't need internal whitespace", {
expect_equal(
rd2html("\\tabular{lll}{\\tab\\tab C\\cr}")[[2]],
"C "
)
expect_equal(
rd2html("\\tabular{lll}{\\tab B \\tab\\cr}")[[2]],
"B "
)
expect_equal(
rd2html("\\tabular{lll}{A\\tab\\tab\\cr}")[[2]],
"A "
)
expect_equal(
rd2html("\\tabular{lll}{\\tab\\tab\\cr}")[[2]],
" "
)
})
test_that("can skip trailing \\cr", {
expect_equal(
rd2html("\\tabular{lll}{A \\tab B \\tab C}")[[2]],
"A B C "
)
})
test_that("code blocks in tables render (#978)", {
expect_equal(
rd2html('\\tabular{ll}{a \\tab \\code{b} \\cr foo \\tab bar}')[[2]],
"a b
"
)
})
test_that("tables with tailing \n (#978)", {
expect_equal(
rd2html('
\\tabular{ll}{
a \\tab \\cr
foo \\tab bar
}
')[[2]],
"a "
)
})
# sexpr ------------------------------------------------------------------
test_that("code inside Sexpr is evaluated", {
local_context_eval()
expect_equal(rd2html("\\Sexpr{1 + 2}"), "3")
})
test_that("can control \\Sexpr output", {
local_context_eval()
expect_equal(rd2html("\\Sexpr[results=hide]{1}"), character())
expect_equal(rd2html("\\Sexpr[results=text]{1}"), "1")
expect_equal(rd2html("\\Sexpr[results=rd]{\"\\\\\\emph{x}\"}"), "x ")
expect_equal(
rd2html("\\Sexpr[results=verbatim]{1 + 2}"),
c("", "[1] 3", " ")
)
expect_equal(
rd2html("\\Sexpr[results=verbatim]{cat(42)}"),
c("", "42", " ")
)
expect_equal(
rd2html("\\Sexpr[results=verbatim]{cat('42!\n'); 3}"),
c("", "42!", "[1] 3", " ")
)
})
test_that("Sexpr can contain multiple expressions", {
local_context_eval()
expect_equal(rd2html("\\Sexpr{a <- 1; a}"), "1")
})
test_that("Sexprs with multiple args are parsed", {
local_context_eval()
expect_equal(rd2html("\\Sexpr[results=hide,stage=build]{1}"), character())
})
test_that("Sexprs in file share environment", {
local_context_eval()
expect_equal(rd2html("\\Sexpr{x <- 1}\\Sexpr{x}"), c("1", "1"))
local_context_eval()
expect_error(rd2html("\\Sexpr{x}"), "not found")
})
test_that("Sexprs run from package root", {
local_context_eval(src_path = test_path("assets/reference"))
# \packageTitle is built in macro that uses DESCRIPTION
expect_equal(
rd2html("\\packageTitle{testpackage}"),
"A test package"
)
})
# links -------------------------------------------------------------------
test_that("simple links generate ", {
expect_equal(
rd2html("\\href{http://bar.com}{BAR}"),
" BAR "
)
expect_equal(
rd2html("\\email{foo@bar.com}"),
"foo@bar.com "
)
expect_equal(
rd2html("\\url{http://bar.com}"),
"http://bar.com "
)
})
test_that("can convert cross links to online documentation url", {
expect_equal(
rd2html("\\link[base]{library}"),
a("library", href = "https://rdrr.io/r/base/library.html")
)
})
test_that("can convert cross links to the same package (#242)", {
withr::local_options(list(
"downlit.package" = "test",
"downlit.topic_index" = c(x = "y", z = "z"),
"downlit.rdname" = "z"
))
expect_equal(rd2html("\\link{x}"), "x ")
expect_equal(rd2html("\\link[test]{x}"), "x ")
# but no self links
expect_equal(rd2html("\\link[test]{z}"), "z")
})
test_that("can parse local links with topic!=label", {
withr::local_options(list(
"downlit.topic_index" = c(x = "y")
))
expect_equal(rd2html("\\link[=x]{z}"), "z ")
})
test_that("functions in other packages generates link to rdrr.io", {
withr::local_options(list(
"downlit.package" = "test",
"downlit.topic_index" = c(x = "y", z = "z")
))
expect_equal(
rd2html("\\link[stats:acf]{xyz}"),
a("xyz", downlit::href_topic("acf", "stats"))
)
# Unless it's the current package
expect_equal(rd2html("\\link[test:x]{xyz}"), "xyz ")
})
test_that("link to non-existing functions return label", {
expect_equal(rd2html("\\link[xyzxyz:xyzxyz]{abc}"), "abc")
expect_equal(rd2html("\\link[base:xyzxyz]{abc}"), "abc")
})
test_that("code blocks autolinked to vignettes", {
withr::local_options(list(
"downlit.package" = "test",
"downlit.article_index" = c("abc" = "abc.html")
))
expect_equal(
rd2html("\\code{vignette('abc')}"),
"vignette('abc')
"
)
})
test_that("link to non-existing functions return label", {
withr::local_options(list(
"downlit.package" = "test",
"downlit.topic_index" = c("TEST-class" = "test")
))
expect_equal(rd2html("\\linkS4class{TEST}"), "TEST ")
})
test_that("bad specs throw errors", {
expect_snapshot(error = TRUE, {
rd2html("\\url{}")
rd2html("\\url{a\nb}")
rd2html("\\email{}")
rd2html("\\linkS4class{}")
})
})
# Paragraphs --------------------------------------------------------------
test_that("empty input gives empty output", {
expect_equal(flatten_para(character()), character())
})
test_that("empty lines break paragraphs", {
expect_equal(
flatten_para(rd_text("a\nb\n\nc")),
"a\nb
\nc
"
)
})
test_that("indented empty lines break paragraphs", {
expect_equal(
flatten_para(rd_text("a\nb\n \nc")),
"a\nb
\nc
"
)
})
test_that("block tags break paragraphs", {
out <- flatten_para(rd_text("a\n\\itemize{\\item b}\nc"))
expect_equal(out, "a
c
")
})
test_that("inline tags + empty line breaks", {
out <- flatten_para(rd_text("a\n\n\\code{b}"))
expect_equal(out, "a
\nb
")
})
test_that("single item can have multiple paragraphs", {
out <- flatten_para(rd_text("\\itemize{\\item a\n\nb}"))
expect_equal(out, "\n")
})
test_that("nl after tag doesn't trigger paragraphs", {
out <- flatten_para(rd_text("One \\code{}\nTwo"))
expect_equal(out, "One
\nTwo
")
})
test_that("cr generates line break", {
out <- flatten_para(rd_text("a \\cr b"))
expect_equal(out, "a b
")
})
# lists -------------------------------------------------------------------
test_that("simple lists work", {
expect_equal(
rd2html("\\itemize{\\item a}"),
c("")
)
expect_equal(
rd2html("\\enumerate{\\item a}"),
c("", "a
", " ")
)
})
test_that("\\describe items can contain multiple paragraphs", {
out <- rd2html("\\describe{
\\item{Label 1}{Contents 1}
\\item{Label 2}{Contents 2}
}")
expect_snapshot_output(cat(out, sep = "\n"))
})
test_that("can add ids to descriptions", {
out <- rd2html("\\describe{
\\item{abc}{Contents 1}
\\item{xyz}{Contents 2}
}", id_prefix = "foo")
expect_snapshot_output(cat(out, sep = "\n"))
})
test_that("\\describe items can contain multiple paragraphs", {
out <- rd2html("\\describe{
\\item{Label}{
Paragraph 1
Paragraph 2
}
}")
expect_snapshot_output(cat(out, sep = "\n"))
})
test_that("nested item with whitespace parsed correctly", {
out <- rd2html("
\\describe{
\\item{Label}{
This text is indented in a way pkgdown doesn't like.
}}")
expect_snapshot_output(cat(out, sep = "\n"))
})
# Verbatim ----------------------------------------------------------------
test_that("preformatted blocks aren't double escaped", {
out <- flatten_para(rd_text("\\preformatted{\\%>\\%}"))
expect_equal(out, "%>%
\n")
})
test_that("newlines are preserved in preformatted blocks", {
out <- flatten_para(rd_text("\\preformatted{^\n\nb\n\nc}"))
expect_equal(out, "^\n\nb\n\nc
\n")
})
test_that("spaces are preserved in preformatted blocks", {
out <- flatten_para(rd_text("\\preformatted{^\n\n b\n\n c}"))
expect_equal(out, "^\n\n b\n\n c
\n")
})
# Other -------------------------------------------------------------------
test_that("eqn", {
out <- rd2html(" \\eqn{\\alpha}{alpha}")
expect_equal(out, "\\(\\alpha\\)")
out <- rd2html(" \\eqn{x}")
expect_equal(out, "\\(x\\)")
})
test_that("deqn", {
out <- rd2html(" \\deqn{\\alpha}{alpha}")
expect_equal(out, "$$\\alpha$$")
out <- rd2html(" \\deqn{x}")
expect_equal(out, "$$x$$")
})
test_that("special", {
out <- rd2html("\\special{( \\dots )}")
expect_equal(out, "( ... )")
})
# figures -----------------------------------------------------------------
test_that("figures are converted to img", {
expect_equal(rd2html("\\figure{a}"), " ")
expect_equal(rd2html("\\figure{a}{b}"), " ")
expect_equal(
rd2html("\\figure{a}{options: height=1}"),
" "
)
})
test_that("figures with multilines alternative text can be parsed", {
expect_equal(rd2html("\\figure{a}{blabla
blop}"), " ")
})
pkgdown/tests/testthat/test-pkgdown_print.R 0000644 0001762 0000144 00000001432 14633374223 020721 0 ustar ligges users test_that("widgets and browseable html are kept as is", {
widget <- htmlwidgets::createWidget("test", list())
expect_s3_class(pkgdown_print(widget), "htmlwidget")
html <- htmltools::browsable(htmltools::div("foo"))
expect_s3_class(pkgdown_print(html), "shiny.tag")
})
test_that("htmlwidgets get sized", {
local_context_eval(list(fig.width = 7, dpi = 100, fig.asp = 1))
widget <- htmlwidgets::createWidget("test", list())
value <- pkgdown_print(widget)
expect_equal(value$width, 700)
expect_equal(value$height, 700)
})
test_that("respect htmlwidgets width", {
local_context_eval(list(fig.width = 7, dpi = 100, fig.asp = 1))
widget <- htmlwidgets::createWidget("test", list(), width = "100px")
value <- pkgdown_print(widget)
expect_equal(value$width, "100px")
})
pkgdown/tests/testthat/test-navbar-menu.R 0000644 0001762 0000144 00000006711 14633374223 020254 0 ustar ligges users test_that("can construct menu with children", {
menu <- menu_submenu(
"Title",
list(
menu_heading("Heading"),
menu_separator(),
menu_link("Link", "https://example.com")
)
)
expect_snapshot(cat(navbar_html(menu)))
})
test_that("bad inputs give clear error", {
submenu <- menu_submenu(
"Title",
list(
menu_submenu("Heading", list(menu_heading("Hi")))
)
)
expect_snapshot(error = TRUE, {
navbar_html(1)
navbar_html(list(foo = 1))
navbar_html(submenu)
})
})
test_that("can construct bullets", {
expect_snapshot({
cat(navbar_html(menu_icon("fa-question", "https://example.com", "label")))
cat(navbar_html(menu_heading("Hi")))
cat(navbar_html(menu_link("Hi", "https://example.com")))
})
})
test_that("bullet class varies based on depth", {
expect_equal(
navbar_html(menu_separator(), menu_depth = 0),
' '
)
expect_equal(
navbar_html(menu_separator(), menu_depth = 1),
' '
)
})
test_that("icons warn if no aria-label", {
reset_message_verbosity("icon-aria-label")
expect_snapshot({
. <- navbar_html(menu_icon("fa-question", "https://example.com", NULL))
})
})
test_that("icons extract base iconset class automatically", {
expect_match(
navbar_html(menu_icon("fa-question", "https://example.com", "label")),
'class="fa fa-question"',
fixed = TRUE
)
expect_match(
navbar_html(menu_icon("fab fab-github", "https://example.com", "label")),
'class="fab fab-github"',
fixed = TRUE
)
})
test_that("can specify link target", {
expect_match(
navbar_html(menu_link("a", "b", target = "_blank")),
'target="_blank"',
fixed = TRUE
)
})
test_that("can construct theme menu", {
pkg <- local_pkgdown_site(meta = list(template = list(bootstrap = 5, `light-switch` = TRUE)))
lightswitch <- navbar_components(pkg)$lightswitch
expect_snapshot(cat(navbar_html(lightswitch)))
})
test_that("simple components don't change without warning", {
expect_snapshot({
cat(navbar_html(menu_heading("a")))
cat(navbar_html(menu_link("a", "b")))
cat(navbar_html(menu_separator()))
cat(navbar_html(menu_search()))
})
})
# Building blocks -----------------------------------------------------------
test_that("navbar_html_text() combines icons and text", {
expect_equal(navbar_html_text(list(text = "a")), 'a')
expect_equal(
navbar_html_text(list(icon = "fas-github", `aria-label` = "github")),
' '
)
expect_equal(
navbar_html_text(list(text = "a", icon = "fas-github", `aria-label` = "github")),
' a'
)
})
test_that("navbar_html_text() escapes text", {
expect_equal(navbar_html_text(list(text = "<>")), '<>')
})
test_that("named arguments become attributes", {
expect_equal(html_tag("a"), ' ')
expect_equal(html_tag("a", x = NULL), ' ')
expect_equal(html_tag("a", x = NA), ' ')
expect_equal(html_tag("a", x = 1), ' ')
})
test_that("unnamed arguments become children", {
expect_equal(html_tag("a", "b"), 'b ')
expect_equal(html_tag("a", "b", NULL), 'b ')
})
test_that("class components are pasted together", {
expect_equal(html_tag("a", class = NULL), ' ')
expect_equal(html_tag("a", class = "a"), ' ')
expect_equal(html_tag("a", class = c("a", "b")), ' ')
})
pkgdown/tests/testthat/test-topics.R 0000644 0001762 0000144 00000015061 14633374223 017340 0 ustar ligges users select_topics_ <- function(topic, topics, check = TRUE) {
pkg <- local_pkgdown_site()
select_topics(
topic,
topics,
check = check,
error_path = "reference[1].contents",
error_pkg = pkg
)
}
test_that("bad inputs give informative warnings", {
topics <- tibble::tribble(
~name, ~alias, ~internal, ~concepts,
"x", c("x", "x1"), FALSE, character(),
)
expect_snapshot(error = TRUE, {
select_topics_("x + ", topics)
select_topics_("y", topics)
select_topics_("paste(1)", topics)
select_topics_("starts_with", topics)
select_topics_("1", topics)
select_topics_("starts_with('y')", topics)
})
})
test_that("selector functions validate their inputs", {
topics <- tibble::tribble(
~name, ~alias, ~internal, ~concepts,
"x", c("x", "x1"), FALSE, character(),
)
expect_snapshot(error = TRUE, {
select_topics_("starts_with('x', 'y')", topics)
select_topics_("starts_with(c('x', 'y'))", topics)
})
})
test_that("empty input returns empty vector", {
topics <- tibble::tribble(
~name, ~alias, ~internal, ~concepts,
"x", c("x", "x1"), FALSE, character(),
)
expect_equal(select_topics(character(), topics), integer())
})
test_that("can select by name or alias", {
topics <- tibble::tribble(
~name, ~alias,
"x", c("a1", "a2"),
"a", c("a3"),
"a-b", "b-a",
"c::d", "d",
)
expect_equal(select_topics_("x", topics), 1)
expect_equal(select_topics_("'x'", topics), 1)
expect_equal(select_topics_("a1", topics), 1)
expect_equal(select_topics_("a2", topics), 1)
expect_equal(select_topics_("c::d", topics), 4)
# Even if name is non-syntactic
expect_equal(select_topics_("a-b", topics), 3)
expect_equal(select_topics_("b-a", topics), 3)
# Or missing
expect_snapshot(error = TRUE, {
select_topics_("a4", topics)
select_topics_("c::a", topics)
})
})
test_that("selection preserves original order", {
topics <- tibble::tribble(
~name, ~alias,
"x", c("a1", "a2"),
"a", c("a3"),
"b", "b1"
)
expect_equal(select_topics_(c("a", "b1", "x"), topics), c(2, 3, 1))
})
test_that("can select by name", {
topics <- tibble::tribble(
~name, ~alias, ~internal,
"a", "a", FALSE,
"b1", "b1", FALSE,
"b2", "b2", FALSE,
"b3", "b3", TRUE,
)
topics$alias <- as.list(topics$alias)
expect_equal(select_topics_("starts_with('a')", topics), 1)
expect_equal(select_topics_("ends_with('a')", topics), 1)
expect_equal(select_topics_("contains('a')", topics), 1)
expect_equal(select_topics_("matches('[a]')", topics), 1)
# Match internal when requested
expect_equal(select_topics_("starts_with('b')", topics), c(2, 3))
expect_equal(select_topics_("starts_with('b', internal = TRUE)", topics), 2:4)
})
test_that("can select by presense or absence of concept", {
topics <- tibble::tribble(
~name, ~alias, ~internal, ~concepts,
"b1", "b1", FALSE, "a",
"b2", "b2", FALSE, c("a", "b"),
"b3", "b3", FALSE, character()
)
topics$alias <- as.list(topics$alias)
expect_equal(select_topics_("has_concept('a')", topics), c(1, 2))
expect_equal(select_topics_("lacks_concept('b')", topics), c(1, 3))
expect_equal(select_topics_("lacks_concepts(c('a', 'b'))", topics), 3)
})
test_that("can select by keyword", {
topics <- tibble::tribble(
~name, ~alias, ~internal, ~keywords,
"b1", "b1", FALSE, "a",
"b2", "b2", FALSE, c("a", "b"),
)
topics$alias <- as.list(topics$alias)
expect_equal(select_topics_("has_keyword('a')", topics), c(1, 2))
expect_equal(select_topics_("has_keyword('b')", topics), c(2))
expect_equal(select_topics_("has_keyword('c')", topics, check = FALSE), integer())
})
test_that("can select by lifecycle", {
topics <- tibble::tribble(
~name, ~alias, ~internal, ~keywords, ~lifecycle,
"b1", "b1", FALSE, "a", list("stable"),
"b2", "b2", FALSE, c("a", "b"), NULL
)
expect_equal(select_topics_("has_lifecycle('stable')", topics), 1)
expect_equal(select_topics_("has_lifecycle('deprecated')", topics, check = FALSE), integer())
})
test_that("can combine positive and negative selections", {
topics <- tibble::tribble(
~name, ~alias, ~internal,
"x", c("a1", "a2"), FALSE,
"a", c("a3"), FALSE,
"b", "b1", FALSE,
"d", "d", TRUE,
)
expect_equal(select_topics_("-x", topics), c(2, 3))
expect_equal(select_topics_(c("-x", "-a"), topics), 3)
expect_equal(select_topics_(c("-x", "x"), topics), c(2, 3, 1))
expect_equal(select_topics_(c("a", "x", "-a"), topics), 1)
expect_snapshot(select_topics_("c(a, -x)", topics), error = TRUE)
})
test_that("an unmatched selection generates a warning", {
topics <- tibble::tribble(
~name, ~alias, ~internal,
"x", c("a1", "a2"), FALSE,
"a", c("a3"), FALSE,
"b", "b1", FALSE,
"d", "d", TRUE,
)
expect_snapshot(error = TRUE,
select_topics_(c("a", "starts_with('unmatched')"), topics),
)
})
test_that("uses funs or aliases", {
pkg <- local_pkgdown_site()
pkg$topics <- tibble::tribble(
~name, ~funs, ~alias, ~file_out, ~title, ~lifecycle,
"x", character(), c("x1", "x2"), "x.html", "X", NULL,
"y", c("y1", "y2"), "y3", "y.html", "Y", NULL
)
out <- section_topics(pkg, c("x", "y"), error_path = "reference[1].contents")
expect_equal(out$aliases, list(c("x1", "x2"), c("y1", "y2")))
})
test_that("full topic selection process works", {
pkg <- local_pkgdown_site(test_path("assets/reference"))
# can mix local and remote
out <- section_topics(
pkg,
c("a", "base::mean"),
error_path = "reference[1].contents"
)
expect_equal(unname(out$name), c("a", "base::mean"))
# concepts and keywords work
out <- section_topics(
pkg,
c("has_concept('graphics')", "has_keyword('foo')"),
error_path = "reference[1].contents"
)
expect_equal(unname(out$name), c("b", "a"))
})
test_that("an unmatched selection with a matched selection does not select everything", {
topics <- tibble::tribble(
~name, ~alias, ~internal,
"x", c("a1", "a2"), FALSE,
"a", c("a3"), FALSE,
"b", "b1", FALSE,
"d", "d", TRUE,
)
expect_equal(
select_topics_(c("a", "starts_with('unmatched')"), topics, check = FALSE),
2
)
expect_equal(
select_topics_(c("starts_with('unmatched')", "a"), topics, check = FALSE),
2
)
})
pkgdown/tests/testthat/test-build-tutorials.R 0000644 0001762 0000144 00000002572 14634573316 021172 0 ustar ligges users test_that("can autodetect tutorials", {
pkg <- local_pkgdown_site()
base_path <- "vignettes/tutorials/test-1"
pkg <- pkg_add_file(pkg, path(base_path, "test-1.Rmd"), c(
'---',
'title: "Tutorial"',
'output: learnr::tutorial',
'runtime: shiny_prerendered',
'---'
))
path <- path(base_path, "rsconnect/documents/test-1.Rmd/shinyapps.io/hadley/tutorial-test-1.dcf")
pkg <- pkg_add_file(pkg, path, c(
"name: tutorial-test-1",
"title: tutorial-test-1",
"hostUrl: https://api.shinyapps.io/v1",
"when: 1521734722.72611",
"url: https://hadley.shinyapps.io/tutorial-test-1/"
))
out <- package_tutorials(pkg$src_path)
expect_equal(out$name, "test-1")
expect_equal(out$file_out, "tutorials/test-1.html")
expect_equal(out$url, "https://hadley.shinyapps.io/tutorial-test-1/")
# and aren't included in vignettes
out <- package_vignettes(pkg$src_path)
expect_equal(nrow(out), 0)
})
test_that("can manually supply tutorials", {
meta <- list(
tutorials = list(
list(name = "1-name", title = "1-title", url = "1-url"),
list(name = "2-name", title = "2-title", url = "2-url")
)
)
pkg <- local_pkgdown_site()
out <- package_tutorials(pkg, meta)
expect_equal(out$name, c("1-name", "2-name"))
expect_equal(out$file_out, c("tutorials/1-name.html", "tutorials/2-name.html"))
expect_equal(out$url, c("1-url", "2-url"))
})
pkgdown/tests/testthat/test-check.R 0000644 0001762 0000144 00000004100 14634573316 017111 0 ustar ligges users test_that("sitrep complains about BS3", {
pkg <- local_pkgdown_site(
meta = list(
template = list(bootstrap = 3),
url = "https://example.com"
),
desc = list(URL = "https://example.com")
)
expect_snapshot(pkgdown_sitrep(pkg))
})
test_that("sitrep reports all problems", {
pkg <- local_pkgdown_site(
test_path("assets/reference"),
list(reference = list(
list(title = "Title", contents = c("a", "b", "c", "e"))
))
)
expect_snapshot(pkgdown_sitrep(pkg))
})
test_that("checks fails on first problem", {
pkg <- local_pkgdown_site(
test_path("assets/reference"),
list(reference = list(
list(title = "Title", contents = c("a", "b", "c", "e"))
))
)
expect_snapshot(check_pkgdown(pkg), error = TRUE)
})
test_that("both inform if everything is ok", {
pkg <- local_pkgdown_site(
meta = list(url = "https://example.com"),
desc = list(URL = "https://example.com")
)
expect_snapshot({
pkgdown_sitrep(pkg)
check_pkgdown(pkg)
})
})
# check urls ------------------------------------------------------------------
test_that("check_urls reports problems", {
# URL not in the pkgdown config
pkg <- local_pkgdown_site()
expect_snapshot(check_urls(pkg), error = TRUE)
# URL only in the pkgdown config
pkg <- local_pkgdown_site(meta = list(url = "https://testpackage.r-lib.org"))
expect_snapshot(check_urls(pkg), error = TRUE)
})
# check favicons --------------------------------------------------------------
test_that("check_favicons reports problems", {
pkg <- local_pkgdown_site()
# no logo no problems
expect_no_error(check_favicons(pkg))
# logo but no favicons
file_touch(path(pkg$src_path, "logo.svg"))
expect_snapshot(check_favicons(pkg), error = TRUE)
# logo and old favicons
dir_create(path_favicons(pkg))
file_touch(path(path_favicons(pkg), "favicon.ico"), Sys.time() - 86400)
expect_snapshot(check_favicons(pkg), error = TRUE)
# logo and new favicons
file_touch(path(path_favicons(pkg), "favicon.ico"), Sys.time() + 86400)
expect_no_error(check_favicons(pkg))
})
pkgdown/tests/testthat/test-utils-fs.R 0000644 0001762 0000144 00000001062 14633374223 017601 0 ustar ligges users test_that("missing template package yields custom error", {
expect_snapshot(path_package_pkgdown("x", "missing", 3), error = TRUE)
})
test_that("out_of_date works as expected", {
temp1 <- file_create(withr::local_tempfile())
expect_true(out_of_date(temp1, "doesntexist"))
expect_snapshot(out_of_date("doesntexist", temp1), error = TRUE)
temp2 <- file_create(withr::local_tempfile())
file_touch(temp2, Sys.time() + 10)
expect_true(out_of_date(temp2, temp1))
expect_false(out_of_date(temp1, temp2))
expect_false(out_of_date(temp1, temp1))
})
pkgdown/tests/testthat/test-theme.R 0000644 0001762 0000144 00000002201 14634573316 017136 0 ustar ligges users test_that("check_bslib_theme() works", {
pkg <- local_pkgdown_site()
expect_equal(check_bslib_theme("default", pkg, bs_version = 4), "default")
expect_equal(check_bslib_theme("lux", pkg, bs_version = 4), "lux")
expect_snapshot(error = TRUE, {
check_bslib_theme("paper", pkg, bs_version = 4)
})
})
test_that("get_bslib_theme() works with template.bslib.preset", {
pkg <- local_pkgdown_site(
meta = list(
template = list(bslib = list(preset = "shiny"), bootstrap = 5)
)
)
expect_equal(get_bslib_theme(pkg), "shiny")
expect_no_error(bs_theme(pkg))
pkg <- local_pkgdown_site(
meta = list(
template = list(bslib = list(preset = "lux"), bootstrap = 5)
)
)
expect_equal(get_bslib_theme(pkg), "lux")
expect_no_error(bs_theme(pkg))
})
test_that("validations yaml specification", {
build_bslib_ <- function(...) {
pkg <- local_pkgdown_site(
meta = list(template = list(..., bootstrap = 5, `light-switch` = TRUE))
)
build_bslib(pkg)
}
expect_snapshot(error = TRUE, {
build_bslib_(theme = 1)
build_bslib_(theme = "fruit")
build_bslib_(`theme-dark` = "fruit")
})
})
pkgdown/tests/testthat/assets/ 0000755 0001762 0000144 00000000000 14672347601 016241 5 ustar ligges users pkgdown/tests/testthat/assets/reference/ 0000755 0001762 0000144 00000000000 14672377072 020204 5 ustar ligges users pkgdown/tests/testthat/assets/reference/R/ 0000755 0001762 0000144 00000000000 14633374223 020375 5 ustar ligges users pkgdown/tests/testthat/assets/reference/R/funs.R 0000644 0001762 0000144 00000000703 14633374223 021473 0 ustar ligges users #' A
#' @export
#' @keywords foo
#' @param a a letter
#' @param b a a number
#' @param c a logical
a <- function(a, b, c) {}
#' B
#' @export
#' @concept graphics
b <- function() {}
#' C
#' @export
c <- function() {}
#' D
#' @usage
#' \special{?topic}
#' @export
`?` <- function() {}
#' E
#' @name e
NULL
#' F
#' @keywords internal
#' @examples
#' testpackage:::f()
f <- function() {runif(5L)}
#' g <-> h
#' @keywords internal
g <- function() 1
pkgdown/tests/testthat/assets/reference/_pkgdown.yml 0000644 0001762 0000144 00000000057 14633374223 022531 0 ustar ligges users url: http://test.org
template:
bootstrap: 5
pkgdown/tests/testthat/assets/reference/NAMESPACE 0000644 0001762 0000144 00000000130 14151774277 021415 0 ustar ligges users # Generated by roxygen2: do not edit by hand
export("?")
export(a)
export(b)
export(c)
pkgdown/tests/testthat/assets/reference/man/ 0000755 0001762 0000144 00000000000 14633374223 020747 5 ustar ligges users pkgdown/tests/testthat/assets/reference/man/a.Rd 0000644 0001762 0000144 00000000363 14633374223 021460 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/funs.R
\name{a}
\alias{a}
\title{A}
\usage{
a(a, b, c)
}
\arguments{
\item{a}{a letter}
\item{b}{a a number}
\item{c}{a logical}
}
\description{
A
}
\keyword{foo}
pkgdown/tests/testthat/assets/reference/man/f.Rd 0000644 0001762 0000144 00000000304 14633374223 021460 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/funs.R
\name{f}
\alias{f}
\title{F}
\usage{
f()
}
\description{
F
}
\examples{
testpackage:::f()
}
\keyword{internal}
pkgdown/tests/testthat/assets/reference/man/e.Rd 0000644 0001762 0000144 00000000204 14633374223 021456 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/funs.R
\name{e}
\alias{e}
\title{E}
\description{
E
}
pkgdown/tests/testthat/assets/reference/man/g.Rd 0000644 0001762 0000144 00000000261 14633374223 021463 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/funs.R
\name{g}
\alias{g}
\title{g <-> h}
\usage{
g()
}
\description{
g <-> h
}
\keyword{internal}
pkgdown/tests/testthat/assets/reference/man/b.Rd 0000644 0001762 0000144 00000000245 14633374223 021460 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/funs.R
\name{b}
\alias{b}
\title{B}
\usage{
b()
}
\description{
B
}
\concept{graphics}
pkgdown/tests/testthat/assets/reference/man/c.Rd 0000644 0001762 0000144 00000000222 13635702026 021451 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/funs.R
\name{c}
\alias{c}
\title{C}
\usage{
c()
}
\description{
C
}
pkgdown/tests/testthat/assets/reference/man/help.Rd 0000644 0001762 0000144 00000000237 13731761074 022172 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/funs.R
\name{?}
\alias{?}
\title{D}
\usage{
\special{?topic}
}
\description{
D
}
pkgdown/tests/testthat/assets/reference/DESCRIPTION 0000644 0001762 0000144 00000000215 14633374223 021700 0 ustar ligges users Package: testpackage
Version: 1.0.0
Title: A test package
Description: A test package
Authors@R: person("Hadley Wickham")
RoxygenNote: 7.3.1
pkgdown/tests/testthat/assets/reference-pre-post/ 0000755 0001762 0000144 00000000000 14672347601 021746 5 ustar ligges users pkgdown/tests/testthat/assets/reference-pre-post/pkgdown/ 0000755 0001762 0000144 00000000000 14131662734 023414 5 ustar ligges users pkgdown/tests/testthat/assets/reference-pre-post/pkgdown/pre-reference.R 0000644 0001762 0000144 00000000007 14131662734 026256 0 ustar ligges users a <- 1
pkgdown/tests/testthat/assets/reference-pre-post/pkgdown/post-reference.R 0000644 0001762 0000144 00000000013 14131662734 026452 0 ustar ligges users a <- a + 1
pkgdown/tests/testthat/assets/reference-pre-post/DESCRIPTION 0000644 0001762 0000144 00000000443 14131662734 023452 0 ustar ligges users Package: testpackage
Version: 1.0.0
Title: A test package
Description: A longer statement about the package.
Authors@R: c(
person("Hadley", "Wickham", , "hadley@rstudio.com", role = c("aut", "cre")),
person("RStudio", role = c("cph", "fnd"))
)
RoxygenNote: 6.1.1
Encoding: UTF-8
pkgdown/tests/testthat/assets/-find-assets.html 0000644 0001762 0000144 00000300030 14633374223 021415 0 ustar ligges users
R Markdown Vignette with an Image
R Markdown Vignette with an Image
Hadley Wickham
Some words, and then an image like this:
pkgdown/tests/testthat/assets/reference-fail/ 0000755 0001762 0000144 00000000000 14672347601 021110 5 ustar ligges users pkgdown/tests/testthat/assets/reference-fail/R/ 0000755 0001762 0000144 00000000000 13671767227 021321 5 ustar ligges users pkgdown/tests/testthat/assets/reference-fail/R/f.R 0000644 0001762 0000144 00000000066 13671767227 021673 0 ustar ligges users #' Title
#'
#' \url{}
#' @export
f <- function() {
}
pkgdown/tests/testthat/assets/reference-fail/NAMESPACE 0000644 0001762 0000144 00000000070 13671767227 022334 0 ustar ligges users # Generated by roxygen2: do not edit by hand
export(f)
pkgdown/tests/testthat/assets/reference-fail/man/ 0000755 0001762 0000144 00000000000 13671767227 021673 5 ustar ligges users pkgdown/tests/testthat/assets/reference-fail/man/f.Rd 0000644 0001762 0000144 00000000237 13671767227 022411 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/f.R
\name{f}
\alias{f}
\title{Title}
\usage{
f()
}
\description{
Title
\url{}
}
pkgdown/tests/testthat/assets/reference-fail/DESCRIPTION 0000644 0001762 0000144 00000000443 13671767227 022627 0 ustar ligges users Package: testpackage
Version: 1.0.0
Title: A test package
Description: A longer statement about the package.
Authors@R: c(
person("Hadley", "Wickham", , "hadley@rstudio.com", role = c("aut", "cre")),
person("RStudio", role = c("cph", "fnd"))
)
RoxygenNote: 6.1.1
Encoding: UTF-8
pkgdown/tests/testthat/assets/reference-selector/ 0000755 0001762 0000144 00000000000 14633374223 022012 5 ustar ligges users pkgdown/tests/testthat/assets/reference-selector/R/ 0000755 0001762 0000144 00000000000 14633374223 022213 5 ustar ligges users pkgdown/tests/testthat/assets/reference-selector/R/funs.R 0000644 0001762 0000144 00000000123 14633374223 023305 0 ustar ligges users #' matches
#' @export
matches <- function() {}
#' A
#' @export
A <- function() {}
pkgdown/tests/testthat/assets/reference-selector/_pkgdown.yml 0000644 0001762 0000144 00000000057 14633374223 024347 0 ustar ligges users url: http://test.org
template:
bootstrap: 5
pkgdown/tests/testthat/assets/reference-selector/NAMESPACE 0000644 0001762 0000144 00000000110 14633374223 023221 0 ustar ligges users # Generated by roxygen2: do not edit by hand
export(A)
export(matches)
pkgdown/tests/testthat/assets/reference-selector/NEWS.md 0000644 0001762 0000144 00000000061 14633374223 023105 0 ustar ligges users # mypackage
## mypackage foo
## mypackage bar
pkgdown/tests/testthat/assets/reference-selector/man/ 0000755 0001762 0000144 00000000000 14633374223 022565 5 ustar ligges users pkgdown/tests/testthat/assets/reference-selector/man/A.Rd 0000644 0001762 0000144 00000000222 14633374223 023230 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/funs.R
\name{A}
\alias{A}
\title{A}
\usage{
A()
}
\description{
A
}
pkgdown/tests/testthat/assets/reference-selector/man/matches.Rd 0000644 0001762 0000144 00000000260 14633374223 024476 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/funs.R
\name{matches}
\alias{matches}
\title{matches}
\usage{
matches()
}
\description{
matches
}
pkgdown/tests/testthat/assets/reference-selector/DESCRIPTION 0000644 0001762 0000144 00000000215 14633374223 023516 0 ustar ligges users Package: testpackage
Version: 1.0.0
Title: A test package
Description: A test package
Authors@R: person("Hadley Wickham")
RoxygenNote: 7.3.1
pkgdown/tests/testthat/assets/reference-html-dep/ 0000755 0001762 0000144 00000000000 14633374223 021704 5 ustar ligges users pkgdown/tests/testthat/assets/reference-html-dep/R/ 0000755 0001762 0000144 00000000000 14633374223 022105 5 ustar ligges users pkgdown/tests/testthat/assets/reference-html-dep/R/funs.R 0000644 0001762 0000144 00000000406 14633374223 023203 0 ustar ligges users #' Example with HTML dependency
#'
#' @examples
#' a()
#' @export
a <- function() {
x <- htmltools::tagList(
htmltools::p("hello"),
rmarkdown::html_dependency_jquery(),
rmarkdown::html_dependency_bootstrap("flatly")
)
htmltools::browsable(x)
}
pkgdown/tests/testthat/assets/reference-html-dep/_pkgdown.yml 0000644 0001762 0000144 00000000057 14633374223 024241 0 ustar ligges users url: http://test.org
template:
bootstrap: 5
pkgdown/tests/testthat/assets/reference-html-dep/NAMESPACE 0000644 0001762 0000144 00000000070 14633374223 023120 0 ustar ligges users # Generated by roxygen2: do not edit by hand
export(a)
pkgdown/tests/testthat/assets/reference-html-dep/man/ 0000755 0001762 0000144 00000000000 14633374223 022457 5 ustar ligges users pkgdown/tests/testthat/assets/reference-html-dep/man/a.Rd 0000644 0001762 0000144 00000000331 14633374223 023163 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/funs.R
\name{a}
\alias{a}
\title{Example with HTML dependency}
\usage{
a()
}
\description{
Example with HTML dependency
}
\examples{
a()
}
pkgdown/tests/testthat/assets/reference-html-dep/DESCRIPTION 0000644 0001762 0000144 00000000215 14633374223 023410 0 ustar ligges users Package: testpackage
Version: 1.0.0
Title: A test package
Description: A test package
Authors@R: person("Hadley Wickham")
RoxygenNote: 7.1.2
pkgdown/tests/testthat/assets/figure/ 0000755 0001762 0000144 00000000000 14633374223 017517 5 ustar ligges users pkgdown/tests/testthat/assets/figure/_pkgdown.yml 0000644 0001762 0000144 00000000136 14633374223 022052 0 ustar ligges users template:
bootstrap: 5
figures:
dev: "jpeg"
fig.ext: "jpg"
fig.width: 3
fig.asp: 1
pkgdown/tests/testthat/assets/figure/vignettes/ 0000755 0001762 0000144 00000000000 14656154156 021535 5 ustar ligges users pkgdown/tests/testthat/assets/figure/vignettes/figures.Rmd 0000644 0001762 0000144 00000000145 14633374223 023637 0 ustar ligges users ---
title: "Test: Figures"
---
```{r}
#| fig-alt: A scatterplot of the numbers 1-10.
plot(1:10)
```
pkgdown/tests/testthat/assets/figure/man/ 0000755 0001762 0000144 00000000000 14630120337 020262 5 ustar ligges users pkgdown/tests/testthat/assets/figure/man/figure.Rd 0000644 0001762 0000144 00000000337 14630120337 022035 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/bacon.R
\name{Figure}
\alias{Figure}
\title{Figure}
\description{
Pulled pork is delicious
}
\examples{
plot(1:5)
hist(1:3)
}
\keyword{internal}
pkgdown/tests/testthat/assets/figure/DESCRIPTION 0000644 0001762 0000144 00000000423 14630120337 021214 0 ustar ligges users Package: testpackage
Version: 1.0.0
Title: A test package
Description: A longer statement about the package.
Authors@R: c(
person("Hadley", "Wickham", , "hadley@rstudio.com", role = c("aut", "cre")),
person("RStudio", role = c("cph", "fnd"))
)
RoxygenNote: 6.0.1
pkgdown/tests/testthat/assets/kitten.jpg 0000644 0001762 0000144 00000143357 14633374223 020253 0 ustar ligges users JFIF H H ICC_PROFILE lcms mntrRGB XYZ ) 9acspAPPL -lcms
desc ^cprt \ wtpt h bkpt | rXYZ gXYZ bXYZ rTRC @gTRC @bTRC @desc c2 text IX XYZ -XYZ 3 XYZ o 8 XYZ b XYZ $ curv ck?Q4!)2;FQw]kpz|i}0
##*%%*525EE\
##*%%*525EE\ "
~TQ PA 1 " oD @DA @A"" F EEcDD7 " " j PQȂEh" " Tb((QA D*"" UU@* " FA@ 4TCv"9@F "*(""#QDD@ADQv Wyr]KD@QF(55jUCv {>{/V"+"AL]^~CXh4 D݀(|B_ FRJLO>m%|Ķ7= ] ?]UW]:cXe4AvK;6վ8Līy.2<#PG
OWxWu
=.7d%ov-yDwn~SyίN೭^lkQ
F pbf7C@Z;B4~[$>
`_8noNײt9Y}o0F W=涨3'^hy[\Rv1m(0>{Aύy5 Wb*y3c58(WMWk؇o6=:/}Y
h D 7(
=S)Ǥ(gЪ댧;XGIrdZO}1 nA)$[=Wmg]Ӕk_`zkW3Q35ԾcZ PPM (
/L M;͙uK2Ãfl\IQ1+.۾]=sɍb T7H { H7TAdql˰x"zvGwms[RݡKʮ*z~c<UE@V(
sUعPzGPe'4c^hp=
|[p~lkPTQ@TCt _Gc,r5V|FͬkY֎=Sy"M{.͞H (( nDQ`7\ o=G7^f}ݤrƮd\}_V7"
Uy+EcȖw)yqw,J؛$2#afMlz7ͭD P
((YO4
g1qZpϤ{u-ܻA-+KgA 4T{hn];y# S>Q`tFSҺXg͎Dt8f
oZ
E@
(cs q:K)wYQ6MH-o8 y'>syZҽOK0FsWɍDh @
)踼߈.v|Ӧ~ut$㳾Tj/П}X}#&e$A;㕽~~h (H?(pWuUI&.: Ef';ovvwjO=cgZ5 2
+įHqU8Ӛu\#VHyk,OC{]Y3Vy (" F9f