autotest-control.R
In autotest: Automatic Package Testing

## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set (
    collapse = TRUE,
    warning = TRUE,
    message = TRUE,
    width = 120,
    comment = "#>",
    fig.retina = 2
)

## ----pkg-load-fakey, eval = FALSE, echo = TRUE--------------------------------
# library (autotest)

## ----pkg-lod, eval = TRUE, echo = FALSE, message = FALSE----------------------
devtools::load_all (".", export_all = FALSE)

## ----cor-rd-------------------------------------------------------------------
rd <- tools::Rd_db (package = "stats")
cor_rd <- rd [[grep ("^cor\\.Rd", names (rd))]]

## ----cor-aliases--------------------------------------------------------------
Rd_get_metadata <- utils::getFromNamespace (".Rd_get_metadata", "tools")
Rd_get_metadata (cor_rd, "alias")

## ----Rd2ex-dummy, echo = TRUE, eval = FALSE-----------------------------------
# tools::Rd2ex (cor_rd)

## ----Rd2ex, echo = FALSE, eval = TRUE-----------------------------------------
tools::Rd2ex (cor_rd)

## ----at-cor-notest-dummy, echo = TRUE, eval = FALSE---------------------------
# xf <- autotest_package (package = "stats", functions = "cor")
# print (xf)

## ----print-x, echo = FALSE, collapse = TRUE-----------------------------------
xf <- tibble::tibble (
    type = rep ("dummy", 15L),
    test_name = c (
        rep ("single_char_case", 2L),
        "single_par_as_length_2",
        "return_successful",
        "return_val_described",
        "return_desc_include_class",
        "return_class_matches_desc",
        rep (c ("par_is_documented", "par_matches_doc"), 4)
    ),
    fn_name = rep ("cor", 15L),
    parameter = c (
        rep ("use", 3L),
        rep ("(return object)", 4L),
        rep ("x", 2L),
        rep ("use", 2L),
        rep ("method", 2L),
        rep ("y", 2L)
    ),
    parameter_type = c (
        rep ("single_character", 3L),
        rep ("(return object)", 4L),
        rep (NA_character_, 8L)
    ),
    operation = c (
        "lower-case character parameter",
        "upper-case character parameter",
        "Length 2 vector for length 1 parameter",
        "Check that function successfully returns an object",
        "Check that description has return value",
        "Check whether description of return value specifies class",
        "Compare class of return value with description",
        rep (
            c (
                "Check that parameter is documented",
                "Check that documentation matches class of input parameter"
            ),
            4L
        )
    ),
    content = c (
        rep ("(Should yield same result)", 2L),
        "Should trigger message, warning, or error",
        rep (NA_character_, 12L)
    ),
    test = rep (TRUE, 15L)
)
print (xf)

## ----test-types---------------------------------------------------------------
table (xf$type)

## ----test-warnings------------------------------------------------------------
xf [xf$type != "dummy", c ("fn_name", "parameter", "operation", "content")]

## ----at-cor-test-dummy, echo = TRUE, eval = FALSE-----------------------------
# xt <- autotest_package (
#     package = "stats",
#     functions = "cor",
#     test = TRUE
# )
# print (xt)

## ----print-xt, echo = FALSE, collapse = TRUE----------------------------------
xt1 <- tibble::tibble (
    type = c (rep ("warning", 4L), "diagnostic"),
    test_name = c (rep ("par_matches_docs", 4L), "single_char_case"),
    fn_name = rep ("cor", 5L),
    parameter = c (rep (c ("x", "y"), 2L), "use"),
    parameter_type = c (rep (NA_character_, 4L), "single character"),
    operation = c (
        rep ("Check that documentation matches class of input parameter", 4L),
        "upper-case character parameter"
    ),
    content = c (
        rep (
            "Parameter documentation does not describe class of [integer]",
            2L
        ),
        rep ("Parameter documentation does not describe class of [dist]", 2L),
        "is case dependent"
    ),
    test = rep (TRUE, 5L)
)

## ----xt-operations------------------------------------------------------------
table (xt1$operation)

## ----test_data1-dummy, echo = TRUE, eval = FALSE------------------------------
# types <- autotest_types ()
# types$test [grep ("list_col", types$test_name)] <- FALSE
# xt2 <- autotest_package (
#     package = "stats",
#     functions = "cor",
#     test = TRUE,
#     test_data = types
# )
# print (xt2)

## ----print-xt2, echo = FALSE, eval = TRUE-------------------------------------
xt2 <- tibble::tibble (
    type = c (rep ("warning", 4L), "diagnostic"),
    test_name = c (rep ("par_matches_docs", 4L), "single_char_case"),
    fn_name = rep ("cor", 5L),
    parameter = c (rep (c ("x", "y"), 2L), "use"),
    parameter_type = c (rep (NA_character_, 4L), "single character"),
    operation = c (
        rep ("Check that documentation matches class of input parameter", 4L),
        "upper-case character parameter"
    ),
    content = c (
        rep (
            "Parameter documentation does not describe class of [integer]",
            2L
        ),
        rep ("Parameter documentation does not describe class of [dist]", 2L),
        "is case dependent"
    ),
    test = rep (TRUE, 5L)
)

print (xt2)

## ----test_data2-fakey, echo = TRUE, eval = FALSE------------------------------
# xf <- autotest_package (
#     package = "stats",
#     functions = "cor"
# )
# xf$test [grepl ("list_col", xf$test_name) & xf$fn_name == "var"] <- FALSE
# xt3 <- autotest_package (
#     package = "stats",
#     functions = "cor",
#     test = TRUE,
#     test_data = xf
# )
# print (xt3)

## ----print-xt3, echo = FALSE, eval = TRUE-------------------------------------
xt3 <- tibble::tibble (
    type = c (rep ("warning", 4L), "diagnostic"),
    test_name = c (rep ("par_matches_docs", 4L), "single_char_case"),
    fn_name = rep ("cor", 5L),
    parameter = c (rep (c ("x", "y"), 2L), "use"),
    parameter_type = c (rep (NA_character_, 4L), "single character"),
    operation = c (
        rep ("Check that documentation matches class of input parameter", 4L),
        "upper-case character parameter"
    ),
    content = c (
        rep (
            "Parameter documentation does not describe class of [integer]",
            2L
        ),
        rep ("Parameter documentation does not describe class of [dist]", 2L),
        "is case dependent"
    ),
    test = rep (TRUE, 5L)
)
print (xt3)

## ----testthat-demo-testdata, collapse = TRUE, message = FALSE, echo = TRUE, eval = FALSE----
# library (testthat) # as called in your test suite
# # For example, to switch off vector-to-list-column tests:
# test_data <- autotest_types (notest = "vector_to_list_col")
# test_data$note <- ""
# test_data$note [test_data$test == "vector_to_list_col"] <-
#     "These tests are not applicable because ..."
# expect_success (expect_autotest_testdata (test_data))

## ----testthat-demo-notestdata, collapse = TRUE, echo = TRUE, eval = FALSE-----
# expect_success (expect_autotest_no_testdata ())

## ----testthat-no-err-warn-fakey, collapse = TRUE, echo = TRUE, eval = FALSE----
# library (testthat) # as called in your test suite
# # For example, to switch off vector-to-list-column tests:
# test_data <- autotest_types (notest = "vector_to_list_col")
# x <- autotest_package (
#     package = "stats",
#     functions = "cov",
#     test = TRUE,
#     test_data = test_data
# )
# 
# expect_success (expect_autotest_no_err (x))
# expect_failure (expect_autotest_no_warn (x)) # should expect_success!!

## ----testthat-no-err-warn, collapse = TRUE, echo = FALSE, eval = TRUE---------
library (testthat) # as called in your test suite
# switch off vector-to-list-column tests:
test_data <- autotest_types (notest = "vector_to_list_col")
x <- tibble::tibble (
    type = c (rep ("warning", 2L), rep ("diagnostic", 20L)),
    test_name = c (
        rep ("par_is_demonstrated", 2L),
        "single_int_for_logical",
        rep ("single_char_case", 2L),
        rep ("vector_custom_class", 2L),
        rep ("single_char_case", 15L)
    ),
    fn_name = c ("var", "cov", "var", rep ("cor", 19L)),
    parameter = rep (
        c (
            "use", "y", "na.rm", "use", "method", "x", "x", "method", "use",
            "use", "use"
        ),
        2L
    ),
    parameter_type = c (
        rep (NA_character_, 2L),
        "single logical",
        rep ("single character", 2L),
        rep ("vector", 2L),
        rep ("single character", 15L)
    ),
    operation = c (
        rep ("Check that parameter usage is demonstrated", 2L),
        "Substitute integer values for logical parameter",
        rep ("upper-case character parameter", 2L),
        rep ("Custom class definitions for vector input", 2L),
        rep ("upper-case character parameter", 4L),
        "Custom class definitions for vector input",
        rep ("upper-case character parameter", 6L),
        "Custom class definitions for vector input",
        rep ("upper-case character parameter", 2L),
        "Custom class definitions for vector input"
    ),
    content = c (
        rep ("Examples do not demonstrate usage of this parameter", 2L),
        "(Function call should still work unless explicitly prevented)",
        rep ("is case dependent", 2L),
        rep (
            "Function [cor] errors on vector columns with different classes",
            2L
        ),
        rep ("is case dependent", 4L),
        "Function [cov] errors on vector columns with different classes",
        rep ("is case dependent", 6L),
        "Function [cor] errors on vector columns with different classes",
        rep ("is case dependent", 2L),
        "Function [cor] errors on vector columns with different classes"
    ),
    test = rep (TRUE, 22L)
)


expect_success (expect_autotest_no_err (x))
expect_failure (expect_autotest_no_warn (x)) # should expect_success!!

## ----testthat-demo-fail-fakey, echo = TRUE, eval = FALSE----------------------
# expect_autotest_notes (x)

## ----testthat-demo-success----------------------------------------------------
x$note <- ""
x [grep ("vector_to_list", x$test_name, fixed = TRUE), "note"] <-
    "these tests have been switched off because ..."

expect_success (expect_autotest_notes (x))