roxygen2: In-Line Documentation for R

test_that("end-to-end NAMESPACE generation works", {
  path <- local_package_copy(test_path("testNamespace"))

  suppressMessages(roxygenise(path))
  withr::defer(pkgload::unload("testNamespace"))

  ns <- read_lines(file.path(path, "NAMESPACE"))
  expect_equal(ns, c(
    "# Generated by roxygen2: do not edit by hand",
    "",
    "export(f)",
    "export(g)"
  ))
})

# @export -----------------------------------------------------------------

test_that("export quote object name appropriate", {
  out <- roc_proc_text(namespace_roclet(), "#' @export\na <- function(){}")
  expect_equal(out, 'export(a)')

  out <- roc_proc_text(namespace_roclet(), "#' @export\n`+` <- function(){}")
  expect_equal(out, 'export("+")')

  out <- roc_proc_text(namespace_roclet(), "#' @export\n`\\`` <- function(){}")
  expect_equal(out, 'export("`")')
})

test_that("export parameter overrides default", {
  out <- roc_proc_text(namespace_roclet(), "#' @export b\na <- function(){}")
  expect_equal(out, 'export(b)')
})

test_that("multiple export parameters generate multiple exports", {
  out <- roc_proc_text(namespace_roclet(), "
    #' @export a b
    a <- function(){}")
  expect_equal(out, c('export(a)', 'export(b)'))
})

test_that("export trimmed before line test", {
  out <- roc_proc_text(namespace_roclet(), "
    #' @export
    #'
    a <- function(){}")
  expect_equal(out, 'export(a)')
})


test_that("export detects S4 class", {
  out <- roc_proc_text(namespace_roclet(), "#' @export\nsetClass('a')")
  expect_equal(out, 'exportClasses(a)')
})

test_that("exports constructor function if created", {
  out <- roc_proc_text(namespace_roclet(), "#' @export\na <- setClass('a')")
  expect_equal(out, c('export(a)', 'exportClasses(a)'))
})

test_that("export detects S4 generic", {
  out <- roc_proc_text(namespace_roclet(), "
    #' @export
    setGeneric('foo', function(x) standardGeneric('foo'))
  ")
  expect_equal(out, 'export(foo)')
})


test_that("export detects S3 method", {
  out <- roc_proc_text(namespace_roclet(), "#' @export\nmean.foo <- function(x) 'foo'")
  expect_equal(out, 'S3method(mean,foo)')
})

test_that("export handles non-syntactic names", {
  out <- roc_proc_text(namespace_roclet(),  "
    #' @export
    `mean.foo-bar` <- function(x) 'foo'
  ")
  expect_equal(out, "S3method(mean,\"foo-bar\")")

  out <- roc_proc_text(namespace_roclet(),  "
    `foo-bar` <- function(x) UseMethod('foo-bar')
    #' @export
    `foo-bar.integer` <- function(x) 'foo'
  ")
  expect_equal(out, "S3method(\"foo-bar\",integer)")
})

test_that("@exportS3method generates fully automatically", {
  out <- roc_proc_text(namespace_roclet(),"
    #' @exportS3Method
    mean.foo <- function(x) 'foo'
  ")
  expect_equal(out, "S3method(mean,foo)")

  block <- "
    #' @exportS3Method
    f <- function(x) 'foo'
  "
  expect_snapshot(. <- roc_proc_text(namespace_roclet(), block))
})

test_that("@exportS3methd can create literal directive", {
  out <- roc_proc_text(namespace_roclet(),
    "#' @exportS3Method base::mean foo
    NULL
  ")
  expect_equal(out, "S3method(base::mean,foo)")
})

test_that("@exportS3method can extract class from generic", {
  out <- roc_proc_text(namespace_roclet(), "
    #' @exportS3Method pkg::foo
    foo.bar <- function(x) 'foo'
  ")
  expect_equal(out, "S3method(pkg::foo,bar)")

  block <- "
    #' @exportS3Method pkg_foo
    foo.bar <- function(x) 'foo'
  "
  expect_snapshot(. <- roc_proc_text(namespace_roclet(), block))

  block <- "
    #' @exportS3Method pkg::foo
    foo1.bar <- 10
  "
  expect_snapshot(. <- roc_proc_text(namespace_roclet(), block))

  block <- "
    #' @exportS3Method pkg::foo
    foo1.bar <- function(x) 'foo'
  "
  expect_snapshot(. <- roc_proc_text(namespace_roclet(), block))
})

test_that("exportClass overrides default class name", {
  out <- roc_proc_text(namespace_roclet(), "#' @exportClass b\nsetClass('a')")
  expect_equal(out, 'exportClasses(b)')
})

test_that("export detects method name", {
  out <- roc_proc_text(namespace_roclet(), "
    #' @export\n
    setMethod('max', 'a', function(x, ...) x[1])")
  expect_equal(out, 'exportMethods(max)')
})

test_that("export method escapes if needed", {
  out <- roc_proc_text(namespace_roclet(), "
    setGeneric('x<-', function(x, value) standardGeneric('x<-'))
    #' @export\n
    setMethod('x<-', 'a', function(x, value) value)")
  expect_equal(out, 'exportMethods("x<-")')
})

test_that("export uses name if no object present", {
  out <- roc_proc_text(namespace_roclet(), "
    #' Title
    #'
    #' @export
    #' @name x
    NULL
  ")
  expect_equal(out, 'export(x)')
})

test_that("default export uses exportClass for RC objects", {
  out <- roc_proc_text(namespace_roclet(), "
    #' Title
    #'
    #' @export
    x <- setRefClass('X')
  ")
  expect_equal(out, 'exportClasses(X)')
})

test_that("exportMethod overrides default method name", {
  out <- roc_proc_text(namespace_roclet(), "
    #' @exportMethod c
    setMethod('max', 'a', function(x, ...) x[1])")
  expect_equal(out, 'exportMethods(c)')
})

test_that("other namespace tags produce correct output", {
  out <- roc_proc_text(namespace_roclet(), "
    #' @exportPattern test
    #' @import test
    #' @importFrom test test1 test2
    #' @importClassesFrom test test1 test2
    #' @importMethodsFrom test test1 test2
    NULL")

  expect_equal(sort(out), sort(c(
    "exportPattern(test)",
    "import(test)",
    "importFrom(test,test1)",
    "importFrom(test,test2)",
    "importClassesFrom(test,test1)",
    "importClassesFrom(test,test2)",
    "importMethodsFrom(test,test1)",
    "importMethodsFrom(test,test2)"
  )))
})

test_that("import directives for current package are ignored", {
  withr::local_envvar(c("ROXYGEN_PKG" = "ignored"))

  out <- roc_proc_text(namespace_roclet(), "
    #' @import ignored
    #' @import test ignored test2
    #' @importFrom ignored test1 test2
    #' @importClassesFrom ignored test1 test2
    #' @importMethodsFrom ignored test1 test2
    NULL")

  expect_equal(sort(out), sort(c(
    "import(test)",
    "import(test2)"
  )))
})

test_that("poorly formed importFrom throws error", {
  block <- "
    #' @importFrom test
    NULL
  "
  expect_snapshot(. <- roc_proc_text(namespace_roclet(), block))
})

test_that("multiline importFrom parsed correctly", {
  out <- roc_proc_text(namespace_roclet(), "
    #' @importFrom test test1
    #'   test2
    NULL
  ")
  expect_equal(sort(out), sort(c(
    "importFrom(test,test1)",
    "importFrom(test,test2)"
  )))
})

test_that("useDynLib imports only selected functions", {
  out <- roc_proc_text(namespace_roclet(), "
    #' @useDynLib test
    #' @useDynLib test a
    #' @useDynLib test a b
    NULL")

    expect_equal(sort(out), sort(
      c("useDynLib(test)", "useDynLib(test,a)", "useDynLib(test,b)")))
})

test_that("useDynLib doesn't quote if comma present", {
  out <- roc_proc_text(namespace_roclet(), "
    #' @useDynLib test, .registration = TRUE
    NULL")

  expect_equal(sort(out), "useDynLib(test, .registration = TRUE)")
})

test_that("empty NAMESPACE generates zero-length vector", {
  base_path <- test_path("empty")

  env <- pkgload::load_all(base_path, quiet = TRUE)$env
  withr::defer(pkgload::unload("empty"))

  blocks <- parse_package(base_path, env = env)

  results <- roclet_process(namespace_roclet(), blocks, env = env, base_path)
  expect_equal(results, character())
})

test_that("can regenerate NAMESPACE even if its broken", {
  path <- local_package_copy(test_path("broken-namespace"))
  expect_snapshot(update_namespace_imports(path))

  expect_equal(
    read_lines(file.path(path, "NAMESPACE")),
    c(
      "# Generated by roxygen2: do not edit by hand",
      "",
      "importFrom(stats,median)"
    )
  )
})

# Raw ---------------------------------------------------------------------

test_that("rawNamespace must be valid code", {
  block <- "
    #' @rawNamespace a +
    NULL
  "
  expect_snapshot(. <- roc_proc_text(namespace_roclet(), block))
})

test_that("rawNamespace inserted unchanged", {
  out <- roc_proc_text(namespace_roclet(), "
    #' @name a
    #' @rawNamespace xyz
    #'   abc
    NULL")

  expect_equal(out, "xyz\n  abc")
})

test_that("rawNamespace does not break idempotency", {
  test_pkg <- test_path("testRawNamespace")
  NAMESPACE <- file.path(test_pkg, "NAMESPACE")

  lines_orig <- read_lines(NAMESPACE)

  expect_no_error(roxygenize(test_pkg, namespace_roclet()))

  # contents unchanged
  expect_equal(read_lines(NAMESPACE), lines_orig)
})

# @evalNamespace ----------------------------------------------------------

test_that("evalNamespace warns for bad code", {
  block <- "
    #' @evalNamespace a +
    #' @name a
    #' @title a
    NULL
  "
  expect_snapshot(. <- roc_proc_text(namespace_roclet(), block))

  block <- "
    #' @evalNamespace stop('Uhoh')
    #' @name a
    #' @title a
    NULL
  "
  expect_snapshot(. <- roc_proc_text(namespace_roclet(), block))

  block <- "
    #' @evalNamespace 1
    #' @name a
    #' @title a
    NULL
  "
  expect_snapshot(. <- roc_proc_text(namespace_roclet(), block))
})

test_that("evalNamespace code is inserted when its value is a string", {
  out1 <- roc_proc_text(namespace_roclet(), "
    nms <- paste(letters[1:3], collapse = ',')
    #' @evalNamespace sprintf('export(%s)', nms)
    #' @name a
    #' @title a
    NULL")
  out2 <- roc_proc_text(namespace_roclet(), "
    nms <- paste(letters[1:3], collapse = ',')
    #' @evalNamespace sprintf('export(%s)',
    #'                        nms)
    #' @name a
    #' @title a
    NULL")

  expect_equal(out1, "export(a,b,c)")
  expect_equal(out2, "export(a,b,c)")
})

test_that("evalNamspace can yield a vector", {
  out <- roc_proc_text(namespace_roclet(), "
    nms <- letters[1:2]
    #' @evalNamespace paste0('export(', nms, ')')
    #' @name a
    #' @title a
    NULL")

  expect_equal(out, c("export(a)", "export(b)"))
})


# helpers -----------------------------------------------------------------

test_that("auto_quote behaves as needed", {
  expect_equal(auto_quote("x"), "x")
  expect_equal(auto_quote("if"), '"if"') # quotes non-syntactic
  expect_equal(auto_quote("'if'"), "'if'") # unless already quoted
})

test_that("can extract non-imports from namespace preserving source", {
  path <- withr::local_tempfile(lines = c(
    "export(x)",
    "import(y)"
  ))
  expect_equal(namespace_exports(path), "export(x)")

  path <- withr::local_tempfile(lines = "export(x, y, z)")
  expect_equal(namespace_exports(path), "export(x, y, z)")

  lines <- c(
    "if (TRUE) {",
    "  import(x, y, z)",
    "}",
    "import(a)",
    "export(b)"
  )
  path <- withr::local_tempfile(lines = lines)
  expect_equal(
    namespace_exports(path),
    c(
      paste(lines[1:3], collapse = "\n"),
      lines[5L]
    )
  )
})

test_that("invalid imports generate correct declarations", {
  # No matched functions --> no output
  block <- "
    #' @importFrom utils InvalidUtilsFunction
    NULL
  "
  expect_message(out <- roc_proc_text(namespace_roclet(), block))
  expect_equal(out, character())

  # Matched functions --> only drop unmatched functions
  block <- "
    #' @importFrom utils head InvalidUtilsFunction
    NULL
  "
  expect_message(out <- roc_proc_text(namespace_roclet(), block))
  expect_equal(out, "importFrom(utils,head)")
})

test_that("invalid imports generate helpful message", {
  block <- "
    #' @importFrom utils head InvalidUtilsFunction1
    NULL
  "
  expect_snapshot(out <- roc_proc_text(namespace_roclet(), block))

  block <- "
    #' @importFrom utils head InvalidUtilsFunction1 InvalidUtilsFunction2
    NULL
  "
  expect_snapshot(out <- roc_proc_text(namespace_roclet(), block))
})

test_that("nothing we can do if package isn't installed", {
  block <- "
    #' @importFrom AnUnknownUnavailablePackage Unchecked
    NULL
  "
  expect_no_message(out <- roc_proc_text(namespace_roclet(), block))
  expect_equal(out, "importFrom(AnUnknownUnavailablePackage,Unchecked)")
})

test_that("non-syntactic imports can use multiple quoting forms", {
  lines <- c(
    "#' @importFrom stringr %>%",
    "#' @importFrom stringr `%>%`",
    "#' @importFrom stringr '%>%'",
    "#' @importFrom stringr \"%>%\"",
    "NULL"
  )

  import <- expect_no_warning(roc_proc_text(namespace_roclet(), lines))
  expect_equal(import, c(
    "importFrom(stringr,\"%>%\")",
    "importFrom(stringr,'%>%')",
    "importFrom(stringr,`%>%`)"
  ))
})

# warn_missing_s3_exports -------------------------------------------------

test_that("warns if S3 method not documented", {
  # Need to manually transform since the srcref is coming from the function;
  # roc_proc_text() uses fake srcrefs for the blocks themselves
  fix_srcref <- function(x) gsub("file[a-z0-9]+", "<text>", x)

  block <- "
      foo <- function(x) UseMethod('foo')
      foo.numeric <- function(x) 1

      mean.myclass <- function(x) 2
    "
  expect_snapshot(
    . <- roc_proc_text(namespace_roclet(), block),
    transform = fix_srcref
  )

  # Works even if method contains {
  block <- "
    foo <- function(x) UseMethod('foo')
    `foo.{` <- function(x) 1
  "
  expect_snapshot(
    . <- roc_proc_text(namespace_roclet(), block),
    transform = fix_srcref
  )
})

test_that("can suppress the warning", {
  block <- "
    #' @exportS3Method NULL
    mean.myclass <- function(x) 1
  "
  expect_silent(out <- roc_proc_text(namespace_roclet(), block))
  expect_equal(out, character())
})


test_that("doesn't warn for potential false postives", {
  roc <- namespace_roclet()
  expect_no_warning({
    roc_proc_text(roc, "foo.numeric <- function(x) 1")
    roc_proc_text(roc, "is.numeric <- function(x) 1")
    roc_proc_text(roc, "as.numeric <- function(x) 1")
  })
})