tests/testthat/test-rd-inherit.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]]

  verify_output(
    test_path("test-rd-inherit-link.txt"),
    {
      "\\link{} should include [digest]"
      out$get_section("param")
    }
  )
})

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

test_that("warns on unknown inherit type", {
  expect_warning(
    parse_text("
      #' @inherit fun blah
      NULL
    "),
    "Unknown inherit type: blah"
  )
})

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

  expect_equal(
    block_get_tag_value(block, "inherit")$fields,
    c(
      "params", "return", "title", "description", "details", "seealso",
      "sections", "references", "examples", "author", "source"
    )
  )
})

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")
})

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

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) {}
    ")

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

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


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 cope with multivariable argument definitions", {
  out <- roc_proc_text(rd_roclet(), "
                       #' My merge
                       #'
                       #' @inheritParams base::merge
                       mymerge <- function(x, y) {}")[[1]]
  params <- out$get_value("param")
  expect_equal(length(params), 2)
  expect_equal(sort(names(params)), c("x", "y"))
})

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_warning(roc_proc_text(rd_roclet(), code), "no parameters to inherit")
})

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")
  )

})

# 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]]

  verify_output(
    test_path("test-rd-inherit-dots.txt"),
    out$get_section("param")
  )
})

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]]

  verify_output(
    test_path("test-rd-inherit-dots-inherit.txt"),
    out$get_section("param")
  )
})

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]]

  verify_output(
    test_path("test-rd-inherit-dots-multi.txt"),
    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)
})

# 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
    #' @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")
})


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

test_that("useful warnings if can't find topics", {
  expect_warning(get_rd("base2::attach"), "Can't find package")
  expect_warning(get_rd("base::function_not_found"), "Can't find help topic")
  expect_warning(get_rd("function", RoxyTopics$new()), "Can't find help topic")
})

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

# find_params -------------------------------------------------------------

test_that("find_params parses input", {
  params <- find_params("utils::`?`", NULL)
  expect_equal(names(params), c("topic", "type"))
})

Try the roxygen2 package in your browser

Any scripts or data that you put into this service are public.

roxygen2 documentation built on Sept. 8, 2021, 9:08 a.m.