tests/testthat/test-assert_create.R

# Test Creation of Simple Assertion Chains  -----------------------------------------------------

cli::test_that_cli(configs = "plain", "assert_create() returns an assertion function", {
  assert_create_output <- assert_create(is.numeric, "Error: Argument must be numeric")
  expect_true(is.function(assert_create_output))
})

cli::test_that_cli(configs = "plain", "assertion function returns invisible TRUE if condition is met", {
  assert_is_numeric <- assert_create(is.numeric, "Error: Argument must be numeric")
  expect_true(assert_is_numeric(2))
})


cli::test_that_cli(configs = "plain", "assertion function aborts with default error message if condition is not met", {
  assert_is_numeric <- assert_create(is.numeric, "Error: Argument must be numeric")
  expect_error(assert_is_numeric("a"), "Error: Argument must be numeric", fixed=TRUE)
})

cli::test_that_cli(configs = "plain", "assertion function aborts with custom error message if condition is not met", {
  assert_is_numeric <- assert_create(is.numeric, "Error: Argument must be numeric")
  expect_error(assert_is_numeric("a", "Custom error message"), "Custom error message", fixed=TRUE)
})

cli::test_that_cli(configs = "plain", "user supplied  custom error message has access to the environment in which it was called", {
  assert_is_numeric <- assert_create(is.numeric, "Error: Argument must be numeric")
  name = "billy"
  age = "26"
  expect_error(assert_is_numeric(age, "{name}'s age must be a number, not a {class(age)}"), "billy's age must be a number, not a character", fixed=TRUE)
})

cli::test_that_cli(configs = "plain", "user supplied  custom error message has access to the environment in which it was called (when run within a function)", {
  assert_is_numeric <- assert_create(is.numeric, "Error: Argument must be numeric")
  foo <- function(){
    name = "billy"
    assert_is_numeric("A", msg = "{name} was always going to fail")
  }
  expect_error(foo(), "billy was always going to fail")
})

cli::test_that_cli(configs = "plain", "user supplied  custom error message has special keywords", {

  assert_is_numeric <- assert_create(is.numeric, "Error: Argument must be numeric")
  name = "billy"
  age = "26"
  expect_error(assert_is_numeric(age, "{arg_name} must be a number, not a {class(arg_value)}"), "age must be a number, not a character", fixed=TRUE)
})




cli::test_that_cli(configs = "plain", "assert_create() aborts if func is not a function", {
  expect_error(assert_create("not a function", "Error message"), "`\"not a function\"` must be a function, not a character", fixed=TRUE)
})

cli::test_that_cli(configs = "plain", "assert_create() aborts if func has 0 arguments", {
expect_error(assert_create(function(){}), "`function() {}` must have at least 1 paramater to be used in `assert_create`", fixed=TRUE)
})

cli::test_that_cli(configs = "plain", "assert_create() aborts if default_error_msg is not a string", {
  expect_error(assert_create(is.numeric, 1), "1 must be a string (length 1 character vector). Class: numeric; Length: 1", fixed=TRUE)
})

cli::test_that_cli(configs = "plain", "assertion function aborts if func does not return a logical scalar when default_error_msg is supplied", {
  assert_is_numeric <- assert_create(function(x) x, "Error: Argument must be numeric")
  expect_snapshot(assert_is_numeric(2), error = TRUE)
})


cli::test_that_cli(configs = "plain", "assertion function aborts if func returns FALSE without a default error message", {
  # Bad assertion: returns FALSE with no default error message
  bad_assert_no_default_error <- assert_create(function(x) FALSE)
  expect_snapshot(bad_assert_no_default_error(2), error = TRUE)

  # Good assertion: returns STRING with no default error message
  good_assert_no_default_error <- assert_create(function(x) "an error message")
  expect_snapshot(good_assert_no_default_error(2), error = TRUE)
})

cli::test_that_cli(configs = "plain", "assertion function throws appropriate error when returning neither a flag NOR a string", {
  # Bad assertion: returns character not string
  bad_assert_returns_char <- assert_create(function(x) c("a", "b"))
  expect_snapshot(bad_assert_returns_char("foo"), error = TRUE)

  # Bad assertion: returns logical not flag
  bad_assert_returns_logical <- assert_create(function(x) c(TRUE, TRUE))
  expect_snapshot(bad_assert_returns_logical("foo"), error = TRUE)

  # Bad assertion: returns factor
  bad_assert_returns_factor <- assert_create(function(x) factor(c(1, 4)))
  expect_snapshot(bad_assert_returns_factor("foo"), error = TRUE)

})

cli::test_that_cli(configs = "plain", "assertion function works as expected with string-returning assertion functions", {
  # Bad assertion: returns character not string
  is_between_min_and_max <- function(obj, min, max){
    if(!is.numeric(obj)) return(paste0("{arg_name} is a {class(arg_value)}, not numeric"))

    if(obj > max) return("{arg_name} is over {max}")
    else if (obj < min) return("{arg_name} is under {min}")

    return(TRUE)
  }

  assert_between_min_and_max <- assert_create(is_between_min_and_max)
  expect_true(assert_between_min_and_max(4, min = 3, max = 5))

  expect_snapshot(assert_between_min_and_max("foo", min = 3, max = 5), error = TRUE)
  expect_snapshot(assert_between_min_and_max(6, min = 3, max = 5), error = TRUE)
  expect_snapshot(assert_between_min_and_max(2, min = 3, max = 5), error = TRUE)
})

cli::test_that_cli(configs = "plain", "created assertion() functions throw informative error when mandatory arguments are not supplied", {
  f1 <- function(bob, billy) { return(TRUE) }
  assert_f1 <- assertions::assert_create(f1, default_error_msg = 'this is an error message')

  expect_error(assert_f1(), regexp = "mandatory argument/s were not supplied", fixed=TRUE)
  expect_error(assert_f1(bob = 'a'), regexp = "mandatory argument/s were not supplied", fixed=TRUE)
  expect_true(assert_f1('a', 'b'))
})


cli::test_that_cli(configs = "plain", "assert_create edge case errors", {

  # Function has dots
  expect_no_error(assert_create(func = function(a, b, ...){ FALSE }))

  # Function has dots but no other arguments
  expect_error(assert_create(func = function( ...){ FALSE }), regexp = "must have at least 1 paramater.*Note '\\.\\.\\.' does NOT count as an argument")

  # Function has names that clash with those assert_create adds to all assertions
  expect_error(assert_create(func = function(msg){ FALSE }), regexp = "cannot include paramaters named 'msg', 'call', or 'arg_name", fixed=TRUE)

  # arg_name is not a string
  assertion <- assert_create(func = function(a){ FALSE }, default_error_msg = "{arg_name} is ignored - this function always throws an error")
  expect_error(assertion(a, arg_name = 2), regexp = "arg_name must be a string, not a numeric")
})


# Test Creation of Assertion Chains  -----------------------------------------------------
cli::test_that_cli(configs = "plain", "assertion chains can evaluate expressions part and not get confused if they contain variable names", {
  #assert_is_character <- assert_create(is.character, "Error: {arg_name} must be a character")
  assert_chain<- assert_create_chain(
    assert_create(is.character, "{arg_name} must be a character"),
    assert_create(is.numeric, "{arg_name} must be numeric")
  )
  y = c(1, 2)
  expect_error(assert_chain(length(y)), regexp = "length(y) must be a character", fixed = TRUE)
})

cli::test_that_cli(configs = "plain", "Common assert_create_chain errors", {

  # Throws error if argument given to assert_create_chain is not a function
  expect_error(assert_create_chain(
    2,
    assert_create(is.numeric, "{arg_name} must be numeric")
  ), regexp = "Input to assert_create_chain must must be functions created by `assert_create()`", fixed=TRUE)

  # Throws error a function doesn't have the required arguments (msg, call and arg_name)
  expect_error(assert_create_chain(
    function(x, msg, arg_name, notcall){},
    assert_create(is.numeric, "{arg_name} must be numeric")
  ), regexp = "Input to assert_create_chain must must be functions created by `assert_create()`", fixed=TRUE)

  # Throws error if functions have less than 4 args (some_obj_to_test and officially required functions: msg, call, arg_name)
  expect_error(assert_create_chain(
    function(msg, call, arg_name){}, # 3 args only
    assert_create(is.numeric, "{arg_name} must be numeric")
  ), regexp = "Input to assert_create_chain must must be functions created by `assert_create()`", fixed=TRUE)
})

cli::test_that_cli(configs = "plain", "assert_create_chain:  user supplied  custom error message has access to the environment in which it was called", {
  assert_chain<- assert_create_chain(
    assert_create(is.numeric, "{arg_name} must be numeric"),
    assert_create(is.character, "{arg_name} must be a character")
  )

  name = "billy"
  age = "26"
  expect_error(assert_chain(age, msg = "{name}'s age must be a number, not a {class(age)}"), "billy's age must be a number, not a character", fixed=TRUE)
})

cli::test_that_cli(configs = "plain", "assert_create_chain: user supplied  custom error message has special keywords", {

  assert_chain<- assert_create_chain(
    assert_create(is.numeric, "{arg_name} must be numeric"),
    assert_create(is.character, "{arg_name} must be a character")
  )
  name = "billy"
  age = "26"
  expect_error(assert_chain(age, "{arg_name} must be a number, not a {class(arg_value)}"), "age must be a number, not a character", fixed=TRUE)
})


cli::test_that_cli(configs = "plain", "assert_create_chain_example", {
  expect_no_error(assert_create_chain_example())
  expect_true(is.character(assert_create_chain_example()))
})

Try the assertions package in your browser

Any scripts or data that you put into this service are public.

assertions documentation built on April 3, 2025, 5:52 p.m.