tests/testthat/test_srcrefs.R

In covtracer: Contextualizing Tests

test_that("srcrefs accepts a package namespace", {
  expect_silent(srcs <- srcrefs(examplepkg_ns))
  expect_true(length(srcs) > 5L)
  expect_true(all(vapply(srcs, class, character(1L)) == "srcref"))
})


test_that("srcrefs accepts an environment", {
  env <- new.env(parent = emptyenv())
  env$a <- env$b <- examplepkg_ns$hypotenuse
  expect_silent(srcs <- srcrefs(env))
  expect_true(length(srcs) == 2L)
  expect_true(all(names(srcs) == c("a", "b")))
  expect_true(all(vapply(srcs, class, character(1L)) == "srcref"))
})


test_that("srcrefs can process S4 methods tables", {
  # extract S3 methods tables and class definitions
  s3_objs <- as.list(examplepkg_ns, all.names = TRUE)
  s3_objs_env <- as.environment(s3_objs[grepl("^.__(T|C)__", names(s3_objs))])

  expect_silent(srcs <- srcrefs(s3_objs_env))
  expect_true(length(srcs) > 1L)

  # expect that the names are reflective of Rd names
  expect_true("names,S4Example-method" %in% names(srcs))
  expect_true(all(vapply(srcs, class, character(1L)) == "srcref"))
})


test_that("srcrefs can process R6 public class methods & fields", {
  # extract Accumulator R6 object, which contains top level public methods & fields
  objs <- as.list(examplepkg_ns, all.names = TRUE)
  expect_true("Accumulator" %in% names(objs))
  r6_objs_env <- as.environment(objs["Accumulator"])

  expect_silent(srcs <- srcrefs(r6_objs_env))
  expect_true(length(srcs) > 0L)

  # expect that all methods have been picked up in srcrefs
  expect_true(any(grepl("# Accumulator\\$initialize", capture.output(srcs))))
  expect_true(any(grepl("# Accumulator\\$add", capture.output(srcs))))

  # expect that the names are reflective of R6 class Rd name
  expect_true(all(names(srcs) == "Accumulator"))
  expect_true(all(vapply(srcs, class, character(1L)) == "srcref"))
})


test_that("srcrefs can process R6 private class methods & fields", {
  # extract Accumulator R6 object, which contains top level public methods & fields
  objs <- as.list(examplepkg_ns, all.names = TRUE)
  expect_true("Person" %in% names(objs))
  r6_objs_env <- as.environment(objs["Person"])

  expect_silent(srcs <- srcrefs(r6_objs_env))
  expect_true(length(srcs) > 0L)

  # expect that all methods have been picked up in srcrefs
  expect_true(any(grepl("# Person\\$initialize", capture.output(srcs))))
  expect_true(any(grepl("# Person\\$print", capture.output(srcs))))

  # expect that the names are reflective of R6 class Rd name
  expect_true(all(names(srcs) == "Person"))
  expect_true(all(vapply(srcs, class, character(1L)) == "srcref"))
})


test_that("srcrefs can process R6 active fields", {
  # extract Accumulator R6 object, which contains top level public methods & fields
  objs <- as.list(examplepkg_ns, all.names = TRUE)
  expect_true("Rando" %in% names(objs))
  r6_objs_env <- as.environment(objs["Rando"])

  expect_silent(srcs <- srcrefs(r6_objs_env))
  expect_true(length(srcs) > 0L)

  # expect that all methods have been picked up in srcrefs
  expect_true(any(grepl("# Rando\\$random", capture.output(srcs))))

  # expect that the names are reflective of R6 class Rd name
  expect_true(all(names(srcs) == "Rando"))
  expect_true(all(vapply(srcs, class, character(1L)) == "srcref"))
})


test_that("srcrefs return lists uses names which can be linked to object docs", {
  srcs <- srcrefs(examplepkg_ns)
  srcnames <- names(as.list(srcs))
  aliases <- unlist(lapply(tools::Rd_db("examplepkg"), tools:::.Rd_get_metadata, "alias"))

  # most object names should be retained (some class objects may not)
  expect_true(any(names(srcs) %in% names(as.list(getNamespace("examplepkg")))))

  # all objects should map to a documented alias (only true if methods redirect to generic)
  expect_true(all(names(srcs) %in% aliases))
})

test_that("srcrefs does not recursve into self-referential envs", {
  env <- new.env()
  env$self <- env
  env$fn <- function(a = 1) {
    print(a)
  }
  expect_length(names(srcrefs(env)), 1L)
})