Add input checking (#2155)

Fixes #1754

Author: hadley

NEWS.md

@@ -1,5 +1,6 @@
 # testthat (development version)
 
+* `expect_*()` functions consistently and rigorously check their inputs (#1754). 
 * `JunitReporter()` no longer fails with `"no applicable method for xml_add_child"` for warnings outside of tests (#1913). Additionally, warnings now save their backtraces.
 * `JunitReporter()` strips ANSI escapes in more placese (#1852, #2032).
 * `try_again()` is now publicised. The first argument is now the number of retries, not tries (#2050).

R/compare.R

@@ -16,8 +16,8 @@ compare <- function(x, y, ...) {
 }
 
 comparison <- function(equal = TRUE, message = "Equal") {
-  stopifnot(is.logical(equal), length(equal) == 1)
-  stopifnot(is.character(message))
+  check_bool(equal)
+  check_character(message)
 
   structure(
     list(

R/expect-condition.R

@@ -114,6 +114,10 @@ expect_error <- function(
   info = NULL,
   label = NULL
 ) {
+  check_string(regexp, allow_null = TRUE, allow_na = TRUE)
+  check_string(class, allow_null = TRUE)
+  check_bool(inherit)
+
   if (edition_get() >= 3) {
     expect_condition_matching_(
       "error",
@@ -158,6 +162,11 @@ expect_warning <- function(
   info = NULL,
   label = NULL
 ) {
+  check_string(regexp, allow_null = TRUE, allow_na = TRUE)
+  check_string(class, allow_null = TRUE)
+  check_bool(inherit)
+  check_bool(all)
+
   if (edition_get() >= 3) {
     if (!missing(all)) {
       warn("The `all` argument is deprecated")
@@ -207,6 +216,11 @@ expect_message <- function(
   info = NULL,
   label = NULL
 ) {
+  check_string(regexp, allow_null = TRUE, allow_na = TRUE)
+  check_string(class, allow_null = TRUE)
+  check_bool(inherit)
+  check_bool(all)
+
   if (edition_get() >= 3) {
     expect_condition_matching_(
       "message",
@@ -239,6 +253,10 @@ expect_condition <- function(
   info = NULL,
   label = NULL
 ) {
+  check_string(regexp, allow_null = TRUE, allow_na = TRUE)
+  check_string(class, allow_null = TRUE)
+  check_bool(inherit)
+
   if (edition_get() >= 3) {
     expect_condition_matching_(
       "condition",

R/expect-equality.R

@@ -65,6 +65,7 @@ expect_equal <- function(
 ) {
   act <- quasi_label(enquo(object), label)
   exp <- quasi_label(enquo(expected), expected.label)
+  check_number_decimal(tolerance, min = 0, allow_null = TRUE)
 
   if (edition_get() >= 3) {
     expect_waldo_equal_("equal", act, exp, info, ..., tolerance = tolerance)

R/expect-inheritance.R

@@ -46,7 +46,7 @@ NULL
 #' @export
 #' @rdname inheritance-expectations
 expect_type <- function(object, type) {
-  stopifnot(is.character(type), length(type) == 1)
+  check_string(type)
 
   act <- quasi_label(enquo(object))
   act_type <- typeof(act$val)
@@ -69,6 +69,8 @@ expect_type <- function(object, type) {
 #'   from `class`. If `TRUE`, checks that object has a class that's identical
 #'   to `class`.
 expect_s3_class <- function(object, class, exact = FALSE) {
+  check_bool(exact)
+
   act <- quasi_label(enquo(object))
   act$class <- format_class(class(act$val))
   exp_lab <- format_class(class)
@@ -98,7 +100,7 @@ expect_s3_class <- function(object, class, exact = FALSE) {
       }
     }
   } else {
-    abort("`class` must be a NA or a character vector")
+    stop_input_type(class, c("a character vector", "NA"))
   }
 
   pass(act$val)
@@ -187,7 +189,7 @@ isS3 <- function(x) is.object(x) && !isS4(x)
 #' @inheritParams expect_type
 #' @export
 expect_is <- function(object, class, info = NULL, label = NULL) {
-  stopifnot(is.character(class))
+  check_character(class)
   edition_deprecate(
     3,
     "expect_is()",

R/expect-known.R

@@ -58,6 +58,10 @@ expect_known_output <- function(
   print = FALSE,
   width = 80
 ) {
+  check_string(file)
+  check_bool(update)
+  check_bool(print)
+  check_number_whole(width, min = 1)
   edition_deprecate(
     3,
     "expect_known_output()",
@@ -131,6 +135,10 @@ expect_output_file <- function(
   print = FALSE,
   width = 80
 ) {
+  check_string(file)
+  check_bool(update)
+  check_bool(print)
+  check_number_whole(width, min = 1)
   # Code is a copy of expect_known_output()
   edition_deprecate(
     3,
@@ -158,6 +166,9 @@ expect_known_value <- function(
   label = NULL,
   version = 2
 ) {
+  check_string(file)
+  check_bool(update)
+  check_number_whole(version, min = 1)
   edition_deprecate(
     3,
     "expect_known_value()",

R/expect-length.R

@@ -14,7 +14,7 @@
 #' expect_length(1:10, 1)
 #' }
 expect_length <- function(object, n) {
-  stopifnot(is.numeric(n), length(n) == 1)
+  check_number_whole(n, min = 0)
 
   act <- quasi_label(enquo(object))
   act$n <- length(act$val)

R/expect-match.R

@@ -77,8 +77,11 @@ expect_no_match <- function(
 ) {
   # Capture here to avoid environment-related messiness
   act <- quasi_label(enquo(object), label)
-  stopifnot(is.character(regexp), length(regexp) == 1)
-  stopifnot(is.character(act$val))
+  check_character(object)
+  check_string(regexp)
+  check_bool(perl)
+  check_bool(fixed)
+  check_bool(all)
 
   expect_match_(
     act = act,

R/expect-named.R

@@ -32,6 +32,9 @@ expect_named <- function(
   info = NULL,
   label = NULL
 ) {
+  check_bool(ignore.order)
+  check_bool(ignore.case)
+  
   act <- quasi_label(enquo(object), label)
   act$names <- names(act$val)
 

R/expect-output.R

@@ -30,6 +30,8 @@ expect_output <- function(
   label = NULL,
   width = 80
 ) {
+  check_number_whole(width, min = 1)
+  
   act <- quasi_capture(enquo(object), label, capture_output, width = width)
 
   if (identical(regexp, NA)) {