diff --git a/.Rbuildignore b/.Rbuildignore index a01807a..9dcf33a 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,3 +1,4 @@ \.github +codecov\.yml LICENSE\.md pkgdown diff --git a/DESCRIPTION b/DESCRIPTION index c43ba2e..62b993d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,10 +16,12 @@ Depends: Imports: utils Suggests: - testthat, - withr, - callr, - roxygen2 + testthat, + withr, + callr, + roxygen2, + spelling Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.1 +Language: en-US diff --git a/NAMESPACE b/NAMESPACE index 447da97..908f117 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,6 @@ # Generated by roxygen2: do not edit by hand -S3method(roxygen2::roxy_tag_parse,roxy_tag_expect) +S3method(roxygen2::roxy_tag_parse,roxy_tag_test) export(fallback_expect_no_error) export(s3_register) export(test_examples_as_testthat) diff --git a/R/opts.R b/R/opts.R index 12f1081..a824eea 100644 --- a/R/opts.R +++ b/R/opts.R @@ -6,8 +6,9 @@ #' #' As long as the `fingerprint` has not changed, the package `DESCRIPTION` will #' be read only once to parse and retrieve configuration options. If the -#' `DESCRIPTION` file is modified or if run from a separate process, the config -#' will be refreshed based on the most recent version of the file. +#' `DESCRIPTION` file is modified or if run from a separate process, the +#' configured settings will be refreshed based on the most recent version of +#' the file. #' #' @param path A path in which to search for a package `DESCRIPTION` #' @param fingerprint An object used to indicate when the cached values have @@ -39,7 +40,7 @@ update_testex_desc <- function(path, fingerprint) { #' @describeIn testex-options #' -#' @return The test options environemnt as a list +#' @return The test options environment as a list #' testex_options <- function(path = package_desc()) { if (is_r_cmd_check()) { diff --git a/R/register-s3.R b/R/register-s3.R index 960f0a1..bb7aebf 100644 --- a/R/register-s3.R +++ b/R/register-s3.R @@ -1,11 +1,11 @@ -# This source code file is licensed under the unlicense license +# This source code file is licensed under the `unlicense` license # https://unlicense.org #' Register a method for a suggested dependency #' #' Generally, the recommend way to register an S3 method is to use the #' `S3Method()` namespace directive (often generated automatically by the -#' `@export` roxygen2 tag). However, this technique requires that the generic +#' `@export` `roxygen2` tag). However, this technique requires that the generic #' be in an imported package, and sometimes you want to suggest a package, #' and only provide a method when that package is loaded. `s3_register()` #' can be called from your package's `.onLoad()` to dynamically register @@ -24,10 +24,10 @@ #' ``` #' #' @section Usage in other packages: -#' To avoid taking a dependency on vctrs, you copy the source of +#' To avoid taking a dependency on `vctrs`, you copy the source of #' [`s3_register()`](https://github.com/r-lib/vctrs/blob/main/R/register-s3.R) #' into your own package. It is licensed under the permissive -#' [unlicense](https://choosealicense.com/licenses/unlicense/) to make it +#' [`unlicense`](https://choosealicense.com/licenses/unlicense/) to make it #' crystal clear that we're happy for you to do this. There's no need to include #' the license or even credit us when using this function. #' @@ -39,7 +39,7 @@ #' in the package environment. #' #' Note that providing `method` can be dangerous if you use -#' devtools. When the namespace of the method is reloaded by +#' `devtools`. When the namespace of the method is reloaded by #' `devtools::load_all()`, the function will keep inheriting from #' the old namespace. This might cause crashes because of dangling #' `.Call()` pointers. diff --git a/R/roxygen2.R b/R/roxygen2.R index 69b95fb..fff9447 100644 --- a/R/roxygen2.R +++ b/R/roxygen2.R @@ -1,47 +1,43 @@ -#' testex replacement for roxygen2 rd roclet +#' [`testex`] `roxygen2` tags #' -#' This roclet aims to be feature compatible with \pkg{roxygen2}'s \code{"rd"} -#' roclet. In addition it supports two new \code{roxygen} tags, \code{@expect} -#' and \code{@testthat}. -#' -#' @return A new `roxygen2` `"rd"` roclet. +#' [`testex`] provides two new `roxygen2` tags, `@test` and `@testthat`. #' #' @section tags: -#' \code{testex} tags are all sub-tags meant to be used within an -#' \code{@examples} block. They should be considered as tags \emph{within} the -#' \code{@examples} block and used to construct blocks of testing code within +#' [testex] tags are all sub-tags meant to be used within an +#' `@examples` block. They should be considered as tags \emph{within} the +#' `@examples` block and used to construct blocks of testing code within #' example code. #' #' \describe{ -#' \item{\code{@expect}: }{ +#' \item{`@test`: }{ #' In-line expectations to test the output of the previous command within an -#' example. If \code{.} is used within the expecation, it will be used to +#' example. If `.` is used within the test expression, it will be used to #' refer to the output of the previous example command. Otherwise, the #' result of the expression is expected to be identical to the previous #' output. #' #' #' @examples #' #' 1 + 2 -#' #' @expect 3 -#' #' @expect . == 3 +#' #' @test 3 +#' #' @test . == 3 #' #' #' #' @examples #' #' 3 + 4 -#' #' @expect identical(., 7) +#' #' @test identical(., 7) #' } #' } #' #' \describe{ -#' \item{\code{@testthat}: }{ -#' Similar to \code{@expect}, \code{@testthat} can be used to make in-line -#' assertions using \pkg{testthat} expectations. \pkg{testthat} expectations +#' \item{`@testthat`: }{ +#' Similar to `@test`, `@testthat` can be used to make in-line +#' assertions using `testthat` expectations. `testthat` expectations #' follow a convention where the first argument is an object to compare #' against an expected value or characteristic. Since the value will always #' be the result of the previous example, this part of the code is #' implicitly constructed for you. #' #' If you want to use the example result elsewhere in your expectation, you -#' can refer to it with a \code{.}. When used in this way, \pkg{testex} will +#' can refer to it with a `.`. When used in this way, [testex] will #' not do any further implicit modification of your expectation. #' #' #' @examples @@ -55,20 +51,20 @@ #' } #' } #' -#' @name testex-roclets +#' @name testex-roxygen-tags NULL #' @importFrom utils head tail -#' @exportS3Method roxygen2::roxy_tag_parse roxy_tag_expect -roxy_tag_parse.roxy_tag_expect <- function(x) { +#' @exportS3Method roxygen2::roxy_tag_parse roxy_tag_test +roxy_tag_parse.roxy_tag_test <- function(x) { x$raw <- x$val <- format_tag_expect_test(x) as_example(x) } #' @importFrom utils head tail -#' @exportS3Method roxygen2::roxy_tag_parse roxy_tag_expect +#' @exportS3Method roxygen2::roxy_tag_parse roxy_tag_test roxy_tag_parse.roxy_tag_testthat <- function(x) { x$raw <- x$val <- format_tag_testthat_test(x) as_example(x) @@ -76,13 +72,13 @@ roxy_tag_parse.roxy_tag_testthat <- function(x) { -#' Convert a Roxygen Tag to an Examples Tag +#' Convert a `roxygen2` Tag to an `@examples` Tag #' #' Allows for converting testing tags into additional `@examples` tags, which #' `roxygen2` will joint together into a single examples section. #' #' @param tag A `roxygen2` tag, whose class should be converted into an -#' examples tag. +#' `@examples` tag. #' @return The tag with an appropriate examples s3 class. #' #' @noRd @@ -95,16 +91,16 @@ as_example <- function(tag) { -#' Format An `@expect` Tag +#' Format An `@test` Tag #' -#' @param tag A `roxygen2` `@expect` tag. +#' @param tag A `roxygen2` `@test` tag. #' @return A formatted string of R documentation `\testonly{}` code. #' #' @noRd #' @keywords internal format_tag_expect_test <- function(tag) { # nolint parsed_test <- parse(text = tag$raw, n = 1, keep.source = TRUE) - test <- populate_expect_dot(parsed_test) + test <- populate_test_dot(parsed_test) n <- first_expr_end(parsed_test) paste0( @@ -116,9 +112,9 @@ format_tag_expect_test <- function(tag) { # nolint ) } -#' Populate An Implicit `@expect` Lambda Function +#' Populate An Implicit `@test` Lambda Function #' -#' When an expect tag does not contain a `.` object, its result is considered +#' When a `@test` tag does not contain a `.` object, its result is considered #' an an implicit test for an identical object. #' #' @param expr A (possibly) implicity lambda function @@ -126,7 +122,7 @@ format_tag_expect_test <- function(tag) { # nolint #' #' @noRd #' @keywords internal -populate_expect_dot <- function(expr) { +populate_test_dot <- function(expr) { if (is.expression(expr)) expr <- expr[[1]] if (!"." %in% all.names(expr)) { expr <- bquote(identical(., .(expr))) @@ -150,7 +146,7 @@ format_tag_testthat_test <- function(tag) { # nolint n <- first_expr_end(parsed_test) test_str <- substring(tag$raw, 1L, n) - nlines <- string_line_count(trimws(test_str, "right")) + nlines <- string_newline_count(trimws(test_str, "right")) lines <- tag$line + c(0L, nlines) src <- paste0(basename(tag$file), ":", lines[[1]], ":", lines[[2]]) @@ -172,9 +168,9 @@ format_tag_testthat_test <- function(tag) { # nolint #' Populate An Implicit `@testthat` Lambda Function #' -#' When a testthat tag does not contain a `.` object, its result is considered -#' an an implicit testthat expectation, which should be injected with a `.` -#' as a first argument. +#' When a `testthat` tag does not contain a `.` object, its result is +#' onsidered an an implicit `testthat` expectation, which should be injected +#' with a `.` as a first argument. #' #' @param expr A (possibly) implicity lambda function #' @return A new expression, injecting a `.` argument if needed. @@ -193,7 +189,7 @@ populate_testthat_dot <- function(expr) { #' Find The Last Character of the First Expression #' -#' @param x A parsed expression with srcref. +#' @param x A parsed expression with [`srcref`]. #' @return An integer representing the character position of the end of the #' first call in a in a parsed expression. #' @@ -209,9 +205,9 @@ first_expr_end <- function(x) { -#' Escape escaped Rd \\testonly strings +#' Escape R Documentation `\\testonly` Strings #' -#' @param x A \code{character} value +#' @param x A `character` value #' @return An escaped string, where any `\` is converted to `\\` #' #' @noRd diff --git a/R/testex.R b/R/testex.R index bb9690e..1ba3519 100644 --- a/R/testex.R +++ b/R/testex.R @@ -5,8 +5,8 @@ #' #' @section Documenting with `testex`: #' -#' `testex` is a simple wrapper around execution that propegates the -#' `.Last.value` returned before running, allowing you to chain expectations +#' `testex` is a simple wrapper around execution that propagates the +#' `.Last.value` returned before running, allowing you to chain tests #' more easily. #' #' ## Use in `Rd` files: @@ -30,24 +30,24 @@ #' #' ## Use with `roxygen2` #' -#' Within a `roxygen2` `@examples` block you can instead use the `@expect` tag +#' Within a `roxygen2` `@examples` block you can instead use the `@test` tag #' which will generate Rd code as shown above. #' #' \preformatted{ #' #' @examples #' #' f <- function(a, b) a + b #' #' f(3, 4) -#' #' @expect is.numeric(.) -#' #' @expect identical(., 7) +#' #' @test is.numeric(.) +#' #' @test identical(., 7) #' } #' -#' @param ... Expressions to evaluated. \code{.} will be replaced with the -#' expression passed to \code{val}, and may be used as a shorthand for the +#' @param ... Expressions to evaluated. `.` will be replaced with the +#' expression passed to `val`, and may be used as a shorthand for the #' last example result. #' @param value A value to test against. By default, this will use the example's -#' \code{.Last.value}. +#' `.Last.value`. #' @param obj An optional object name used to construct a more helpful error -#' message testthat failure message. +#' message `testthat` failure message. #' @param example An option `srcref_key` string used to indicate where the #' relevant example code originated from. #' @param tests An option `srcref_key` string used to indicate where the diff --git a/R/testthat.R b/R/testthat.R index 8dc04ed..88d1975 100644 --- a/R/testthat.R +++ b/R/testthat.R @@ -1,18 +1,18 @@ #' Support for `testthat` example expectations #' #' Various functions that are used to produce a more native `testthat` -#' experience, automatically converting `testex` tests into `testthat` code and +#' experience, automatically converting [testex] tests into `testthat` code and #' executing tests such that they produce informative messages on failure. #' -#' `testex` operates on the previous value produced in example code. This is +#' [testex] operates on the previous value produced in example code. This is #' unlike `testthat` expectations, which expect a value to be provided as a #' first argument. #' -#' To accommodate a more native `testthat` interface, `testex` provides a few -#' convenience functions to make `testex` expectations run more natively within -#' the style of `testthat`. +#' To accommodate a more native `testthat` interface, [testex] provides a few +#' convenience functions to make [testex] expectations run more idiomatically +#' in the style of `testthat`. #' -#' @param ... Expectations to evaluate with \pkg{testthat} +#' @param ... Expectations to evaluate with `testthat` #' @param value A symbol or quote to use to refer to the subject of `testthat` #' tests. #' @inheritParams testex @@ -45,7 +45,7 @@ NULL #' @describeIn testex-testthat #' -#' A flavor of `testex` that will inject `.Last.value` into the first argument +#' A flavor of [testex] that will inject [.Last.value] into the first argument #' of each expression - suitable for using the `expect_*` family of functions #' from `testthat`. Also handles temporarily attaching the `testthat` package. #' @@ -79,16 +79,16 @@ testthat_block <- function(..., value = get_example_value(), obj = NULL, #' #' Retroactively assigns a source file and location to a expectation. This #' allows `testthat` to report an origin for any code that raised an example -#' test failure from the source roxygen code, even though the test code is +#' test failure from the source `roxygen2` code, even though the test code is #' reconstructed from package documentation files. #' -#' @param src A `srcref_key` which is parsed to produce an artificial srcref for -#' the expectation signaled messages. +#' @param src A `srcref_key` which is parsed to produce an artificial [`srcref`] +#' for the expectation signaled messages. #' @param expr An expression to be evaluated. If an `expectation` condition is -#' raised during its evaluation, its srcref is converted to `src`. +#' raised during its evaluation, its [`srcref`] is converted to `src`. #' #' @return The result of evaluating `expr`, or an expectation with appended -#' `srcref` information if an expectation is raised. +#' [`srcref`] information if an expectation is raised. #' #' @export with_srcref <- function(src, expr, envir = parent.frame()) { @@ -139,10 +139,10 @@ fallback_expect_no_error <- function(object, ...) { -#' Execute examples from Rd files as testthat tests +#' Execute examples from Rd files as `testthat` tests #' -#' Reads examples from Rd files and constructs \pkg{testthat}-style tests. -#' \pkg{testthat} expectations are built such that +#' Reads examples from Rd files and constructs `testthat`-style tests. +#' `testthat` expectations are built such that #' #' 1. Each example expression is expected to run without error #' 1. Any `testex` expectations are expected to pass @@ -157,7 +157,7 @@ fallback_expect_no_error <- function(object, ...) { #' #' @param package A package name whose examples should be tested #' @param path Optionally, a path to a source code directory to use. Will only -#' have an effect if parameter \code{package} is missing. +#' have an effect if parameter `package` is missing. #' @param test_dir An option directory where test files should be written. #' Defaults to a temporary directory. #' @param clean Whether the `test_dir` should be removed upon completion of test @@ -165,8 +165,8 @@ fallback_expect_no_error <- function(object, ...) { #' @param overwrite Whether files should be overwritten if `test_dir` already #' exists. Defaults to `TRUE`. #' @param ... Additional argument unused -#' @param reporter A \pkg{testthat} reporter to use. Defaults to the active -#' reporter in the \pkg{testthat} environment or default reporter. +#' @param reporter A `testthat` reporter to use. Defaults to the active +#' reporter in the `testthat` environment or default reporter. #' #' @return The result of [`testthat::source_file()`], after iterating over #' generated test files. @@ -238,11 +238,11 @@ test_examples_as_testthat <- function( #' Test a list of files #' -#' @param files An iterable collection of file paths to test -#' @param context An optional context message to display in testthat reporters +#' @param files A collection of file paths to test +#' @param context An optional context message to display in `testthat` reporters #' @param ... Additional arguments passed to `testhat::source_file` #' -#' @return The result of [`testthat::source_file()`], after iterating over +#' @return The result of [testthat::source_file()], after iterating over #' generated test files. #' #' @keywords internal @@ -253,14 +253,14 @@ test_files <- function(files, context, ...) { -#' Wraps an example expression in a testthat expectation to not error +#' Wraps an example expression in a `testthat` expectation to not error #' -#' @param expr An expr to wrap in a `expect_no_error()` expectation. Uses -#' 'testthat's version if recent enough version is available, or provides +#' @param expr An expression to wrap in a `expect_no_error()` expectation. Uses +#' `testthat`s version if recent enough version is available, or provides #' a fallback otherwise. #' @param value A symbol to use to store the result of `expr` #' -#' @return A [`testthat::test_that()`] call +#' @return A [testthat::test_that()] call #' #' @importFrom utils packageVersion #' @keywords internal diff --git a/R/use.R b/R/use.R index 518e83e..d8d6a21 100644 --- a/R/use.R +++ b/R/use.R @@ -1,14 +1,14 @@ -#' Add `testex` tags and configure package to fully use `testex` features +#' Add [`testex`] tags and configure package to fully use [`testex`] features #' #' @note -#' The testex roxygen tags behave similarly to 'roxygen2' `@examples` tags, -#' with the minor addition of some wrapping code to manage the tests. This +#' The [`testex`] `roxygen2` tags behave similarly to `roxygen2` `@examples` +#' tags, with the minor addition of some wrapping code to manage the tests. This #' means that they will be integrated into your `@examples` and can be #' intermixed between `@examples` tags #' #' @param path A package source code working directory -#' @param check A \code{logical} value indicating whether tests should be -#' executing during \code{R CMD check}. +#' @param check A `logical` value indicating whether tests should be +#' executing during `R CMD check`. #' @param quiet Whether output should be suppressed #' #' @return The result of [`write.dcf()`] upon modifying the package @@ -63,7 +63,7 @@ report <- function(quiet) { -#' Update Roxygen field in DESCRIPTION +#' Update [`roxygen2`] Settings Field in DESCRIPTION #' #' @param desc A parsed DESCRIPTION matrix #' @param report A reporter to aggregate output @@ -122,7 +122,7 @@ update_desc_suggests <- function(desc, report) { desc_update(desc, Suggests = suggests) } -#' Add Config/pkg/options field to DESCRIPTION +#' Add `Config/pkg/options` field to DESCRIPTION #' #' @param desc A parsed DESCRIPTION matrix #' @param options Options to use @@ -155,7 +155,7 @@ update_desc_config_options <- function(desc, options, report) { desc } -#' Add testthat test for running example tests +#' Add `testthat` test for running example tests #' #' @param path A directory path to use as basis for finding testing suite #' @param report A reporter to aggregate output @@ -254,10 +254,10 @@ cliless <- function(..., .envir = parent.frame(), .less = FALSE) { -#' Run examples as testthat expectations +#' Run examples as `testthat` expectations #' #' @param path A package source code working directory -#' @param context A testthat test context to use as the basis for a new test +#' @param context A `testthat` test context to use as the basis for a new test #' filename. #' @param quiet Whether to emit output messages. #' diff --git a/R/utils.R b/R/utils.R index 2706f0c..4359642 100644 --- a/R/utils.R +++ b/R/utils.R @@ -41,7 +41,7 @@ with_attached <- function(ns, expr) { -#' Test whether currently executing R CMD check +#' Test whether currently executing R checks #' #' @return A logical indicating whether `R CMD check` is currently running #' @@ -59,7 +59,7 @@ is_r_cmd_check <- function() { #' @param path A path within a package source or install directory #' @param quiet Whether to suppress output #' -#' @return NULl, invisibly +#' @return NULL, invisibly #' #' @name package-file-helpers #' @keywords internal @@ -133,7 +133,7 @@ package_desc <- function() { -#' `vapply` shorthands +#' `vapply` shorthand alternatives #' #' Simple wrappers around `vapply` for common data types #' @@ -180,8 +180,8 @@ deparse_pretty <- function(expr) { #' Deparse an expression and indent for pretty-printing #' -#' @param x A \code{code} object -#' @param indent An \code{integer} number of spaces or a string to prefix each +#' @param x A `code` object +#' @param indent An `integer` number of spaces or a string to prefix each #' line of the deparsed output. #' #' @return An indented version of the deparsed string from `x`. @@ -198,10 +198,10 @@ deparse_indent <- function(x, indent = 0L) { #' #' @param x A character value #' -#' @return The number of lines in a mult-line string +#' @return The number of newline characters in a multiline string #' #' @keywords internal -string_line_count <- function(x) { +string_newline_count <- function(x) { nchar(gsub("[^\n]", "", x)) } diff --git a/R/utils_rd.R b/R/utils_rd.R index 1314915..6aa58f9 100644 --- a/R/utils_rd.R +++ b/R/utils_rd.R @@ -10,7 +10,6 @@ NULL #' @describeIn testex-rd-example-helpers -#' #' Extract examples tag from an Rd file #' #' @return The examples section of an Rd object @@ -25,7 +24,6 @@ rd_extract_examples <- function(rd) { #' @describeIn testex-rd-example-helpers -#' #' Convert an Rd example to string #' #' @return A formatted Rd example @@ -40,13 +38,12 @@ rd_code_as_string <- function(rd) { #' @describeIn testex-rd-example-helpers -#' #' Split sections of an example into evaluated example code blocks and code -#' blocks wrapped in testonly `Rd_tag`s, reassigning `srcref`s as the example -#' code is split. +#' blocks wrapped in `\testonly` `Rd_tag`s, reassigning [`srcref`]s as the +#' example code is split. #' -#' @return An interlaced list of expressions, either representing evaluable code -#' or tests. The names of the list are either `\\testonly` or `RDCODE` +#' @return An interlaced list of expressions, either representing example +#' code or tests. The names of the list are either `\testonly` or `RDCODE` #' depending on the originating source of the expression. #' split_testonly_as_expr <- function(rd) { @@ -71,7 +68,7 @@ split_testonly_as_expr <- function(rd) { ) code_seg <- lapply(code_seg, rd_code_as_string) - code_seg_lines <- vnapply(code_seg, string_line_count) + code_seg_lines <- vnapply(code_seg, string_newline_count) # filter out any unused lines segment_has_expr <- grepl("\\S", code_seg) @@ -95,9 +92,8 @@ split_testonly_as_expr <- function(rd) { #' @describeIn testex-rd-example-helpers -#' -#' Split sections of an example into lists of `Rd_tag`s. Note that srcrefs are -#' split by line number. If a line is split between two sections, it is +#' Split sections of an example into lists of `Rd_tag`s. Note that [`srcref`]s +#' are split by line number. If a line is split between two sections, it is #' attributed to the first section. As this is used primarily for giving line #' numbers to test messages, this is sufficient for providing test failures #' locations. diff --git a/R/utils_srcref.R b/R/utils_srcref.R index 5f3fd76..c68bafd 100644 --- a/R/utils_srcref.R +++ b/R/utils_srcref.R @@ -1,13 +1,13 @@ -#' Convert a srcref to a character representation +#' Convert a [`srcref`] to a [`character`] representation #' -#' @param x A srcref object -#' @param nloc The number of src locations to use. Defaults to 2, indicating -#' starting and ending line number. -#' @param path A form of filepath to use for the key. One of `"base"` for only -#' the basename of the source filepath, `"root"` for a path relative to a -#' package root directory if found, or `"full"` for the full filepath. +#' @param x A [`srcref`] object +#' @param nloc The number of locations ([`utils::getSrcLocation`]) to use. +#' Defaults to 2, indicating starting and ending line number. +#' @param path A form of file path to use for the key. One of `"base"` for only +#' the basename of the source file path, `"root"` for a path relative to a +#' package root directory if found, or `"full"` for the full file path. #' -#' @return A string hash of a `srcref` +#' @return A string hash of a [srcref] #' #' @keywords internal #' @importFrom utils getSrcref getSrcFilename @@ -42,11 +42,10 @@ srcref_key <- function(x, nloc = 2, path = c("base", "root", "full")) { -#' Convert to srcref +#' Convert to [srcref] #' #' @param x an object to coerce -#' -#' @return A `srcref` +#' @return A [srcref] #' #' @name as.srcref #' @keywords internal @@ -57,8 +56,7 @@ as.srcref <- function(x) { #' @describeIn as.srcref -#' -#' Convert from a `srcref_key` to a sourceref object +#' Convert from a `srcref_key` to a [srcref] object #' as.srcref.character <- function(x) { m <- regexpr("(?.*?)(?(:\\d+)+)", x, perl = TRUE) @@ -68,7 +66,7 @@ as.srcref.character <- function(x) { dimnames = list(x, colnames(s)) ) - filename <- m[,"filename"] + filename <- m[, "filename"] pkgroot <- find_package_root(quiet = TRUE) if (!is.null(pkgroot)) { @@ -86,7 +84,7 @@ as.srcref.character <- function(x) { -#' Build srcLocation from a minimal numeric vector +#' Build a source location from a minimal numeric vector #' #' Build a length four source location from a length two source location. The #' starting column on the first line is assumed to be 1, and the final column is @@ -96,7 +94,7 @@ as.srcref.character <- function(x) { #' @param x A numeric vector of at least length 2 #' @param file A file to use to determine the length of the final line #' -#' @return A numeric vector similar to a `srcLocation` object +#' @return A numeric vector similar to a [`utils::getSrcLocation`] object #' #' @keywords internal srclocs <- function(x, file) { @@ -111,13 +109,13 @@ srclocs <- function(x, file) { -#' Split a srcref into separate srcrefs at specific lines +#' Split a Source Reference at specific lines #' -#' @param sr An original srcref object -#' @param where A numeric vector of line numbers where the srcref should be +#' @param sr An original [srcref] object +#' @param where A numeric vector of line numbers where the [srcref] should be #' split #' -#' @return A list of `srcref` +#' @return A list of [srcref] #' #' @importFrom utils getSrcFilename #' @keywords internal @@ -125,7 +123,7 @@ split_srcref <- function(sr, where) { if (is.null(sr)) return(rep_len(sr, length(where))) file <- utils::getSrcFilename(sr, full.names = TRUE) - # allocate a list of new srcrefs + # allocate a list of new [srcref]s refs <- list() length(refs) <- length(where) @@ -133,7 +131,7 @@ split_srcref <- function(sr, where) { start <- getSrcLocation(sr) where <- start + where - # create new srcrefs of regions, divided by "where" lines + # create new [srcref]s of regions, divided by "where" lines for (i in seq_along(where)) { locs <- srclocs(c(start, where[[i]]), file) refs[[i]] <- srcref(srcfile(file), locs) @@ -145,11 +143,10 @@ split_srcref <- function(sr, where) { -#' Determine the number of source code lines of a given srcref -#' -#' @param x A `srcref` object +#' Determine the number of source code lines of a given [srcref] #' -#' @return The number of lines in the original source of a `srcref` +#' @param x A [srcref] object +#' @return The number of lines in the original source of a [srcref] #' #' @importFrom utils getSrcLocation #' @keywords internal diff --git a/R/zzz.R b/R/zzz.R index afb7cc4..8f24a84 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,4 +1,4 @@ .onLoad <- function(libname, pkgname) { - s3_register("roxygen2::roxy_tag_parse", "roxy_tag_expect") + s3_register("roxygen2::roxy_tag_parse", "roxy_tag_test") s3_register("roxygen2::roxy_tag_parse", "roxy_tag_testthat") } diff --git a/README.md b/README.md index 65454d5..4a50184 100644 --- a/README.md +++ b/README.md @@ -1,27 +1,26 @@ -# `testex` _**test** **ex**amples_ +# `testex` ***test examples*** [![CRAN](https://img.shields.io/cran/v/testex.svg)](https://cran.r-project.org/package=testex) -[![R CMD -check](https://github.com/dgkf/testex/workflows/R-CMD-check/badge.svg)](https://github.com/dgkf/testex/actions?query=workflow%3AR-CMD-check) -[![Codecov](https://img.shields.io/codecov/c/github/dgkf/testex/main.svg)](https://app.codecov.io/gh/dgkf/testex) +[![`R CMD check`](https://github.com/dgkf/testex/workflows/R-CMD-check/badge.svg)](https://github.com/dgkf/testex/actions?query=workflow%3AR-CMD-check) +[![coverage](https://img.shields.io/codecov/c/github/dgkf/testex/main.svg)](https://app.codecov.io/gh/dgkf/testex) Add tests and assertions in-line in examples ## Quick Start -### 1. Add some expectations +### 1. Add some tests! -Adding tests right next to your examples using the roxygen `@expect` tag. +Adding tests right next to your examples using the `roxygen2` `@test` tag. ```r #' Hello, World! #' #' @examples #' hello("World") -#' @expect "Hello, World!" +#' @test "Hello, World!" #' #' hello("darkness my old friend") -#' @expect grepl("darkness", .) +#' @test grepl("darkness", .) #' #' @export hello <- function(who) { @@ -29,10 +28,10 @@ hello <- function(who) { } ``` -### 2. Add the `roclet` +### 2. Add the `roxygen2` tags -To enable this roclet, you'll also need to modify your package's `DESCRIPTION` -to include the `testex::rd` roclet. Adding it is as easy as calling: +To enable the new `roxygen2` tags, you'll also need to modify your package's +`DESCRIPTION`. Adding it is as easy as calling: ```r testex::use_testex() @@ -47,8 +46,7 @@ This will take a few steps to set up your package: ### 3. Configure how you want to run your tests -You could call it a day there if you'd like, but there are a few options if -you'd like to tune your testing workflow. +Alternatively, you can configure how `testex` works yourself. #### Running tests with `testthat` @@ -61,9 +59,9 @@ testex::use_testex_as_testthat() ``` This will add a `tests/testthat/test-testex.R` file to your `testthat` directory -which will re-build and run testthat tests based on examples each time you run -your testing suite. Tests are created to expect that examples execute -successfully and that each example expectation is fulfilled. +which will re-build and run `testthat` tests based on examples each time you run +your testing suite. Tests are created, expecting that examples execute +successfully and that each example test is fulfilled. #### Disabling example checks during `R CMD check` @@ -149,14 +147,13 @@ identity("hello, world") ``` Already `testex` is doing a bit of work to make our lives easier. The -`.Last.value` is propegated to each of the tests and we can use the convenient +`.Last.value` is propagated to each of the tests and we can use the convenient shorthand `.` to refer to the value we want to test. -### Use a `roclet`! +### Use a `roxygen2` tag! -If you're already using `roxygen2`, then things get even easier! You can add in -the `"testex::rd"` roclet (replacing the default `roxygen2` `"rd"` roclet) and -make use of the `@expect` tag. +If you're already using `roxygen2`, then things get even easier! `roxygen2` +can make use of new tags provided by `testex`: ```r #' Hello, World! @@ -164,10 +161,10 @@ make use of the `@expect` tag. #' @examples #' #' hello("World") -#' @expect "Hello, World!" +#' @test "Hello, World!" #' #' hello("darkness my old friend") -#' @expect grepl("darkness", .) +#' @test grepl("darkness", .) #' #' @export hello <- function(who) { @@ -203,15 +200,15 @@ hello <- function(who) { The `@testthat` tag will automatically insert the `.Last.value` from the previous example into the first argument of each expectation. Multiple -consecutive `@testthat` expecations will all test the previous example output. +consecutive `@testthat` expectations will all test the previous example output. -## Roadmap +## Planned Features | | | |---|---| -| Example result propegation using `testex::testex()`| :ballot_box_with_check: | +| Example result propagation using `testex::testex()`| :ballot_box_with_check: | | `DESCRPTION` `Config/testex/options` to disable execution during `R CMD check` | :ballot_box_with_check: | -| `roxygen2` tag `@expect` | :ballot_box_with_check: | +| `roxygen2` tag `@test` | :ballot_box_with_check: | | `roxygen2` tag `@testthat` | :ballot_box_with_check: | | Aggregation with `testthat` test results | :ballot_box_with_check: | | Other ideas? Request a feature! | :thought_balloon: | diff --git a/codecov.yml b/codecov.yml new file mode 100644 index 0000000..04c5585 --- /dev/null +++ b/codecov.yml @@ -0,0 +1,14 @@ +comment: false + +coverage: + status: + project: + default: + target: auto + threshold: 1% + informational: true + patch: + default: + target: auto + threshold: 1% + informational: true diff --git a/inst/pkg.example/R/fn.R b/inst/pkg.example/R/fn.R index d7bd4a3..edd8af5 100644 --- a/inst/pkg.example/R/fn.R +++ b/inst/pkg.example/R/fn.R @@ -44,18 +44,18 @@ fn <- function(x) { #' } #' #' fn_roxygen(value) -#' @expect "testing 1 2 3" +#' @test "testing 1 2 3" #' #' \dontrun{ #' stop("this won't work") #' } #' #' fn_roxygen("testing") -#' @expect grepl("\\d", .) -#' @expect startsWith(., "testing") +#' @test grepl("\\d", .) +#' @test startsWith(., "testing") #' #' fn_roxygen("testing") -#' @expect { +#' @test { #' "testing 1 2 3" #' } #' @@ -83,7 +83,6 @@ fn_roxygen <- function(x) { #' @testthat expect_equal("testing 1 2 3") #' @testthat expect_match("^testing") #' -#' @examples #' fn_roxygen_testthat("testing") #' @testthat expect_equal("testing 1 2 3") #' @testthat expect_match("^testing") @@ -111,8 +110,8 @@ NULL #' #' @examples #' fn_roxygen_multiple1("testing") -#' @expect grepl("\\d", .) -#' @expect startsWith(., "testing") +#' @test grepl("\\d", .) +#' @test startsWith(., "testing") #' #' @export fn_roxygen_multiple1 <- function(x) { @@ -124,8 +123,8 @@ fn_roxygen_multiple1 <- function(x) { #' #' @examples #' fn_roxygen_multiple2("testing") -#' @expect grepl("\\d", .) -#' @expect startsWith(., "testing") +#' @test grepl("\\d", .) +#' @test startsWith(., "testing") #' #' @export fn_roxygen_multiple2 <- function(x) { diff --git a/inst/pkg.example/man/fn_roxygen_testthat.Rd b/inst/pkg.example/man/fn_roxygen_testthat.Rd index 8a8b639..4de2c1b 100644 --- a/inst/pkg.example/man/fn_roxygen_testthat.Rd +++ b/inst/pkg.example/man/fn_roxygen_testthat.Rd @@ -30,13 +30,13 @@ testex::with_srcref("fn.R:84:84", expect_match(., "^testing")) } fn_roxygen_testthat("testing") \testonly{ -testex::testthat_block(test_that("example tests at `fn.R:88:88`", { -testex::with_srcref("fn.R:88:88", expect_equal(., "testing 1 2 3")) +testex::testthat_block(test_that("example tests at `fn.R:87:87`", { +testex::with_srcref("fn.R:87:87", expect_equal(., "testing 1 2 3")) })) } \testonly{ -testex::testthat_block(test_that("example tests at `fn.R:89:89`", { -testex::with_srcref("fn.R:89:89", expect_match(., "^testing")) +testex::testthat_block(test_that("example tests at `fn.R:88:88`", { +testex::with_srcref("fn.R:88:88", expect_match(., "^testing")) })) } } diff --git a/man/as.srcref.Rd b/man/as.srcref.Rd index 957fa6c..2fad87b 100644 --- a/man/as.srcref.Rd +++ b/man/as.srcref.Rd @@ -3,7 +3,7 @@ \name{as.srcref} \alias{as.srcref} \alias{as.srcref.character} -\title{Convert to srcref} +\title{Convert to \link{srcref}} \usage{ as.srcref(x) @@ -13,14 +13,14 @@ as.srcref(x) \item{x}{an object to coerce} } \value{ -A \code{srcref} +A \link{srcref} } \description{ -Convert to srcref +Convert to \link{srcref} } \section{Methods (by class)}{ \itemize{ -\item \code{as.srcref(character)}: Convert from a \code{srcref_key} to a sourceref object +\item \code{as.srcref(character)}: Convert from a \code{srcref_key} to a \link{srcref} object }} \keyword{internal} diff --git a/man/is_r_cmd_check.Rd b/man/is_r_cmd_check.Rd index 2a1119a..cd00f9a 100644 --- a/man/is_r_cmd_check.Rd +++ b/man/is_r_cmd_check.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/utils.R \name{is_r_cmd_check} \alias{is_r_cmd_check} -\title{Test whether currently executing R CMD check} +\title{Test whether currently executing R checks} \usage{ is_r_cmd_check() } @@ -10,6 +10,6 @@ is_r_cmd_check() A logical indicating whether \verb{R CMD check} is currently running } \description{ -Test whether currently executing R CMD check +Test whether currently executing R checks } \keyword{internal} diff --git a/man/package-file-helpers.Rd b/man/package-file-helpers.Rd index 10093df..5ac62c2 100644 --- a/man/package-file-helpers.Rd +++ b/man/package-file-helpers.Rd @@ -22,7 +22,7 @@ directory. Only considered if \code{package} is missing.} \item{package}{A package name} } \value{ -NULl, invisibly +NULL, invisibly A list of package Rd objects, as returned by \code{\link[tools:Rdutils]{tools::Rd_db()}} } diff --git a/man/s3_register.Rd b/man/s3_register.Rd index 4b39c19..9878255 100644 --- a/man/s3_register.Rd +++ b/man/s3_register.Rd @@ -13,7 +13,7 @@ this will be found by looking for a function called \code{generic.class} in the package environment. Note that providing \code{method} can be dangerous if you use -devtools. When the namespace of the method is reloaded by +\code{devtools}. When the namespace of the method is reloaded by \code{devtools::load_all()}, the function will keep inheriting from the old namespace. This might cause crashes because of dangling \code{.Call()} pointers.} @@ -21,7 +21,7 @@ the old namespace. This might cause crashes because of dangling \description{ Generally, the recommend way to register an S3 method is to use the \code{S3Method()} namespace directive (often generated automatically by the -\verb{@export} roxygen2 tag). However, this technique requires that the generic +\verb{@export} \code{roxygen2} tag). However, this technique requires that the generic be in an imported package, and sometimes you want to suggest a package, and only provide a method when that package is loaded. \code{s3_register()} can be called from your package's \code{.onLoad()} to dynamically register @@ -41,10 +41,10 @@ by using "delayed method registration", i.e. placing the following in your } \section{Usage in other packages}{ -To avoid taking a dependency on vctrs, you copy the source of +To avoid taking a dependency on \code{vctrs}, you copy the source of \href{https://github.com/r-lib/vctrs/blob/main/R/register-s3.R}{\code{s3_register()}} into your own package. It is licensed under the permissive -\href{https://choosealicense.com/licenses/unlicense/}{unlicense} to make it +\href{https://choosealicense.com/licenses/unlicense/}{\code{unlicense}} to make it crystal clear that we're happy for you to do this. There's no need to include the license or even credit us when using this function. } diff --git a/man/split_srcref.Rd b/man/split_srcref.Rd index 78ca260..a916537 100644 --- a/man/split_srcref.Rd +++ b/man/split_srcref.Rd @@ -2,20 +2,20 @@ % Please edit documentation in R/utils_srcref.R \name{split_srcref} \alias{split_srcref} -\title{Split a srcref into separate srcrefs at specific lines} +\title{Split a Source Reference at specific lines} \usage{ split_srcref(sr, where) } \arguments{ -\item{sr}{An original srcref object} +\item{sr}{An original \link{srcref} object} -\item{where}{A numeric vector of line numbers where the srcref should be +\item{where}{A numeric vector of line numbers where the \link{srcref} should be split} } \value{ -A list of \code{srcref} +A list of \link{srcref} } \description{ -Split a srcref into separate srcrefs at specific lines +Split a Source Reference at specific lines } \keyword{internal} diff --git a/man/srclocs.Rd b/man/srclocs.Rd index 7fa1ecb..ede7e13 100644 --- a/man/srclocs.Rd +++ b/man/srclocs.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/utils_srcref.R \name{srclocs} \alias{srclocs} -\title{Build srcLocation from a minimal numeric vector} +\title{Build a source location from a minimal numeric vector} \usage{ srclocs(x, file) } @@ -12,7 +12,7 @@ srclocs(x, file) \item{file}{A file to use to determine the length of the final line} } \value{ -A numeric vector similar to a \code{srcLocation} object +A numeric vector similar to a \code{\link[utils:sourceutils]{utils::getSrcLocation}} object } \description{ Build a length four source location from a length two source location. The diff --git a/man/srcref_key.Rd b/man/srcref_key.Rd index fbf4317..d25632d 100644 --- a/man/srcref_key.Rd +++ b/man/srcref_key.Rd @@ -2,24 +2,24 @@ % Please edit documentation in R/utils_srcref.R \name{srcref_key} \alias{srcref_key} -\title{Convert a srcref to a character representation} +\title{Convert a \code{\link{srcref}} to a \code{\link{character}} representation} \usage{ srcref_key(x, nloc = 2, path = c("base", "root", "full")) } \arguments{ -\item{x}{A srcref object} +\item{x}{A \code{\link{srcref}} object} -\item{nloc}{The number of src locations to use. Defaults to 2, indicating -starting and ending line number.} +\item{nloc}{The number of locations (\code{\link[utils:sourceutils]{utils::getSrcLocation}}) to use. +Defaults to 2, indicating starting and ending line number.} -\item{path}{A form of filepath to use for the key. One of \code{"base"} for only -the basename of the source filepath, \code{"root"} for a path relative to a -package root directory if found, or \code{"full"} for the full filepath.} +\item{path}{A form of file path to use for the key. One of \code{"base"} for only +the basename of the source file path, \code{"root"} for a path relative to a +package root directory if found, or \code{"full"} for the full file path.} } \value{ -A string hash of a \code{srcref} +A string hash of a \link{srcref} } \description{ -Convert a srcref to a character representation +Convert a \code{\link{srcref}} to a \code{\link{character}} representation } \keyword{internal} diff --git a/man/srcref_nlines.Rd b/man/srcref_nlines.Rd index 2ea25c4..30e399d 100644 --- a/man/srcref_nlines.Rd +++ b/man/srcref_nlines.Rd @@ -2,17 +2,17 @@ % Please edit documentation in R/utils_srcref.R \name{srcref_nlines} \alias{srcref_nlines} -\title{Determine the number of source code lines of a given srcref} +\title{Determine the number of source code lines of a given \link{srcref}} \usage{ srcref_nlines(x) } \arguments{ -\item{x}{A \code{srcref} object} +\item{x}{A \link{srcref} object} } \value{ -The number of lines in the original source of a \code{srcref} +The number of lines in the original source of a \link{srcref} } \description{ -Determine the number of source code lines of a given srcref +Determine the number of source code lines of a given \link{srcref} } \keyword{internal} diff --git a/man/string_line_count.Rd b/man/string_newline_count.Rd similarity index 63% rename from man/string_line_count.Rd rename to man/string_newline_count.Rd index 2557f38..0393538 100644 --- a/man/string_line_count.Rd +++ b/man/string_newline_count.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R -\name{string_line_count} -\alias{string_line_count} +\name{string_newline_count} +\alias{string_newline_count} \title{Get String Line Count} \usage{ -string_line_count(x) +string_newline_count(x) } \arguments{ \item{x}{A character value} } \value{ -The number of lines in a mult-line string +The number of newline characters in a multiline string } \description{ Get String Line Count diff --git a/man/test_examples_as_testthat.Rd b/man/test_examples_as_testthat.Rd index 2225e83..c82ba4e 100644 --- a/man/test_examples_as_testthat.Rd +++ b/man/test_examples_as_testthat.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/testthat.R \name{test_examples_as_testthat} \alias{test_examples_as_testthat} -\title{Execute examples from Rd files as testthat tests} +\title{Execute examples from Rd files as \code{testthat} tests} \usage{ test_examples_as_testthat( package, @@ -31,16 +31,16 @@ execution. Defaults to \code{TRUE}.} \item{overwrite}{Whether files should be overwritten if \code{test_dir} already exists. Defaults to \code{TRUE}.} -\item{reporter}{A \pkg{testthat} reporter to use. Defaults to the active -reporter in the \pkg{testthat} environment or default reporter.} +\item{reporter}{A \code{testthat} reporter to use. Defaults to the active +reporter in the \code{testthat} environment or default reporter.} } \value{ The result of \code{\link[testthat:source_file]{testthat::source_file()}}, after iterating over generated test files. } \description{ -Reads examples from Rd files and constructs \pkg{testthat}-style tests. -\pkg{testthat} expectations are built such that +Reads examples from Rd files and constructs \code{testthat}-style tests. +\code{testthat} expectations are built such that } \details{ \enumerate{ diff --git a/man/test_files.Rd b/man/test_files.Rd index 1de01dd..a46091d 100644 --- a/man/test_files.Rd +++ b/man/test_files.Rd @@ -7,9 +7,9 @@ test_files(files, context, ...) } \arguments{ -\item{files}{An iterable collection of file paths to test} +\item{files}{A collection of file paths to test} -\item{context}{An optional context message to display in testthat reporters} +\item{context}{An optional context message to display in \code{testthat} reporters} \item{...}{Additional arguments passed to \code{testhat::source_file}} } diff --git a/man/testex-options.Rd b/man/testex-options.Rd index 5123fb7..72fe57e 100644 --- a/man/testex-options.Rd +++ b/man/testex-options.Rd @@ -19,13 +19,14 @@ been invalidated} \value{ The test options environment, invisibly. -The test options environemnt as a list +The test options environment as a list } \description{ As long as the \code{fingerprint} has not changed, the package \code{DESCRIPTION} will be read only once to parse and retrieve configuration options. If the -\code{DESCRIPTION} file is modified or if run from a separate process, the config -will be refreshed based on the most recent version of the file. +\code{DESCRIPTION} file is modified or if run from a separate process, the +configured settings will be refreshed based on the most recent version of +the file. } \section{Functions}{ \itemize{ diff --git a/man/testex-rd-example-helpers.Rd b/man/testex-rd-example-helpers.Rd index 6c2fef2..7631f8e 100644 --- a/man/testex-rd-example-helpers.Rd +++ b/man/testex-rd-example-helpers.Rd @@ -24,8 +24,8 @@ The examples section of an Rd object A formatted Rd example -An interlaced list of expressions, either representing evaluable code -or tests. The names of the list are either \verb{\\\testonly} or \code{RDCODE} +An interlaced list of expressions, either representing example +code or tests. The names of the list are either \verb{\testonly} or \code{RDCODE} depending on the originating source of the expression. A list of Rd tag contents @@ -40,11 +40,11 @@ Rd Example Parsing Helpers \item \code{rd_code_as_string()}: Convert an Rd example to string \item \code{split_testonly_as_expr()}: Split sections of an example into evaluated example code blocks and code -blocks wrapped in testonly \code{Rd_tag}s, reassigning \code{srcref}s as the example -code is split. +blocks wrapped in \verb{\testonly} \code{Rd_tag}s, reassigning \code{\link{srcref}}s as the +example code is split. -\item \code{split_testonly()}: Split sections of an example into lists of \code{Rd_tag}s. Note that srcrefs are -split by line number. If a line is split between two sections, it is +\item \code{split_testonly()}: Split sections of an example into lists of \code{Rd_tag}s. Note that \code{\link{srcref}}s +are split by line number. If a line is split between two sections, it is attributed to the first section. As this is used primarily for giving line numbers to test messages, this is sufficient for providing test failures locations. diff --git a/man/testex-roclets.Rd b/man/testex-roxygen-tags.Rd similarity index 55% rename from man/testex-roclets.Rd rename to man/testex-roxygen-tags.Rd index 9016a5e..f57f880 100644 --- a/man/testex-roclets.Rd +++ b/man/testex-roxygen-tags.Rd @@ -1,55 +1,50 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/roxygen2.R -\name{testex-roclets} -\alias{testex-roclets} -\title{testex replacement for roxygen2 rd roclet} -\value{ -A new \code{roxygen2} \code{"rd"} roclet. -} +\name{testex-roxygen-tags} +\alias{testex-roxygen-tags} +\title{\code{\link{testex}} \code{roxygen2} tags} \description{ -This roclet aims to be feature compatible with \pkg{roxygen2}'s \code{"rd"} -roclet. In addition it supports two new \code{roxygen} tags, \code{@expect} -and \code{@testthat}. +\code{\link{testex}} provides two new \code{roxygen2} tags, \verb{@test} and \verb{@testthat}. } \section{tags}{ -\code{testex} tags are all sub-tags meant to be used within an -\code{@examples} block. They should be considered as tags \emph{within} the -\code{@examples} block and used to construct blocks of testing code within +\link{testex} tags are all sub-tags meant to be used within an +\verb{@examples} block. They should be considered as tags \emph{within} the +\verb{@examples} block and used to construct blocks of testing code within example code. \describe{ -\item{\code{@expect}: }{ +\item{\verb{@test}: }{ In-line expectations to test the output of the previous command within an -example. If \code{.} is used within the expecation, it will be used to +example. If \code{.} is used within the test expression, it will be used to refer to the output of the previous example command. Otherwise, the result of the expression is expected to be identical to the previous output. \if{html}{\out{
}}\preformatted{#' @examples #' 1 + 2 -#' @expect 3 -#' @expect . == 3 +#' @test 3 +#' @test . == 3 #' #' @examples #' 3 + 4 -#' @expect identical(., 7) +#' @test identical(., 7) }\if{html}{\out{
}} } } \describe{ -\item{\code{@testthat}: }{ -Similar to \code{@expect}, \code{@testthat} can be used to make in-line -assertions using \pkg{testthat} expectations. \pkg{testthat} expectations +\item{\verb{@testthat}: }{ +Similar to \verb{@test}, \verb{@testthat} can be used to make in-line +assertions using \code{testthat} expectations. \code{testthat} expectations follow a convention where the first argument is an object to compare against an expected value or characteristic. Since the value will always be the result of the previous example, this part of the code is implicitly constructed for you. If you want to use the example result elsewhere in your expectation, you -can refer to it with a \code{.}. When used in this way, \pkg{testex} will +can refer to it with a \code{.}. When used in this way, \link{testex} will not do any further implicit modification of your expectation. \if{html}{\out{
}}\preformatted{#' @examples diff --git a/man/testex-testthat.Rd b/man/testex-testthat.Rd index 2445558..51aef20 100644 --- a/man/testex-testthat.Rd +++ b/man/testex-testthat.Rd @@ -27,7 +27,7 @@ fallback_expect_no_error(object, ...) tests.} \item{obj}{An optional object name used to construct a more helpful error -message testthat failure message.} +message \code{testthat} failure message.} \item{example}{An option \code{srcref_key} string used to indicate where the relevant example code originated from.} @@ -37,11 +37,11 @@ relevant test code originated from.} \item{envir}{An environment in which the expectations should be evaluated} -\item{src}{A \code{srcref_key} which is parsed to produce an artificial srcref for -the expectation signaled messages.} +\item{src}{A \code{srcref_key} which is parsed to produce an artificial \code{\link{srcref}} +for the expectation signaled messages.} \item{expr}{An expression to be evaluated. If an \code{expectation} condition is -raised during its evaluation, its srcref is converted to \code{src}.} +raised during its evaluation, its \code{\link{srcref}} is converted to \code{src}.} \item{object}{An expression to evaluate} } @@ -49,33 +49,33 @@ raised during its evaluation, its srcref is converted to \code{src}.} The result of evaluating provided expressions The result of evaluating \code{expr}, or an expectation with appended -\code{srcref} information if an expectation is raised. +\code{\link{srcref}} information if an expectation is raised. The value produced by the expectation code } \description{ Various functions that are used to produce a more native \code{testthat} -experience, automatically converting \code{testex} tests into \code{testthat} code and +experience, automatically converting \link{testex} tests into \code{testthat} code and executing tests such that they produce informative messages on failure. } \details{ -\code{testex} operates on the previous value produced in example code. This is +\link{testex} operates on the previous value produced in example code. This is unlike \code{testthat} expectations, which expect a value to be provided as a first argument. -To accommodate a more native \code{testthat} interface, \code{testex} provides a few -convenience functions to make \code{testex} expectations run more natively within -the style of \code{testthat}. +To accommodate a more native \code{testthat} interface, \link{testex} provides a few +convenience functions to make \link{testex} expectations run more idiomatically +in the style of \code{testthat}. } \section{Functions}{ \itemize{ -\item \code{testthat_block()}: A flavor of \code{testex} that will inject \code{.Last.value} into the first argument +\item \code{testthat_block()}: A flavor of \link{testex} that will inject \link{.Last.value} into the first argument of each expression - suitable for using the \verb{expect_*} family of functions from \code{testthat}. Also handles temporarily attaching the \code{testthat} package. \item \code{with_srcref()}: Retroactively assigns a source file and location to a expectation. This allows \code{testthat} to report an origin for any code that raised an example -test failure from the source roxygen code, even though the test code is +test failure from the source \code{roxygen2} code, even though the test code is reconstructed from package documentation files. \item \code{fallback_expect_no_error()}: A \code{testthat} expectation that the provided code can be evaluated without diff --git a/man/testex.Rd b/man/testex.Rd index ee2e982..8d283b8 100644 --- a/man/testex.Rd +++ b/man/testex.Rd @@ -22,7 +22,7 @@ last example result.} \code{.Last.value}.} \item{obj}{An optional object name used to construct a more helpful error -message testthat failure message.} +message \code{testthat} failure message.} \item{example}{An option \code{srcref_key} string used to indicate where the relevant example code originated from.} @@ -44,8 +44,8 @@ A wrapper around \code{stopifnot} that allows you to use \code{.} to refer to \section{Documenting with \code{testex}}{ -\code{testex} is a simple wrapper around execution that propegates the -\code{.Last.value} returned before running, allowing you to chain expectations +\code{testex} is a simple wrapper around execution that propagates the +\code{.Last.value} returned before running, allowing you to chain tests more easily. \subsection{Use in \code{Rd} files:}{ @@ -69,15 +69,15 @@ documentation, which use this function internally. \subsection{Use with \code{roxygen2}}{ -Within a \code{roxygen2} \verb{@examples} block you can instead use the \verb{@expect} tag +Within a \code{roxygen2} \verb{@examples} block you can instead use the \verb{@test} tag which will generate Rd code as shown above. \preformatted{ #' @examples #' f <- function(a, b) a + b #' f(3, 4) -#' @expect is.numeric(.) -#' @expect identical(., 7) +#' @test is.numeric(.) +#' @test identical(., 7) } } } diff --git a/man/use_testex.Rd b/man/use_testex.Rd index eaaf636..131a4cd 100644 --- a/man/use_testex.Rd +++ b/man/use_testex.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/use.R \name{use_testex} \alias{use_testex} -\title{Add \code{testex} tags and configure package to fully use \code{testex} features} +\title{Add \code{\link{testex}} tags and configure package to fully use \code{\link{testex}} features} \usage{ use_testex(path = getwd(), check = TRUE, quiet = FALSE) } @@ -10,7 +10,7 @@ use_testex(path = getwd(), check = TRUE, quiet = FALSE) \item{path}{A package source code working directory} \item{check}{A \code{logical} value indicating whether tests should be -executing during \code{R CMD check}.} +executing during \verb{R CMD check}.} \item{quiet}{Whether output should be suppressed} } @@ -19,11 +19,11 @@ The result of \code{\link[=write.dcf]{write.dcf()}} upon modifying the package \code{DESCRIPTION} file. } \description{ -Add \code{testex} tags and configure package to fully use \code{testex} features +Add \code{\link{testex}} tags and configure package to fully use \code{\link{testex}} features } \note{ -The testex roxygen tags behave similarly to 'roxygen2' \verb{@examples} tags, -with the minor addition of some wrapping code to manage the tests. This +The \code{\link{testex}} \code{roxygen2} tags behave similarly to \code{roxygen2} \verb{@examples} +tags, with the minor addition of some wrapping code to manage the tests. This means that they will be integrated into your \verb{@examples} and can be intermixed between \verb{@examples} tags } diff --git a/man/use_testex_as_testthat.Rd b/man/use_testex_as_testthat.Rd index 397be94..b3c0de7 100644 --- a/man/use_testex_as_testthat.Rd +++ b/man/use_testex_as_testthat.Rd @@ -2,14 +2,14 @@ % Please edit documentation in R/use.R \name{use_testex_as_testthat} \alias{use_testex_as_testthat} -\title{Run examples as testthat expectations} +\title{Run examples as \code{testthat} expectations} \usage{ use_testex_as_testthat(path = getwd(), context = "testex", quiet = FALSE) } \arguments{ \item{path}{A package source code working directory} -\item{context}{A testthat test context to use as the basis for a new test +\item{context}{A \code{testthat} test context to use as the basis for a new test filename.} \item{quiet}{Whether to emit output messages.} @@ -18,6 +18,6 @@ filename.} The result of \code{\link[=writeLines]{writeLines()}} after writing a new \code{testthat} file. } \description{ -Run examples as testthat expectations +Run examples as \code{testthat} expectations } \concept{use} diff --git a/man/vapplys.Rd b/man/vapplys.Rd index af495e7..9e91f7d 100644 --- a/man/vapplys.Rd +++ b/man/vapplys.Rd @@ -4,7 +4,7 @@ \alias{vlapply} \alias{vcapply} \alias{vnapply} -\title{\code{vapply} shorthands} +\title{\code{vapply} shorthand alternatives} \usage{ vlapply(..., FUN.VALUE = logical(1L)) diff --git a/man/wrap_expect_no_error.Rd b/man/wrap_expect_no_error.Rd index 58b5594..334ff3e 100644 --- a/man/wrap_expect_no_error.Rd +++ b/man/wrap_expect_no_error.Rd @@ -2,13 +2,13 @@ % Please edit documentation in R/testthat.R \name{wrap_expect_no_error} \alias{wrap_expect_no_error} -\title{Wraps an example expression in a testthat expectation to not error} +\title{Wraps an example expression in a \code{testthat} expectation to not error} \usage{ wrap_expect_no_error(expr, value) } \arguments{ -\item{expr}{An expr to wrap in a \code{expect_no_error()} expectation. Uses -'testthat's version if recent enough version is available, or provides +\item{expr}{An expression to wrap in a \code{expect_no_error()} expectation. Uses +\code{testthat}s version if recent enough version is available, or provides a fallback otherwise.} \item{value}{A symbol to use to store the result of \code{expr}} @@ -17,6 +17,6 @@ a fallback otherwise.} A \code{\link[testthat:test_that]{testthat::test_that()}} call } \description{ -Wraps an example expression in a testthat expectation to not error +Wraps an example expression in a \code{testthat} expectation to not error } \keyword{internal} diff --git a/tests/spelling.R b/tests/spelling.R new file mode 100644 index 0000000..6713838 --- /dev/null +++ b/tests/spelling.R @@ -0,0 +1,3 @@ +if(requireNamespace('spelling', quietly = TRUE)) + spelling::spell_check_test(vignettes = TRUE, error = FALSE, + skip_on_cran = TRUE) diff --git a/tests/testthat/test-roxygen2-expect.R b/tests/testthat/test-roxygen2-expect.R index cf6bb24..c98b77e 100644 --- a/tests/testthat/test-roxygen2-expect.R +++ b/tests/testthat/test-roxygen2-expect.R @@ -1,4 +1,4 @@ -test_that("@expect tags produce \\testonly blocks", { +test_that("@test tags produce \\testonly blocks", { roxy_text <- " #' Title #' @@ -8,7 +8,7 @@ test_that("@expect tags produce \\testonly blocks", { #' #' @examples #' 1 + 2 - #' @expect 3 + #' @test 3 #' #' @export f <- function(x, y) x + y @@ -17,7 +17,7 @@ test_that("@expect tags produce \\testonly blocks", { block <- roxygen2::parse_text(roxy_text)[[1]] expect_tag <- block$tags[[5]] - expect_equal(expect_tag$tag, "expect") + expect_equal(expect_tag$tag, "test") expect_s3_class(expect_tag, "roxy_tag_examples") expect_true(any(grepl("\\\\testonly\\{", expect_tag$val))) diff --git a/tests/testthat/test-roxygen2-parse-text.R b/tests/testthat/test-roxygen2-parse-text.R index 83039ca..d6cd6e4 100644 --- a/tests/testthat/test-roxygen2-parse-text.R +++ b/tests/testthat/test-roxygen2-parse-text.R @@ -8,7 +8,7 @@ test_that("roxygen2 can parse testex tags without raising conditions", { #' #' @examples #' 1 + 2 - #' @expect 3 + #' @test 3 #' #' @export f <- function(x, y) x + y