test-markdown-link.R
In roxygen2: In-Line Documentation for R

test_that("proper link references are added", {
  cases <- list(
    c("foo [func()] bar",           "[func()]: R:func()"),
    c("foo [obj] bar",              "[obj]: R:obj"),
    c("foo [text][func()] bar",     "[func()]: R:func()"),
    c("foo [text][obj] bar",        "[obj]: R:obj"),
    c("foo [pkg::func()] bar",       "[pkg::func()]: R:pkg::func()"),
    c("foo [pkg::obj] bar",          "[pkg::obj]: R:pkg::obj"),
    c("foo [text][pkg::func()] bar", "[pkg::func()]: R:pkg::func()"),
    c("foo [text][pkg::obj] bar",    "[pkg::obj]: R:pkg::obj"),
    c("foo [linktos4-class] bar",    "[linktos4-class]: R:linktos4-class"),
    c("foo [pkg::s4-class] bar",     "[pkg::s4-class]: R:pkg::s4-class")
  )

  for (i in seq_along(cases)) {
    expect_match(
      add_linkrefs_to_md(cases[[i]][1]),
      cases[[i]][2],
      fixed = TRUE
    )
  }
})

test_that("can not have [ inside of link", {
  expect_equal(
    markdown("`[[`. [subset()]"),
    "\\code{[[}. \\code{\\link[=subset]{subset()}}"
  )
})

test_that("can escape [ to avoid spurious links", {
  expect_equal(
    markdown("\\[test\\]"),
    "[test]"
  )

  expect_equal(
    markdown("\\[ [test] \\]"),
    "[ \\link{test} ]"
  )
})

test_that("\\Sexpr with options not converted to links", {
  expect_equal(
     markdown("\\Sexpr[results=rd]{runif(1)}"),
     "\\Sexpr[results=rd]{runif(1)}"
   )
})

test_that("% in links are escaped", {
  expect_equal(markdown("[x][%%]"), "\\link[=\\%\\%]{x}")
  expect_equal(markdown("[%][x]"), "\\link[=x]{\\%}")
  expect_equal(markdown("[%%]"), "\\link{\\%\\%}")
  expect_equal(markdown("[base::%%]"), "\\link[base:Arithmetic]{base::\\%\\%}")
})

test_that("{ and } in links are escaped (#1259)", {
  expect_equal(markdown("[`foo({ bar })`][x]"), "\\code{\\link[=x]{foo(\\{ bar \\})}}")
  expect_equal(markdown("[`{{`][x]"), "\\code{\\link[=x]{\\{\\{}}")

  # Non code parts are not escaped (invalid Rd)
  expect_equal(markdown("[foo({ bar })][x]"), "\\link[=x]{foo({ bar })}")
})

test_that("non-text nodes in links fails", {
  tag <- roxy_tag("title", NULL, NULL, file = "foo.R", line = 10)

  expect_snapshot({
    markdown("[`foo` bar][x]", tag = tag)
    markdown("[__baz__][x]", tag = tag)
  })
})

test_that("commonmark picks up the various link references", {
  cases <- list(
    list("foo [func()] bar",            c("R:func()", "func()")),
    list("foo [obj] bar",               c("R:obj", "obj")),
    list("foo [text][func()] bar",      c("R:func()", "text")),
    list("foo [text][obj] bar",         c("R:obj", "text")),
    list("foo [pkg::func()] bar",       c("R:pkg::func()", "pkg::func()")),
    list("foo [pkg::obj] bar",          c("R:pkg::obj", "pkg::obj")),
    list("foo [text][pkg::func()] bar", c("R:pkg::func()", "text")),
    list("foo [text][pkg::obj] bar",    c("R:pkg::obj", "text")),
    list("foo [linktos4-cl] bar",       c("R:linktos4-cl", "linktos4-cl")),
    list("foo [pkg::s4-cl] bar",        c("R:pkg::s4-cl", "pkg::s4-cl"))
  )

  for (i in seq_along(cases)) {
    x <- commonmark::markdown_xml(add_linkrefs_to_md(cases[[i]][[1]]))
    xdoc <- xml2::xml_ns_strip(xml2::read_xml(x))
    link <- xml2::xml_find_first(xdoc, "//link")
    expect_equal(xml2::xml_attr(link, "destination"), cases[[i]][[2]][1])
    text <- xml2::xml_find_first(link, "./text")
    expect_equal(xml2::xml_text(text), cases[[i]][[2]][2], info = i)
  }
})

test_that("short and sweet links work", {
  out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see [function()].
    #' And also [object].
    #' @md
    foo <- function() {}")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see \\code{\\link[=function]{function()}}.
    #' And also \\link{object}.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)

  expect_snapshot(
    out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' See [11pkg::function()], [11pkg::object].
    #' @md
    foo <- function() {}")[[1]]
  )
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' See \\code{\\link[11pkg:function]{11pkg::function()}}, \\link[11pkg:object]{11pkg::object}.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)

  out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see [name][dest].
    #' @md
    foo <- function() {}")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see \\link[=dest]{name}.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)

  expect_snapshot_warning(
    out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see [name words][stringr::bar111].
    #' @md
    foo <- function() {}")[[1]]
  )
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see \\link[stringr:bar111]{name words}.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)

  out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see [terms][terms.object].
    #' @md
    foo <- function() {}")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see \\link[=terms.object]{terms}.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)

  out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see [abc][abc-class].
    #' @md
    foo <- function() {}")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see \\link[=abc-class]{abc}.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)

  out1 <- roc_proc_text(rd_roclet(), "
    #' Title.
    #'
    #' In another package: [and this one][desc::desc].
    #' [name words][desc::desc].
    #'
    #' @md
    #' @name markdown-test
    foo <- function() {}")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title.
    #'
    #' In another package: \\link[desc:desc]{and this one}.
    #' \\link[desc:desc]{name words}.
    #'
    #' @name markdown-test
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)
})

test_that("a weird markdown link bug is fixed", {

  out1 <- roc_proc_text(rd_roclet(), "
    #' Dummy page to test roxygen's markdown formatting
    #'
    #' Links are very tricky, so I'll put in some links here:
    #' Link to a function: [roxygenize()].
    #' Link to an object: [roxygenize] (we just treat it like an object here).
    #'
    #' Link to another package, function: [desc::desc()].
    #' Link to another package, non-function: [desc::desc].
    #'
    #' Link with link text: [this great function][roxygenize()],
    #' [`roxygenize`][roxygenize()], or [that great function][roxygenize].
    #'
    #' In another package: [and this one][desc::desc].
    #'
    #' @md
    #' @name markdown-test
    #' @keywords internal
    NULL")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Dummy page to test roxygen's markdown formatting
    #'
    #' Links are very tricky, so I'll put in some links here:
    #' Link to a function: \\code{\\link[=roxygenize]{roxygenize()}}.
    #' Link to an object: \\link{roxygenize} (we just treat it like an object here).
    #'
    #' Link to another package, function: \\code{\\link[desc:desc]{desc::desc()}}.
    #' Link to another package, non-function: \\link[desc:desc]{desc::desc}.
    #'
    #' Link with link text: \\link[=roxygenize]{this great function},
    #' \\code{\\link[=roxygenize]{roxygenize}}, or \\link[=roxygenize]{that great function}.
    #'
    #' In another package: \\link[desc:desc]{and this one}.
    #'
    #' @name markdown-test
    #' @keywords internal
    NULL")[[1]]
  expect_equivalent_rd(out1, out2)
})

test_that("another markdown link bug is fixed", {

  out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see [escape_rd_for_md()].
    #'
    #' And also [object].
    #' @md
    foo <- function() {}")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see \\code{\\link[=escape_rd_for_md]{escape_rd_for_md()}}.
    #'
    #' And also \\link{object}.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)
})

test_that("markdown code as link text is rendered as code", {

  suppressWarnings(out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see [`name`][dest],
    #' [`function`][function()],
    #' [`filter`][stats::filter()],
    #' [`bar`][pkg::bar],
    #' [`terms`][terms.object],
    #' [`abc`][abc-class].
    #' @md
    foo <- function() {}")[[1]])
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see \\code{\\link[=dest]{name}},
    #' \\code{\\link[=function]{function}},
    #' \\code{\\link[stats:filter]{filter}},
    #' \\code{\\link[pkg:bar]{bar}},
    #' \\code{\\link[=terms.object]{terms}},
    #' \\code{\\link[=abc-class]{abc}}.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)
})

test_that("non-code link in backticks works", {

  out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see [`foobar`].
    #' Also [`this_too`].
    #' @md
    foo <- function() {}")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see \\code{\\link{foobar}}.
    #' Also \\code{\\link{this_too}}.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)
})

test_that("[] is not picked up in code", {

  out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' @param connect_args `[named list]`\\cr Connection arguments
    #' Description, see `[foobar]`.
    #' Also `[this_too]`.
    #' @md
    foo <- function() {}")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' @param connect_args \\verb{[named list]}\\cr Connection arguments
    #' Description, see \\verb{[foobar]}.
    #' Also \\verb{[this_too]}.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)
})

test_that("[]() links are still fine", {

  out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see [some thing](http://www.someurl.com).
    #' @md
    foo <- function() {}")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see \\href{http://www.someurl.com}{some thing}.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)

  out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Link
    #' text [broken
    #' across lines](http://www.someurl.com) preserve
    #' whitespace, even when
    #' [broken across
    #' several
    #' lines](http://www.someurl.com),
    #' or with varying
    #' [amounts \
    #'   of  \
    #' interspersed   \
    #'   whitespace](http://www.someurl.com).
    #' @md
    foo <- function() {}")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Link
    #' text \\href{http://www.someurl.com}{broken across lines} preserve
    #' whitespace, even when
    #' \\href{http://www.someurl.com}{broken across several lines},
    #' or with varying
    #' \\href{http://www.someurl.com}{amounts of interspersed whitespace}.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)

})

test_that("links to S4 classes are OK", {

  out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see [linktos4-class] as well.
    #' @md
    foo <- function() {}")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see \\linkS4class{linktos4} as well.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)

  suppressWarnings(out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see [pkg::linktos4-class] as well.
    #' @md
    foo <- function() {}")[[1]])
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see \\link[pkg:linktos4-class]{pkg::linktos4} as well.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)

})

test_that("linebreak in 'text' of [text][foo] turns into single space", {

  out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Link
    #' text [broken
    #' across lines][fcn] preserve
    #' whitespace, even when
    #' [broken across
    #' several
    #' lines][fcn],
    #' or with varying
    #' [amounts \
    #'   of  \
    #' interspersed   \
    #'   whitespace][fcn].
    #' @md
    foo <- function() {}")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Link
    #' text \\link[=fcn]{broken across lines} preserve
    #' whitespace, even when
    #' \\link[=fcn]{broken across several lines},
    #' or with varying
    #' \\link[=fcn]{amounts of interspersed whitespace}.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)

})

test_that("markup in link text", {
  out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see [`code link text`][func].
    #' And also [`code as well`](https://external.com).
    #' @md
    foo <- function() {}")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' Description, see \\code{\\link[=func]{code link text}}.
    #' And also \\href{https://external.com}{\\verb{code as well}}.
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)
})

test_that("linking to self is unqualified", {
  old <- roxy_meta_set("current_package", "myself")
  on.exit(roxy_meta_set("current_package", old), add = TRUE)
  rd <- markdown("foo [myself::fun()] and [myself::obj] bar")
  expect_equal(
    rd,
    "foo \\code{\\link[=fun]{fun()}} and \\link{obj} bar"
  )
})

test_that("percents are escaped in link targets", {
  out1 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' [link % text](https://foo.bar/link%20target)
    #' @md
    foo <- function() {}")[[1]]
  out2 <- roc_proc_text(rd_roclet(), "
    #' Title
    #'
    #' \\href{https://foo.bar/link%20target}{link % text}
    #' @md
    foo <- function() {}")[[1]]
  expect_equivalent_rd(out1, out2)
})