test_that("can eval inline code", {
out1 <- roc_proc_text(rd_roclet(), "
#' @title Title `r 1 + 1`
#' @description Description `r 2 + 2`
#' @md
foo <- function() NULL
")[[1]]
expect_equal(out1$get_value("title"), "Title 2")
expect_equal(out1$get_value("description"), "Description 4")
})
test_that("can eval fenced code", {
out1 <- roc_proc_text(rd_roclet(), "
#' @title Title
#' @details Details
#' ```{r lorem}
#' 1+1
#' ```
#' @md
foo <- function() NULL
")[[1]]
expect_match(out1$get_value("details"), "2")
})
test_that("use same env within, but not across blocks", {
example <- "
#' Title `r baz <- 420` `r baz`
#'
#' Description `r exists('baz', inherits = FALSE)`
#' @md
bar <- function() NULL
#' Title
#'
#' Description `r exists('baz', inherits = FALSE)`
#' @md
zap <- function() NULL
"
out1 <- roc_proc_text(rd_roclet(), example)[[1]]
out2 <- roc_proc_text(rd_roclet(), example)[[2]]
expect_equal(out1$get_value("title"), "Title 420")
expect_equal(out1$get_value("description"), "Description TRUE")
expect_equal(out2$get_value("description"), "Description FALSE")
})
test_that("appropriate knit print method for fenced and inline is applied", {
rlang::local_bindings(
knit_print.foo = function(x, inline = FALSE, ...) {
knitr::asis_output(ifelse(inline, "inline", "fenced"))
},
.env = globalenv()
)
out1 <- roc_proc_text(rd_roclet(), "
#' @title Title `r structure('default', class = 'foo')`
#'
#' @details Details
#'
#' ```{r}
#' structure('default', class = 'foo')
#' ```
#'
#' @md
#' @name bar
NULL
")
expect_match(out1$bar.Rd$get_value("details"), "fenced", fixed = TRUE)
expect_match(out1$bar.Rd$get_value("title"), "inline", fixed = TRUE)
})
test_that("can create markdown markup", {
expect_identical(
markdown("Description `r paste0('_', 'keyword', '_')`"),
"Description \\emph{keyword}"
)
})
test_that("can create markdown markup piecewise", {
expect_identical(
markdown(
"Description [`r paste0('https://url')`](`r paste0('link text')`)"
),
"Description \\link{https://url}(link text)"
)
})
test_that("can create escaped markdown markup", {
# this workaround is recommended by @yihui
# "proper" escaping for inline knitr tracked in https://github.com/yihui/knitr/issues/1704
out1 <- roc_proc_text(rd_roclet(), "
#' Title
#' Description `r paste0('\\x60', 'bar', '\\x60')`
#' @md
foo <- function() NULL
")[[1]]
expect_match(out1$get_value("title"), "\\code{bar}", fixed = TRUE)
})
test_that("NULL creates no text", {
expect_identical(
markdown("Description --`r NULL`--"),
"Description ----"
)
})
test_that("multi-line inline code gives useful warning", {
block <- "
#' Title
#'
#' `r 1 +
#' 1`
#' @md
foo <- function() {}
"
expect_snapshot(
out <- roc_proc_text(rd_roclet(), block)[[1]]
)
expect_equal(out$get_value("description"), "\\verb{r 1 + 1}")
})
test_that("inline code gives useful warning", {
block <- "
#' Title
#'
#' `r 1 + `
#' @md
foo <- function() {}
"
expect_snapshot(
out <- roc_proc_text(rd_roclet(), block)[[1]]
)
expect_equal(out$get_value("description"), "\\verb{r 1 + }")
})
test_that("interleaving fences and inline code", {
out1 <- roc_proc_text(rd_roclet(), "
#' Title
#'
#' @details Details `r x <- 10; x`
#'
#' ```{r}
#' y <- x + 10
#' y
#' ```
#'
#' @md
#' @name dummy
NULL")[[1]]
expect_snapshot(cat(out1$get_value("details")))
})
test_that("preserves white space", {
out1 <- roc_proc_text(rd_roclet(), "
#' Title
#'
#' @details
#'
#' ```{r}
#' a <- 1
#'
#' b <- 2
#' ```
#'
#' ```{r}
#' c <- 3
#' ```
#'
#' @md
#' @name dummy
NULL")[[1]]
expect_snapshot(cat(out1$get_value("details")))
})
test_that("fence options are used", {
out1 <- roc_proc_text(rd_roclet(), "
#' Title
#'
#' @details Details
#'
#' ```{r eval = FALSE}
#' this - would - fail - to - eval
#' ```
#'
#' @md
#' @name dummy
NULL")[[1]]
details <- out1$get_value("details")
expect_false(grepl("Error", details))
})
test_that("dynamic code in fragile tags still runs", {
out <- markdown("foo \\out{`r 1+1`} bar")
expect_equal(out, "foo \\out{2} bar")
})
test_that("fragile tags in dynamic code are left alone", {
out <- markdown("foo `r substr('\\\\out{xxx}', 2, 4)` bar")
expect_equal(out, "foo out bar")
})
test_that("fragile tags in generated code", {
out <- markdown("foo `r '\\\\out{*1*}'` bar")
expect_equal(out, "foo \\out{*1*} bar")
expect_silent(out2 <- markdown("foo `r '\\\\out{}'` bar"))
expect_equal(out2, "foo \\out{} bar")
})
test_that("workaround for cmark sourcepos bug (#1353) works", {
out <- roc_proc_text(rd_roclet(), "
#' Title
#'
#' line1
#' pre `r \"1\"` 2 `r 1+2` post
#'
#' no workaround needed `r 'here'`
#' @md
foo <- function() {}
")[[1]]
expect_equal(out$get_section("description")$value, "line1\npre 1 2 3 post")
expect_equal(out$get_section("details")$value, "no workaround needed here")
})
test_that("doesn't generate NA language", {
out <- roc_proc_text(rd_roclet(), "
#' Title
#'
#' ```
#' r <- 1:10
#' ```
#' @md
foo <- function() {}")[[1]]
expect_false(grepl("NA", out$get_section("description")$value))
})