test_that("special characters are escaped", {
out <- rd2html("a & b")
expect_equal(out, "a & b")
})
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", {
local_edition(3)
expect_snapshot(cli::cat_line(rd2html("\\subsection{A}{B}")))
})
test_that("subsection generates h3", {
local_edition(3)
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", {
local_edition(3)
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")
})
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 with multiple args are parsed", {
skip_if_not(getRversion() >= "4.0.0")
local_edition(3)
local_context_eval()
expect_snapshot(rd2html("\\Sexpr[results=verbatim]{1}"), error = TRUE)
})
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", {
local_edition(3)
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("\\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")
})
# Usage -------------------------------------------------------------------
test_that("S4 methods gets comment", {
out <- rd2html("\\S4method{fun}{class}(x, y)")
expect_equal(out[1], "# S4 method for 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")
expect_equal(out[2], "fun(x, y)")
out <- rd2html("\\method{fun}{class}(x, y)")
expect_equal(out[1], "# S3 method for 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 function")
expect_equal(out[2], "fun(x, y)")
out <- rd2html("\\method{fun}{function}(x, y)")
expect_equal(out[1], "# S3 method for function")
expect_equal(out[2], "fun(x, y)")
out <- rd2html("\\S4method{fun}{function,function}(x, y)")
expect_equal(out[1], "# S4 method for function,function")
expect_equal(out[2], "fun(x, y)")
})
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", {
# Fails due to a bug prior to R 4.0.0:
# https://bugs.r-project.org/show_bug.cgi?id=17727
skip_if_not(getRversion() >= "4.0.0")
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}"), "")
})