test-rd-inherit.R
In roxygen2: In-Line Documentation for R

# Rd parsing --------------------------------------------------------------

test_that("can round-trip Rd", {
  rd <- tools::parse_Rd(test_path("escapes.Rd"))

  field <- find_field(rd, "description")
  lines <- strsplit(field, "\n")[[1]]
  expect_equal(
    lines,
    c(
      "% Comment", # Latex comments shouldn't be escaped
      "\\code{\\\\}" # Backslashes in code should be
    )
  )
})

test_that("\\links are transformed", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' Title
    #'
    #' @inheritParams digest::sha1
    wrapper <- function(algo) {}"
  )[[1]]

  # \\link{} should include [digest]
  expect_snapshot_output(out$get_section("param"))
})

test_that("markdown doesn't get get extra parens", {
  expect_equal(rd2text(parse_rd("\\href{a}{b}")), "\\href{a}{b}\n")
  expect_equal(rd2text(parse_rd("\\ifelse{a}{b}{c}")), "\\ifelse{a}{b}{c}\n")
  expect_equal(rd2text(parse_rd("\\if{a}{b}")), "\\if{a}{b}\n")
})

test_that("relative links converted to absolute", {
  link_to_base <- function(x) {
    rd2text(parse_rd(x), package = "base")
  }

  expect_equal(
    link_to_base("\\link{abbreviate}"),
    "\\link[base]{abbreviate}\n"
  )
  expect_equal(
    link_to_base("\\link[=abbreviate]{abbr}"),
    "\\link[base:abbreviate]{abbr}\n"
  )

  # Doesn't affect links that already have
  expect_equal(
    link_to_base("\\link[foo]{abbreviate}"),
    "\\link[foo]{abbreviate}\n"
  )
  expect_equal(
    link_to_base("\\link[foo::abbreviate]{abbr}"),
    "\\link[foo::abbreviate]{abbr}\n"
  )

  # linkS4class converted to absolute link (#1634)
  link_to_methods <- function(x) {
    rd2text(parse_rd(x), package = "methods")
  }
  expect_equal(
    link_to_methods("\\linkS4class{genericFunction}"),
    "\\link[methods:genericFunction-class]{genericFunction}\n"
  )
})

# tag parsing -------------------------------------------------------------

test_that("invalid syntax gives useful warning", {
  block <- "
    #' @inheritDotParams
    #' @inheritSection
    NULL
  "
  expect_snapshot(. <- roc_proc_text(rd_roclet(), block))
})

test_that("warns on unknown inherit type", {
  text <- "
    #' @inherit fun blah
    NULL
  "
  expect_snapshot(parse_text(text))
})

test_that("no options gives default values", {
  block <- parse_text(
    "
    #' @inherit fun
    NULL
  "
  )[[1]]

  expect_equal(block_get_tag_value(block, "inherit")$fields, inherit_components)
})

test_that("some options overrides defaults", {
  block <- parse_text(
    "
    #' @inherit fun return
    NULL
  "
  )[[1]]

  expect_equal(block_get_tag_value(block, "inherit")$fields, "return")
})


# Inherit return values ---------------------------------------------------

test_that("can inherit return values from roxygen topic", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #'
    #' @return ABC
    a <- function(x) {}

    #' B
    #'
    #' @inherit a
    b <- function(y) {}
  "
  )[[2]]

  expect_equal(out$get_value("value"), "ABC")
})


test_that("takes value from first with return", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A1
    #' @return A
    a1 <- function(x) {}

    #' A2
    a2 <- function() {}

    #' B
    #' @return B
    b <- function(x) {}

    #' C
    #' @inherit a2
    #' @inherit b
    #' @inherit a1
    c <- function(y) {}
  "
  )[[3]]

  expect_equal(out$get_value("value"), "B")
})

test_that("can inherit return value from external function", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A1
    #' @inherit base::mean
    a1 <- function(x) {}
  "
  )[[1]]

  expect_match(out$get_value("value"), "before the mean is computed.$")
  expect_match(out$get_value("value"), "^If \\\\code")
})


# Inherit seealso ---------------------------------------------------------

test_that("can inherit return values from roxygen topic", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #'
    #' @seealso ABC
    a <- function(x) {}

    #' B
    #'
    #' @inherit a
    b <- function(y) {}
  "
  )[[2]]

  expect_equal(out$get_value("seealso"), "ABC")
})

# Inherit description and details -----------------------------------------

test_that("can inherit description from roxygen topic", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #'
    #' B
    #'
    #' @return ABC
    a <- function(x) {}

    #' @title C
    #' @inherit a description
    b <- function(y) {}
  "
  )[[2]]

  expect_equal(out$get_value("description"), "B")
})

test_that("inherits description if omitted", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #'
    #' B
    #'
    #' @return ABC
    a <- function(x) {}

    #' C
    #' @inherit a description
    b <- function(y) {}
  "
  )[[2]]

  expect_equal(out$get_value("description"), "B")
})

test_that("can inherit details from roxygen topic", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #'
    #' B
    #'
    #' C
    #'
    #' @return ABC
    a <- function(x) {}

    #' D
    #'
    #' E
    #'
    #' @inherit a details
    b <- function(y) {}
  "
  )[[2]]

  expect_equal(out$get_value("description"), "E")
  expect_equal(out$get_value("details"), "C")
})


# Inherit sections --------------------------------------------------------

test_that("inherits missing sections", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #' @section A:1
    #' @section B:1
    a <- function(x) {}

    #' D
    #'
    #' @section A:2
    #' @inherit a sections
    b <- function(y) {}
  "
  )[[2]]

  section <- out$get_value("section")
  expect_equal(section$title, c("A", "B"))
  expect_equal(section$content, c("2", "1"))
})

test_that("can inherit single section", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #' @section A:1
    #' @section B:1
    a <- function(x) {}

    #' D
    #'
    #' @inheritSection a B
    b <- function(y) {}
  "
  )[[2]]

  section <- out$get_value("section")
  expect_equal(section$title, "B")
  expect_equal(section$content, "1")
})


test_that("warns if can't find section", {
  code <- "
    #' a
    a <- function(x) {}

    #' b
    #'
    #' @inheritSection a A
    b <- function(y) {}
  "
  expect_snapshot(. <- roc_proc_text(rd_roclet(), code))
})

# Inherit parameters ------------------------------------------------------

test_that("match_params can ignore . prefix", {
  expect_equal(match_param("a", c("x", "y", "z")), NULL)
  expect_equal(match_param("x", c("x", "y", "z")), "x")
  expect_equal(match_param(".x", c("x", "y", "z")), "x")
  expect_equal(match_param("x", c(".x", ".y", ".z")), ".x")
  expect_equal(match_param(".x", c(".x", ".y", ".z")), ".x")
  expect_equal(match_param(c(".x", "y"), c(".x", ".y", ".z")), c(".x", ".y"))
  expect_equal(match_param(c(".x", "x"), c("x", ".x")), c(".x", "x"))
  expect_equal(match_param(c(".x", "x"), "x"), "x")
  expect_equal(match_param("x", c(".x", "x")), c("x", ".x"))
})

test_that("multiple @inheritParam tags gathers all params", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #'
    #' @param x X
    a <- function(x) {}

    #' B
    #'
    #' @param y Y
    b <- function(y) {}

    #' C
    #'
    #' @inheritParams a
    #' @inheritParams b
    c <- function(x, y) {}
    "
  )

  params <- out[["c.Rd"]]$get_value("param")
  expect_equal(length(params), 2)

  expect_equal(params[["x"]], "X")
  expect_equal(params[["y"]], "Y")
})

test_that("multiple @inheritParam tags gathers all params", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #'
    #' @param x X
    a <- function(x) {}

    #' B
    #'
    #' @param .y Y
    b <- function(.y) {}

    #' C
    #'
    #' @inheritParams a
    #' @inheritParams b
    c <- function(.x, y) {}
    "
  )[[3]]
  expect_equal(out$get_value("param"), c(.x = "X", y = "Y"))
})

test_that("@inheritParam preserves mixed names", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #' @param .x,x X
    a <- function(x, .x) {}

    #' B
    #' @inheritParams a
    b <- function(x, .x) {}
  "
  )[[2]]

  expect_equal(out$get_value("param"), c(".x,x" = "X"))
})

test_that("can inherit from same arg twice", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #'
    #' @param x X
    a <- function(x) {}

    #' B
    #'
    #' @inheritParams a
    b <- function(x) {}

    #' C
    #'
    #' @inheritParams a
    #' @rdname b
    c <- function(.x) {}
    "
  )[[2]]
  expect_equal(out$get_value("param"), c("x,.x" = "X"))
})

test_that("@inheritParams can inherit from inherited params", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' C
    #'
    #' @inheritParams b
    c <- function(x) {}

    #' B
    #'
    #' @inheritParams a
    b <- function(x) {}

    #' A.
    #'
    #' @param x X
    a <- function(x) {}
    "
  )

  expect_equal(out[["c.Rd"]]$get_value("param"), c(x = "X"))
})

test_that("multiple @inheritParam inherits from existing topics", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' My mean
    #'
    #' @inheritParams base::mean
    mymean <- function(x, trim) {}"
  )[[1]]
  params <- out$get_value("param")
  expect_equal(length(params), 2)
  expect_equal(sort(names(params)), c("trim", "x"))
})


test_that("@inheritParam can inherit multivariable arguments", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A
    #' @param x,y X and Y
    A <- function(x, y) {}

    #' B
    #'
    #' @inheritParams A
    B <- function(x, y) {}"
  )[[2]]
  expect_equal(out$get_value("param"), c("x,y" = "X and Y"))

  # Even when the names only match without .
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A
    #' @param x,y X and Y
    A <- function(x, y) {}

    #' B
    #'
    #' @inheritParams A
    B <- function(.x, .y) {}"
  )[[2]]
  expect_equal(out$get_value("param"), c(".x,.y" = "X and Y"))
})

test_that("@inheritParam only inherits exact multiparam matches", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A
    #' @param x,y X and Y
    A <- function(x, y) {}

    #' B
    #'
    #' @inheritParams A
    B <- function(x) {}"
  )[[2]]
  expect_equal(out$get_value("param"), NULL)
})

test_that("@inheritParams inherits params documented with dots (#1718)", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A
    #' @param a A variable.
    #' @param b,\\dots Parameters to pass.
    A <- function(a, b, ...) {}

    #' B
    #' @inheritParams A
    B <- function(a, b, ...) {}
    "
  )
  expect_equal(
    out[[2]]$get_value("param"),
    c("a" = "A variable.", "b,..." = "Parameters to pass.")
  )
})

test_that("@inheritParam understands compound docs", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' Title
    #'
    #' @param x x
    #' @param y x
    x <- function(x, y) {}

    #' Title
    #'
    #' @inheritParams x
    #' @param y y
    y <- function(x, y) {}"
  )[[2]]
  params <- out$get_value("param")
  expect_equal(params, c(x = "x", y = "y"))
})

test_that("warned if no params need documentation", {
  code <- "
    #' Title
    #'
    #' @param x x
    #' @param y x
    #' @inheritParams foo
    x <- function(x, y) {}
  "
  expect_snapshot(. <- roc_proc_text(rd_roclet(), code))
})

test_that("argument order, also for incomplete documentation", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #'
    #' @param y Y
    #' @param x X
    a <- function(x, y) {}

    #' B
    #'
    #' @param y Y
    b <- function(x, y) {}

    #' C
    #'
    #' @param x X
    c <- function(x, y) {}

    #' D
    #'
    #' @inheritParams b
    #' @param z Z
    d <- function(x, y, z) {}

    #' E
    #'
    #' @inheritParams c
    #' @param y Y
    e <- function(x, y, z) {}
  "
  )

  expect_equal(out[["a.Rd"]]$get_value("param"), c(x = "X", y = "Y"))
  expect_equal(out[["b.Rd"]]$get_value("param"), c(y = "Y"))
  expect_equal(out[["c.Rd"]]$get_value("param"), c(x = "X"))
  expect_equal(out[["d.Rd"]]$get_value("param"), c(y = "Y", z = "Z"))
  expect_equal(out[["e.Rd"]]$get_value("param"), c(x = "X", y = "Y"))
})

test_that("argument order with @inheritParam", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #'
    #' @param x X
    #' @param y Y
    a <- function(x, y) {}

    #' B1
    #'
    #' @param y B
    #' @inheritParams a
    b1 <- function(x, y) {}

    #' B2
    #'
    #' @inheritParams a
    #' @param y B
    b2 <- function(x, y) {}

    #' C1
    #'
    #' @param x C
    #' @inheritParams a
    c1 <- function(x, y) {}

    #' C2
    #'
    #' @inheritParams a
    #' @param x C
    c2<- function(x, y) {}
    "
  )

  expect_equal(out[["b1.Rd"]]$get_value("param"), c(x = "X", y = "B"))
  expect_equal(out[["b2.Rd"]]$get_value("param"), c(x = "X", y = "B"))
  expect_equal(out[["c1.Rd"]]$get_value("param"), c(x = "C", y = "Y"))
  expect_equal(out[["c2.Rd"]]$get_value("param"), c(x = "C", y = "Y"))
})


test_that("inherit params ... named \\dots", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' Foo
    #'
    #' @param x x
    #' @param \\dots foo
    foo <- function(x, ...) {}

    #' Bar
    #'
    #' @inheritParams foo
    #' @param \\dots bar
    bar <- function(x=1, ...) {}
  "
  )[[2]]

  expect_equal(
    out$get_value("param"),
    c(x = "x", "\\dots" = "bar")
  )
})

# inheritParams argument filtering ----------------------------------------

test_that("@inheritParams can include specific args", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #'
    #' @param x X
    #' @param y Y
    #' @param z Z
    a <- function(x, y, z) {}

    #' B
    #'
    #' @inheritParams a x z
    b <- function(x, y, z) {}
    "
  )[[2]]

  params <- out$get_value("param")
  expect_equal(params, c(x = "X", z = "Z"))
})

test_that("@inheritParams can exclude specific args", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #'
    #' @param x X
    #' @param y Y
    #' @param z Z
    a <- function(x, y, z) {}

    #' B
    #'
    #' @inheritParams a -y
    b <- function(x, y, z) {}
    "
  )[[2]]

  params <- out$get_value("param")
  expect_equal(params, c(x = "X", z = "Z"))
})

test_that("@inheritParams filtering works with external packages", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' My mean
    #'
    #' @inheritParams base::mean -na.rm
    mymean <- function(x, trim, na.rm) {}"
  )[[1]]

  params <- out$get_value("param")
  expect_true("trim" %in% names(params))
  expect_false("na.rm" %in% names(params))
})

test_that("multiple @inheritParams can each filter args (#1879)", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #'
    #' @param x X
    #' @param y Y
    a <- function(x, y) {}

    #' B.
    #'
    #' @param z Z
    #' @param w W
    b <- function(z, w) {}

    #' C
    #'
    #' @inheritParams a x
    #' @inheritParams b -w
    c <- function(x, y, z, w) {}
    "
  )[[3]]

  params <- out$get_value("param")
  expect_equal(params, c(x = "X", z = "Z"))
})

test_that("@inheritParams filters are unioned for a repeated source", {
  filter <- function(...) {
    tags <- paste0("    #' @inheritParams ", c(...), collapse = "\n")
    out <- roc_proc_text(
      rd_roclet(),
      paste0(
        "
    #' A.
    #'
    #' @param x X
    #' @param y Y
    #' @param z Z
    a <- function(x, y, z) {}

    #' B
    #'
",
        tags,
        "
    b <- function(x, y, z) {}
    "
      )
    )[[2]]
    out$get_value("param")
  }

  expect_equal(filter("a x", "a z"), c(x = "X", z = "Z"))
  expect_equal(filter("a x", "a -y"), c(x = "X", z = "Z"))
  # Each tag selects independently, so the order of tags doesn't matter
  expect_equal(filter("a -y", "a x"), c(x = "X", z = "Z"))
  expect_equal(filter("a x", "a -x"), c(x = "X", y = "Y", z = "Z"))
  # An unfiltered tag selects everything
  expect_equal(filter("a x", "a"), c(x = "X", y = "Y", z = "Z"))
  expect_equal(filter("a", "a x"), c(x = "X", y = "Y", z = "Z"))
})

test_that("@inheritParams without args still works", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' A.
    #'
    #' @param x X
    #' @param y Y
    a <- function(x, y) {}

    #' B
    #'
    #' @inheritParams a
    b <- function(x, y) {}
    "
  )[[2]]

  params <- out$get_value("param")
  expect_equal(params, c(x = "X", y = "Y"))
})

# inheritDotParams --------------------------------------------------------

test_that("can inherit all from single function", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' Foo
    #'
    #' @param x x
    #' @param y y
    foo <- function(x, y) {}

    #' Bar
    #'
    #' @inheritDotParams foo
    bar <- function(...) {}
  "
  )[[2]]

  expect_snapshot_output(test_path("test-rd-inherit-dots.txt"))
})

test_that("does not produce multiple ... args", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' Foo
    #'
    #' @inheritParams bar
    #' @inheritDotParams baz
    foo <- function(x, ...) {}

    #' Bar
    #'
    #' @param x x
    #' @param ... dots
    bar <- function(x, ...) {}

    #' Baz
    #'
    #' @param y y
    #' @param z z
    baz <- function(y, z) {}
  "
  )[[1]]

  expect_snapshot_output(test_path("test-rd-inherit-dots-inherit.txt"))
})

test_that("can inherit dots from several functions", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' Foo
    #'
    #' @param x x
    #' @param y y1
    foo <- function(x, y) {}

    #' Bar
    #'
    #' @param y y2
    #' @param z z
    bar <- function(z) {}

    #' Foobar
    #'
    #' @inheritDotParams foo
    #' @inheritDotParams bar
    foobar <- function(...) {}
  "
  )[[3]]

  expect_snapshot_output(out$get_section("param"))
})

test_that("inheritDotParams does not add already-documented params", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' Wrapper around original
    #'
    #' @inherit original
    #' @inheritDotParams original
    #' @param y some more specific description
    #' @export
    wrapper <- function(x = 'some_value', y = 'some other value', ...) {
      original(x = x, y = y, ...)
    }

    #' Original function
    #'
    #' @param x x description
    #' @param y y description
    #' @param z z description
    #' @export
    original <- function(x, y, z, ...) {}
  "
  )[[1]]

  params <- out$get_value("param")
  dot_param <- params[["..."]]
  expect_named(params, c("x", "y", "..."))
  expect_false(grepl("item{x}{x description}", dot_param, fixed = TRUE))
  expect_false(grepl("item{y}{y description}", dot_param, fixed = TRUE))
  expect_match(dot_param, "item{\\code{z}}{z description}", fixed = TRUE)
})

test_that("useful error for bad inherits", {
  text <- "
    #' Foo
    #'
    #' @param x x
    #' @param y y
    foo <- function(x, y) {}

    #' Bar
    #'
    #' @inheritDotParams foo -z
    bar <- function(...) {}
  "
  expect_snapshot(. <- roc_proc_text(rd_roclet(), text))
})

test_that("warns when no params to inherit (#1671)", {
  text <- "
    #' Foo
    #'
    #' @param ... not used
    foo <- function(...) {}

    #' Bar
    #'
    #' @param y y
    #' @inheritDotParams foo
    bar <- function(y, ...) {}
  "
  expect_snapshot(out <- roc_proc_text(rd_roclet(), text))
  expect_false("..." %in% names(out[["bar.Rd"]]$get_value("param")))
})

test_that("inheritDotParams matches when doc uses dotted name but formal doesn't (#1826)", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' Foo
    #'
    #' @param x x
    #' @param .y,y doc for y
    foo <- function(x, y) {}

    #' Bar
    #'
    #' @inheritDotParams foo x y
    bar <- function(...) {}
  "
  )[[2]]

  dot_param <- out$get_value("param")[["..."]]
  expect_match(dot_param, "item{\\code{y}}", fixed = TRUE)
})

test_that("inheritDotParams uses all documented params, not just formals (#1840)", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' My mean
    #'
    #' @inheritDotParams base::mean
    mymean <- function(x, ...) {}
  "
  )[[1]]

  dot_param <- out$get_value("param")[["..."]]
  expect_match(dot_param, "\\code{trim}", fixed = TRUE)
  expect_match(dot_param, "\\code{na.rm}", fixed = TRUE)
})

test_that("inheritDotParams warns when source not found (#1602)", {
  text <- "
    #' Test
    #' @inheritDotParams format
    test = function(...) {}
  "
  expect_snapshot(. <- roc_proc_text(rd_roclet(), text))
})

# inherit everything ------------------------------------------------------

test_that("can inherit all from single function", {
  out <- roc_proc_text(
    rd_roclet(),
    "
    #' Foo
    #'
    #' Description
    #'
    #' Details
    #'
    #' @param x x
    #' @param y y
    #' @author Hadley
    #' @source my mind
    #' @note my note
    #' @format my format
    #' @examples
    #' x <- 1
    foo <- function(x, y) {}

    #' @inherit foo
    bar <- function(x, y) {}
  "
  )[[2]]

  expect_named(out$get_value("param"), c("x", "y"))
  expect_equal(out$get_value("title"), "Foo")
  expect_equal(out$get_value("description"), "Description")
  expect_equal(out$get_value("details"), "Details")
  expect_equal(out$get_value("examples"), rd("x <- 1"))
  expect_equal(out$get_value("author"), "Hadley")
  expect_equal(out$get_value("source"), "my mind")
  expect_equal(out$get_value("format"), "my format")
  expect_equal(out$get_value("note"), "my note")
})


# get_rd() -----------------------------------------------------------------

test_that("useful warnings if can't find topics", {
  expect_snapshot({
    get_rd("notinstalled::pkg", source = "source")
    get_rd("base::doesntexist", source = "source")
    get_rd("doesntexist", RoxyTopics$new(), source = "source")
  })
})

test_that("can find section in existing docs", {
  out <- find_sections(get_rd("base::attach"))
  expect_equal(out$title, "Good practice")
})