#' @title
#' Expect that the tested function is self-contained
#'
#' @description
#' Tests if a fuction is self-contained (i.e. do not use any global variables).
#'
#' @param object
#' Function to test if it is self-contained.
#' @param label Additional information.
#' @param info Deprecated.
#'
#' @keywords internal
#'
#' @export
expect_function_self_contained <- function(object, info = NULL, label = NULL) {
if(!is.null(label)) .Deprecated(msg = "argument label is deprecated with testthat 2.0")
# 1. Capture object and label
act <- testthat::quasi_label(rlang::enquo(object))
# 2. Call expect()
act$global_vars <- codetools::findGlobals(object, merge = F)$variables
msg <- sprintf("%s contain global variable(s): %s.", act$lab, paste(act$global_vars, collapse = " "))
testthat::expect(length(act$global_vars) == 0, msg, info)
# 3. Invisibly return the value
invisible(act$val)
}
#' @title
#' Expect that a given package is used
#'
#' @description
#' Tests that the following packages is used.
#'
#' @param pkg
#' Package to check for.
#' @param info Deprecated.
#'
#' @keywords internal
#'
#' @export
expect_attached_package <- function(pkg, info = NULL){
checkmate::assert_string(pkg)
# 2. Call expect()
msg <- sprintf("Package '%s' is not used (attached).", pkg)
testthat::expect(any(grepl(pkg, search())), msg)
# 3. Invisibly return the value
invisible(NULL)
}
#' @title
#' Expect that a forbidden package is not used/attached
#'
#' @description
#' Tests that the following packages is not used.
#'
#' @param pkg Package to check for.
#'
#' @keywords internal
#'
#' @export
expect_no_attached_forbidden_package <- function(pkg){
checkmate::assert_string(pkg)
# 2. Call expect()
msg <- sprintf("Package '%s' is forbidden.", pkg)
testthat::expect(!any(grepl(pkg, search())), msg)
# 3. Invisibly return the value
invisible(NULL)
}
#' @title
#' Expect function arguments
#'
#' @description
#' Test that an function object has a function with given arguments.
#'
#' @param object
#' Function to check the arguments of.
#' @param expected
#' Expected arguments in function.
#' @param label Additional information.
#' @param info Deprecated.
#' @param expected.label Deprecated.
#'
#' @keywords internal
#'
#' @export
expect_function_arguments <- function(object, expected, info = NULL, label = NULL, expected.label = NULL) {
checkmate::assert_character(expected, null.ok = TRUE)
if(!is.null(label)) .Deprecated(msg = "argument label is deprecated with testthat 2.0")
if(!is.null(expected.label)) .Deprecated(msg = "argument expected.label is deprecated with testthat 2.0")
# 1. Capture object and label
act <- testthat::quasi_label(rlang::enquo(object))
# 2. Call expect()
act$function_arguments <- names(formals(object))
act$missing_arguments <- !act$function_arguments %in% expected
act$extra_arguments <- !expected %in% act$function_arguments
msg <- sprintf("%s should contain arguments %s, not %s.",
act$lab,
paste(expected, collapse = " "),
paste(act$function_arguments, collapse = " "))
testthat::expect(!(any(act$missing_arguments) | any(act$extra_arguments)), msg, info)
# 3. Invisibly return the value
invisible(act$val)
}
#' @title
#' Expect function contain code
#'
#' @description
#' Test that a given code string exists in function
#'
#' @param object
#' Function to check for mandatory code
#' @param expected
#' Expected arguments in function.
#' @param label Additional information.
#' @param info Deprecated.
#' @param expected.label Deprecated.
#'
#' @keywords internal
#'
#' @export
expect_function_code <-
function(object, expected, info = NULL, label = NULL, expected.label = NULL)
{
checkmate::assert_string(expected)
if(!is.null(label)) .Deprecated(msg = "argument label is deprecated with testthat 2.0")
if(!is.null(expected.label)) .Deprecated(msg = "argument expected.label is deprecated with testthat 2.0")
# 1. Capture object and label
act <- testthat::quasi_label(rlang::enquo(object))
# 2. Call expect()
act$body <- as.character(body(object))
testthat::expect(
any(grepl(x = act$body, pattern = expected)),
sprintf("'%s' not found in the body of %s",
expected,
act$lab),
info
)
# 3. Invisibly return the value
invisible(act$val)
}
#' @title
#' Expect no forbidden function code
#'
#' @description
#' Test that a given code string does not exists in function.
#'
#' @param object
#' Function to check for mandatory code
#' @param forbidden
#' Code string that are forbidden to use.
#'
#' @keywords internal
#'
#' @export
expect_no_forbidden_function_code <-
function(object, forbidden)
{
checkmate::assert_string(forbidden)
# 1. Capture object and label
act <- testthat::quasi_label(rlang::enquo(object))
# 2. Call expect()
act$body <- as.character(body(object))
testthat::expect(
!any(grepl(x = act$body, pattern = forbidden)),
sprintf("Forbidden code '%s' is found in the body of %s",
forbidden,
act$lab)
)
# 3. Invisibly return the value
invisible(act$val)
}
#' @title Depricated function: expect_self_contained
#'
#' @description Function has been depricated and will be removed. Please use \code{\link{expect_function_self_contained}} instead.
#'
#' @keywords internal
#' @export
expect_self_contained <- function(object, info = NULL, label = NULL){
.Deprecated("expect_function_self_contained")
expect_function_self_contained(object, info, label)
}
#' @title Depricated function: expect_package
#'
#' @description Function has been depricated and will be removed. Please use \code{\link{expect_attached_package}} instead.
#'
#' @keywords internal
#' @export
expect_package <- function(object, info = NULL, label = NULL){
.Deprecated("expect_attached_package")
expect_attached_package(object, info)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.