tests/testthat/test-assertions.R

In ropensci/assertr: Assertive Programming for R Analysis Pipelines

# just some set up
a <- 1
alist <- list(a=c(1,2,3), b=c(4,5,6))

our.iris <- iris
our.iris.2 <- our.iris
our.iris.2[106,1] <- 7
our.iris.3 <- our.iris.2
our.iris.3[c(118, 119, 123, 132, 131, 136), 1] <- 7

exmpl.data <- data.frame(x=c(8, 9, 6, 5, 9, 5, 6, 7,
                             8, 9, 6, 5, 5, 6, 7),
                         y=c(82, 91, 61, 49, 40, 49, 57, 74,
                             78, 90, 61, 49, 51, 62, 68))

nexmpl.data <- exmpl.data
nexmpl.data[12,2] <- NA

mnexmpl.data <- nexmpl.data
mnexmpl.data[12,1] <- NA

nanmnexmpl.data <- mnexmpl.data
nanmnexmpl.data[10,1] <- 0/0

test.df <- data.frame(x = c(0, 1, 2))
test.df2 <- data.frame(x = c(0, 1, 2),
                       y = c(2, 1.5, 1),
                       z = c(0,NA, -1))

# custom error (or success) messages
not.helpful <- function(message, ...){
  stop("unspecified error", call.=FALSE)
}

give.validation <- function(data, ...){
  return("great job!")
}

just.show.error <- function(err, ...){
  lapply(err, summary)
}

# helper functions for verifying success_append results
success_result <- function(verb, the_call, columns, row_redux_call, description) {
  row_redux_message <- ""
  if (!is.na(row_redux_call))
    row_redux_message <- paste0(" on ", row_redux_call, " row reduction")
  msg <- paste0("verification [", the_call, "]", row_redux_message, " passed!")
  success <- list(
    verb = verb,
    message = msg,
    call = the_call,
    columns = columns,
    row_redux_call = row_redux_call,
    description = description
  )
  class(success) <- c("assertr_success", "success", "condition")
  list(success)
}
get_assertr_success <- function(assertion) {
  attr(assertion, "assertr_success")
}

############### verify ###############
test_that("verify returns data if verification passes", {
  expect_equal(verify(mtcars, drat > 2), mtcars)
  expect_equal(verify(mtcars, mtcars$drat > 2), mtcars)
  expect_equal(verify(mtcars, mtcars$drat > 2), mtcars)
  expect_equal(verify(mtcars, nrow(mtcars) > 30), mtcars)
  expect_equal(verify(mtcars, am %in% c(0,1,2)), mtcars)
  expect_equal(verify(mtcars, am %in% c(0,1)), mtcars)
  # looks to parent frame scope?
  expect_equal(verify(mtcars, a > 0), mtcars)
  expect_equal(verify(mtcars, nrow(iris) > 140), mtcars)
  expect_equal(verify(alist, length(a) > 0), alist)
  # respects scoping rules?
  expect_equal(verify(alist, length(a) > 2), alist)
  expect_equal(verify(alist, length(a) > 2 && length(b) > 2), alist)
  expect_equal(verify(alist, a >= 1 & b > 2), alist)
  expect_equal(verify(alist, a > 2 | b > 2), alist)
  expect_equal(verify(alist, 3 > 2), alist)
})

test_that("verify returns TRUE if verification passes (and we use `success_logical`)", {
  expect_true(verify(mtcars, drat > 2, success_fun=success_logical))
  expect_true(verify(mtcars, mtcars$drat > 2, success_fun=success_logical))
  expect_true(verify(mtcars, mtcars$drat > 2, success_fun=success_logical))
  expect_true(verify(mtcars, nrow(mtcars) > 30, success_fun=success_logical))
  expect_true(verify(mtcars, am %in% c(0,1,2), success_fun=success_logical))
  expect_true(verify(mtcars, am %in% c(0,1), success_fun=success_logical))
  # looks to parent frame scope?
  expect_true(verify(mtcars, a > 0, success_fun=success_logical))
  expect_true(verify(mtcars, nrow(iris) > 140, success_fun=success_logical))
  expect_true(verify(alist, length(a) > 0, success_fun=success_logical))
  # respects scoping rules?
  expect_true(verify(alist, length(a) > 2, success_fun=success_logical))
  expect_true(verify(alist, length(a) > 2 && length(b) > 2, success_fun=success_logical))
  expect_true(verify(alist, a >= 1 & b > 2, success_fun=success_logical))
  expect_true(verify(alist, a > 2 | b > 2, success_fun=success_logical))
  expect_true(verify(alist, 3 > 2, success_fun=success_logical))
})

test_that("verify returns success results if verification passes (and we use `success_append`)", {
  expect_equal(
    get_assertr_success(verify(mtcars, drat > 2, success_fun=success_append)),
    success_result("verify", "drat > 2", NA, NA, NA))
  expect_equal(
    get_assertr_success(verify(mtcars, mtcars$drat > 2, success_fun=success_append)),
    success_result("verify", "mtcars$drat > 2", NA, NA, NA))
  expect_equal(
    get_assertr_success(verify(mtcars, mtcars$drat > 2, success_fun=success_append)),
    success_result("verify", "mtcars$drat > 2", NA, NA, NA))
  expect_equal(
    get_assertr_success(verify(mtcars, nrow(mtcars) > 30, success_fun=success_append)),
    success_result("verify", "nrow(mtcars) > 30", NA, NA, NA))
  expect_equal(
    get_assertr_success(verify(mtcars, am %in% c(0,1,2), success_fun=success_append)),
    success_result("verify", "am %in% c(0, 1, 2)", NA, NA, NA))
  expect_equal(
    get_assertr_success(verify(mtcars, am %in% c(0,1), success_fun=success_append)),
    success_result("verify", "am %in% c(0, 1)", NA, NA, NA))
  # looks to parent frame scope?
  expect_equal(
    get_assertr_success(verify(mtcars, a > 0, success_fun=success_append)),
    success_result("verify", "a > 0", NA, NA, NA))
  expect_equal(
    get_assertr_success(verify(mtcars, nrow(iris) > 140, success_fun=success_append)),
    success_result("verify", "nrow(iris) > 140", NA, NA, NA))
  expect_equal(
    get_assertr_success(verify(alist, length(a) > 0, success_fun=success_append)),
    success_result("verify", "length(a) > 0", NA, NA, NA))
  # respects scoping rules?
  expect_equal(
    get_assertr_success(verify(alist, length(a) > 2, success_fun=success_append)),
    success_result("verify", "length(a) > 2", NA, NA, NA))
  expect_equal(
    get_assertr_success(verify(alist, length(a) > 2 && length(b) > 2, success_fun=success_append)),
    success_result("verify", "length(a) > 2 && length(b) > 2", NA, NA, NA))
  expect_equal(
    get_assertr_success(verify(alist, a >= 1 & b > 2, success_fun=success_append)),
    success_result("verify", "a >= 1 & b > 2", NA, NA, NA))
  expect_equal(
    get_assertr_success(verify(alist, a > 2 | b > 2, success_fun=success_append)),
    success_result("verify", "a > 2 | b > 2", NA, NA, NA))
  expect_equal(
    get_assertr_success(verify(alist, 3 > 2, success_fun=success_append)),
    success_result("verify", "3 > 2", NA, NA, NA))
})

test_that("verify performs custom success function if verification passes", {
  expect_equal(verify(mtcars, drat > 2, success_fun=give.validation),
               "great job!")
  expect_equal(verify(mtcars, mtcars$drat > 2, function(x, ...){return("noice!")}),
               "noice!")
})

test_that("verify raises error if verification fails", {
  expect_equal(verify(mtcars, drat > 3, error_fun = error_logical), FALSE)
  expect_output(verify(mtcars, drat > 3, error_fun = just.show.error),
                "verification \\[drat > 3\\] failed! \\(4 failures\\)")

  expect_equal(verify(mtcars, nrow(mtcars) > 34, error_fun = error_logical), FALSE)
  expect_output(verify(mtcars, nrow(mtcars) > 34, error_fun = just.show.error),
                "verification \\[nrow\\(mtcars\\) > 34\\] failed! \\(1 failure\\)")

  expect_equal(verify(mtcars, am %in% c(1,2), error_fun = error_logical), FALSE)
  expect_output(verify(mtcars, am %in% c(1,2), error_fun = just.show.error),
                "verification \\[am %in% c\\(1, 2\\)\\] failed! \\(19 failures\\)")

  # looks to parent frame scope?
  expect_equal(verify(mtcars, a < 0, error_fun = error_logical), FALSE)
  expect_output(verify(mtcars, a < 0, error_fun = just.show.error),
                "verification \\[a < 0\\] failed! \\(1 failure\\)")

  # respects scoping rules?
  expect_equal(verify(alist, length(a) == 1, error_fun = error_logical), FALSE)
  expect_output(verify(alist, length(a) == 1, error_fun = just.show.error),
                "verification \\[length\\(a\\) == 1\\] failed! \\(1 failure\\)")
  expect_equal(verify(alist, length(a) > 4, error_fun = error_logical), FALSE)
  expect_output(verify(alist, length(a) > 4, error_fun = just.show.error),
                "verification \\[length\\(a\\) > 4\\] failed! \\(1 failure\\)")
  expect_output(verify(alist, length(a) > 2 && length(b) > 3, error_fun = just.show.error),
                "verification \\[length\\(a\\) > 2 && length\\(b\\) > 3\\] failed! \\(1 failure\\)")
  expect_output(verify(alist, a >= 2 | b > 4, error_fun = just.show.error),
                "verification \\[a >= 2 | b > 4\\] failed! \\(1 failure\\)")
  expect_output(verify(alist, 2 > 4, error_fun = just.show.error),
                "verification \\[2 > 4\\] failed! \\(1 failure\\)")
  # NA values don't compare TRUE
  expect_output(verify(test.df2, z > -2, error_fun = just.show.error),
                "verification \\[z > -2\\] failed! \\(1 failure\\)")
})

test_that("verify breaks appropriately", {
  expect_error(verify(4 > 2), "argument \"expr\" is missing, with no default")
  expect_error(verify(mtcars), "argument \"expr\" is missing, with no default")
  expect_error(verify(MTCARS, 2 > 1),
               "object 'MTCARS' not found")
  expect_warning(expect_warning(
    verify(mtcars, 1),
    "coercing argument of type 'double' to logical"),
    "The result of evaluating '1' is not a logical vector"
  )
  expect_error(suppressWarnings(verify(mtcars, "1")),
               "missing value where TRUE/FALSE needed")
  expect_error(verify(mtcars, 1 > 0, "tree"), "could not find function \"success_fun\"")
  expect_error(verify(mtcars, d > 1), "object 'd' not found")
})

test_that("verify works within functions", {
  my_verify <- function(data, expr, success_fun) {
    verify(data, !!rlang::enexpr(expr), success_fun=success_fun)
  }

  expect_true(my_verify(mtcars, drat > 2, success_fun=success_logical))
})

test_that("verify works with long predicates (fix #80)", {
  my_data <- data.frame(COMMENT=c("foo", "bar", "baz", "Positive Pre-dose"),
                        USUBJID = "ABCDEFGHIJKLMNOPQRTSU",
                        stringsAsFactors=FALSE)
  expect_output(
    expect_error(
      verify(my_data,
             is.na(COMMENT) | (COMMENT %in% "Positive Pre-dose" & USUBJID %in% "ABCDEFGHIJKLMNOPQRTSU")),
      "assertr stopped execution"
    ),
    regexp='is.na(COMMENT) | (COMMENT %in% "Positive Pre-dose" & USUBJID %in%      "ABCDEFGHIJKLMNOPQRTSU")',
    fixed=TRUE
  )
})

test_that("skip_chain_opts doesn't affect functionality outside chain for verify", {
  expect_equal(verify(mtcars, mtcars$drat > 2, skip_chain_opts=TRUE), mtcars)
  expect_equal(verify(mtcars, nrow(mtcars) > 30, skip_chain_opts=TRUE), mtcars)
  expect_true(verify(mtcars, mtcars$drat > 2, success_fun=success_logical, skip_chain_opts=TRUE))
  expect_true(verify(mtcars, nrow(mtcars) > 30, success_fun=success_logical, skip_chain_opts=TRUE))
  expect_equal(verify(mtcars, drat > 3, error_fun=error_logical, skip_chain_opts=TRUE), FALSE)
  expect_output(verify(mtcars, drat > 3, error_fun=just.show.error, skip_chain_opts=TRUE),
                "verification \\[drat > 3\\] failed! \\(4 failures\\)")
})

######################################


############### assert ###############
test_that("assert returns data if verification passes", {
  expect_equal(assert(mtcars, in_set(0,1), vs, am), mtcars)
  expect_equal(assert(mtcars, within_bounds(3,5), gear), mtcars)
  expect_equal(assert(mtcars, is.numeric, mpg:carb), mtcars)
  expect_equal(assert(mtcars, not_na, vs), mtcars)
  expect_equal(assert(mtcars, not_na, mpg:carb), mtcars)
  # lambdas
  expect_equal(assert(mtcars, function(x) x%%1==0, cyl, vs, am, gear, carb), mtcars)
  expect_equal(assert(mtcars, function(x) if(x%%1!=0) return(FALSE), gear), mtcars)
  expect_equal(assert(iris, function(x) nchar(as.character(x)) > 5, Species),
               iris)
})

test_that("assert returns TRUE if verification passes (w/ `success_logical`)", {
  expect_true(assert(mtcars, in_set(0,1), vs, am, success_fun=success_logical))
  expect_true(assert(mtcars, within_bounds(3,5), gear, success_fun=success_logical))
  expect_true(assert(mtcars, is.numeric, mpg:carb, success_fun=success_logical))
  expect_true(assert(mtcars, not_na, vs, success_fun=success_logical))
  expect_true(assert(mtcars, not_na, mpg:carb, success_fun=success_logical))
  # lambdas
  # expect_true(assert(mtcars, function(x) x%%1==0, cyl, vs, am, gear, carb,
  #                    success_fun=success_logical))
  expect_true(assert(mtcars, function(x) if(x%%1!=0) return(FALSE), gear,
                     success_fun=success_logical))
  expect_true(assert(iris, function(x) nchar(as.character(x)) > 5, Species,
                     success_fun=success_logical))
})

test_that("assert returns correct result if verification passes (w/ `success_append`)", {
  expect_equal(
    get_assertr_success(assert(mtcars, in_set(0,1), vs, am, success_fun=success_append)),
    success_result("assert", "in_set(0, 1)", c("vs", "am"), NA, NA))
  expect_equal(
    get_assertr_success(assert(mtcars, within_bounds(3,5), gear, success_fun=success_append)),
    success_result("assert", "within_bounds(3, 5)", "gear", NA, NA))
  expect_equal(
    get_assertr_success(assert(mtcars, is.numeric, mpg:carb, success_fun=success_append)),
    success_result("assert", "is.numeric", colnames(mtcars), NA, NA))
  expect_equal(
    get_assertr_success(assert(mtcars, not_na, vs, success_fun=success_append)),
    success_result("assert", "not_na", "vs", NA, NA))
  expect_equal(
    get_assertr_success(assert(mtcars, not_na, mpg:carb, success_fun=success_append)),
    success_result("assert", "not_na", colnames(mtcars), NA, NA))
  expect_equal(
    get_assertr_success(assert(mtcars, function(x) x%%1==0, cyl, vs, am, gear, carb,
                               success_fun=success_append)),
    success_result("assert", "function(x) x%%1 == 0", c("cyl", "vs", "am", "gear", "carb"), NA, NA))
  expect_equal(
    get_assertr_success(assert(mtcars, function(x) if(x%%1!=0) return(FALSE), gear,
                               success_fun=success_append)),
    success_result("assert", "function(x) if (x%%1 != 0) return(FALSE)", "gear", NA, NA))
  expect_equal(
    get_assertr_success(assert(iris, function(x) nchar(as.character(x)) > 5, Species,
                               success_fun=success_append)),
    success_result("assert", "function(x) nchar(as.character(x)) > 5", "Species", NA, NA))
})

test_that("assert performs custom success function if verification passes", {
  expect_equal(assert(mtcars, not_na, mpg:carb, success_fun=give.validation), "great job!")
  expect_equal(assert(mtcars, within_bounds(3,5), gear, success_fun=function(x, ...) {return("noice!")}), "noice!")

})

test_that("assert raises error if verification fails", {
  expect_equal(assert(mtcars, within_bounds(3.5,4.5), gear, error_fun = error_logical), FALSE)
  expect_output(assert(mtcars, within_bounds(3.5,4.5), gear, error_fun = just.show.error),
               "Column 'gear' violates assertion 'within_bounds\\(3.5, 4.5\\)' 20 times.*")
  expect_equal(assert(mtcars, within_bounds(3,5), gear, carb, error_fun = error_logical), FALSE)
  expect_output(assert(mtcars, within_bounds(3,5), gear, carb, error_fun = just.show.error),
                 "Column 'carb' violates assertion 'within_bounds\\(3, 5\\)' 19 times")
  expect_equal(assert(mtcars, within_bounds(3.5, 4.5), carb, gear, error_fun = error_logical), FALSE)
  expect_output(assert(mtcars, within_bounds(3.5, 4.5), carb, gear, error_fun = just.show.error),
               "Column 'carb' violates assertion 'within_bounds\\(3.5, 4.5\\)' 22 times.+Column 'gear' violates assertion 'within_bounds\\(3.5, 4.5\\)' 20 times")
})

test_that("assert raises *custom error* if verification fails", {
  expect_error(assert(mtcars, within_bounds(3.5,4.5), gear, error_fun=not.helpful),
               "unspecified error")
  expect_error(assert(mtcars, within_bounds(3,5), gear, carb, error_fun=not.helpful),
               "unspecified error")
})

test_that("assert breaks appropriately", {
  expect_error(assert(in_set(0,1), mtcars$vs),
               "assert requires columns to be selected. Check number of arguments")
  expect_error(
    object = {
      assert(mtcars, in_set(0,1), vs, tree)
      },
    regexp = "Column `tree` doesn't exist",
    class = "error"
    )
  expect_error(assert(mtcars, in_set(0,1), vs, "tree"))
  expect_error(assert("tree"),
               "argument \"predicate\" is missing, with no default")
})

test_that("skip_chain_opts doesn't affect functionality outside chain for assert", {
  expect_equal(assert(mtcars, in_set(0,1), vs, am, skip_chain_opts=TRUE), mtcars)
  expect_equal(assert(mtcars, within_bounds(3,5), gear, skip_chain_opts=TRUE), mtcars)
  expect_true(assert(mtcars, in_set(0,1), vs, am, success_fun=success_logical, skip_chain_opts=TRUE))
  expect_true(assert(mtcars, within_bounds(3,5), gear, success_fun=success_logical, skip_chain_opts=TRUE))
  expect_equal(assert(mtcars, within_bounds(3.5,4.5), gear, error_fun=error_logical, skip_chain_opts=TRUE), FALSE)
  expect_output(assert(mtcars, within_bounds(3.5,4.5), gear, error_fun=just.show.error, skip_chain_opts=TRUE),
                "Column 'gear' violates assertion 'within_bounds\\(3.5, 4.5\\)' 20 times.*")
})

test_that("assert works with single row data.frames", {
  single_row_data <- head(mtcars, 1)

  expect_equal(assert(single_row_data, within_bounds(10,30), disp, error_fun = error_logical), FALSE)
  expect_output(assert(single_row_data, within_bounds(10,30), disp, error_fun = just.show.error),
               "Column 'disp' violates assertion 'within_bounds\\(10, 30\\)' 1 time.*")
  expect_equal(assert(single_row_data, within_bounds(10,30), disp, mpg, error_fun = error_logical), FALSE)
  expect_output(assert(single_row_data, within_bounds(10,30), disp, mpg, error_fun = just.show.error),
               "Column 'disp' violates assertion 'within_bounds\\(10, 30\\)' 1 time.*")
})

######################################





############### assert_rows ###############
test_that("assert_rows returns data if verification passes", {
  expect_equal(assert_rows(mtcars, rowSums, within_bounds(0,2), vs, am), mtcars)
  expect_equal(assert_rows(mtcars, num_row_NAs, within_bounds(0,.1), dplyr::everything()),
               mtcars)
  expect_equal(assert_rows(mtcars, rowSums, within_bounds(5,16), cyl, carb),
               mtcars)
  expect_equal(assert_rows(mnexmpl.data, num_row_NAs, within_bounds(0,2),
                           dplyr::everything()), mnexmpl.data)
  expect_equal(assert_rows(nexmpl.data, num_row_NAs, function(x) x < 2,
                           dplyr::everything()), nexmpl.data)
  expect_equal(assert_rows(mtcars, rowSums, function(x) if(x>16) return(FALSE), carb, cyl),
               mtcars)
})

test_that("assert_rows returns TRUE if verification passes (w/ `success_logical`", {
  expect_true(assert_rows(mtcars, rowSums, within_bounds(0,2), vs, am, success_fun=success_logical))
  expect_true(assert_rows(mtcars, num_row_NAs, within_bounds(0,.1), dplyr::everything(), success_fun=success_logical))
  expect_true(assert_rows(mtcars, rowSums, within_bounds(5,16), cyl, carb, success_fun=success_logical))
  expect_true(assert_rows(mnexmpl.data, num_row_NAs, within_bounds(0,2),
                           dplyr::everything(), success_fun=success_logical))
  expect_true(assert_rows(nexmpl.data, num_row_NAs, function(x) x < 2,
                           dplyr::everything(), success_fun=success_logical))
  expect_true(assert_rows(mtcars, rowSums, function(x) if(x>16) return(FALSE), carb, cyl, success_fun=success_logical))
})

test_that("assert_rows returns correct result if verification passes (w/ `success_append`", {
  expect_equal(
    get_assertr_success(assert_rows(mtcars, rowSums, within_bounds(0,2), vs, am, success_fun=success_append)),
    success_result("assert_rows", "within_bounds(0, 2)", c("vs", "am"), "rowSums", NA))
  expect_equal(
    get_assertr_success(assert_rows(mtcars, num_row_NAs, within_bounds(0,.1), dplyr::everything(), success_fun=success_append)),
    success_result("assert_rows", "within_bounds(0, 0.1)", colnames(mtcars), "num_row_NAs", NA))
  expect_equal(
    get_assertr_success(assert_rows(mtcars, rowSums, within_bounds(5,16), cyl, carb, success_fun=success_append)),
    success_result("assert_rows", "within_bounds(5, 16)", c("cyl", "carb"), "rowSums", NA))
  expect_equal(
    get_assertr_success(assert_rows(mnexmpl.data, num_row_NAs, within_bounds(0,2),
                                    dplyr::everything(), success_fun=success_append)),
    success_result("assert_rows", "within_bounds(0, 2)", colnames(mnexmpl.data), "num_row_NAs", NA))
  expect_equal(
    get_assertr_success(assert_rows(nexmpl.data, num_row_NAs, function(x) x < 2,
                                    dplyr::everything(), success_fun=success_append)),
    success_result("assert_rows", "function(x) x < 2", colnames(mnexmpl.data), "num_row_NAs", NA))
  expect_equal(
    get_assertr_success(assert_rows(mtcars, rowSums, function(x) if(x>16) return(FALSE), carb, cyl, success_fun=success_append)),
    success_result("assert_rows", "function(x) if (x > 16) return(FALSE)", c("carb", "cyl"), "rowSums", NA))
})

test_that("assert_rows performs custom success function if verification passes", {
  expect_equal(assert_rows(mtcars, rowSums, within_bounds(0,2), vs, am, success_fun=give.validation), "great job!")
  expect_equal(assert_rows(mtcars, rowSums, within_bounds(5,16), cyl, carb, success_fun=function(x, ...) {return("noice!")}), "noice!")

})

test_that("assert_rows raises error if verification fails", {
  expect_output(assert_rows(mtcars, rowSums, within_bounds(1,2), vs, am, error_fun = just.show.error),
               "Data frame row reduction 'rowSums' violates predicate 'within_bounds\\(1, 2\\)' 12 times")
  expect_output(assert_rows(mtcars, num_row_NAs, within_bounds(1,2), dplyr::everything(), error_fun = just.show.error),
                "Data frame row reduction 'num_row_NAs' violates predicate 'within_bounds\\(1, 2\\)' 32 times")
  expect_output(assert_rows(mtcars, rowSums, function(x) if(x==10) return(FALSE), carb, cyl, error_fun = just.show.error),
                "Data frame row reduction 'rowSums' violates predicate 'function\\(x\\) if \\(x == 10\\) return\\(FALSE\\)' 8 times")
  expect_output(assert_rows(mnexmpl.data, num_row_NAs, within_bounds(0,1), dplyr::everything(), error_fun = just.show.error),
                "Data frame row reduction 'num_row_NAs' violates predicate 'within_bounds\\(0, 1\\)' 1 time")
})

test_that("assert_rows raises *custom error* if verification fails", {
  expect_error(assert_rows(mnexmpl.data, num_row_NAs, within_bounds(0,1), dplyr::everything(), error_fun=not.helpful),
               "unspecified error")
})

test_that("assert_rows breaks appropriately", {
  expect_error(assert_rows(in_set(0,1), mtcars$vs),
               "argument \"predicate\" is missing, with no default")
  expect_error(assert_rows(rowSums, in_set(0,1), mtcars$vs),
               "assert_rows requires columns to be selected. Check number of arguments")
  expect_error(
    object = {
      assert_rows(
        data = mtcars,
        row_reduction_fn = rowSums,
        predicate = in_set(0,1,2),
        vs,
        am,
        tree
        )
      },
    regexp = "Column `tree` doesn't exist",
    class = "error"
    )
  expect_error(assert_rows(mtcars, rowSums, in_set(0,1,2), vs, am, "tree"))
  expect_error(assert_rows("tree"),
               "argument \"row_reduction_fn\" is missing, with no default")
})

test_that("skip_chain_opts doesn't affect functionality outside chain for assert_rows", {
  expect_equal(assert_rows(mtcars, rowSums, within_bounds(0,2), vs, am, skip_chain_opts=TRUE), mtcars)
  expect_equal(assert_rows(mtcars, num_row_NAs, within_bounds(0,.1), dplyr::everything(), skip_chain_opts=TRUE),
               mtcars)
  expect_true(assert_rows(mtcars, rowSums, within_bounds(0,2), vs, am, success_fun=success_logical, skip_chain_opts=TRUE))
  expect_true(assert_rows(mtcars, num_row_NAs, within_bounds(0,.1), dplyr::everything(), success_fun=success_logical, skip_chain_opts=TRUE))
  expect_output(assert_rows(mtcars, rowSums, within_bounds(1,2), vs, am, error_fun=just.show.error, skip_chain_opts=TRUE),
                "Data frame row reduction 'rowSums' violates predicate 'within_bounds\\(1, 2\\)' 12 times")
  expect_output(assert_rows(mtcars, num_row_NAs, within_bounds(1,2), dplyr::everything(), error_fun=just.show.error, skip_chain_opts=TRUE),
                "Data frame row reduction 'num_row_NAs' violates predicate 'within_bounds\\(1, 2\\)' 32 times")
})

######################################


############### insist ###############
test_that("insist returns data if verification passes", {
  expect_equal(insist(our.iris, within_n_sds(3), Sepal.Length), our.iris)
  expect_equal(insist(our.iris.3, within_n_sds(2), Sepal.Length), our.iris.3)
  expect_equal(insist(our.iris, within_n_sds(4), Sepal.Length:Petal.Width),
               our.iris)
})

test_that("insist returns TRUE if verification passes (w/ success_logical)", {
  expect_true(insist(our.iris, within_n_sds(3), Sepal.Length, success_fun=success_logical))
  expect_true(insist(our.iris.3, within_n_sds(2), Sepal.Length, success_fun=success_logical))
  expect_true(insist(our.iris, within_n_sds(4), Sepal.Length:Petal.Width, success_fun=success_logical))
})

test_that("insist returns correct result if verification passes (w/ `success_append`", {
  expect_equal(
    get_assertr_success(insist(our.iris, within_n_sds(3), Sepal.Length, success_fun=success_append)),
    success_result("insist", "within_n_sds(3)", "Sepal.Length", NA, NA))
  expect_equal(
    get_assertr_success(insist(our.iris.3, within_n_sds(2), Sepal.Length, success_fun=success_append)),
    success_result("insist", "within_n_sds(2)", "Sepal.Length", NA, NA))
  expect_equal(
    get_assertr_success(insist(our.iris, within_n_sds(4), Sepal.Length:Petal.Width, success_fun=success_append)),
    success_result("insist", "within_n_sds(4)", c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width"), NA, NA))
})

test_that("insist performs custom success function if verification passes", {
  expect_equal(insist(our.iris, within_n_sds(3), Sepal.Length, success_fun=give.validation), "great job!")
  expect_equal(insist(our.iris.3, within_n_sds(2), Sepal.Length, success_fun=function(x, ...){return("noice!")}), "noice!")
})

test_that("insist raises error if verification fails", {
  expect_output(insist(our.iris, within_n_sds(2), Sepal.Length, error_fun = just.show.error),
                "Column 'Sepal.Length' violates assertion 'within_n_sds\\(2\\)' 6 times")
  expect_output(insist(our.iris.2, within_n_sds(2), Sepal.Length, error_fun = just.show.error),
                "Column 'Sepal.Length' violates assertion 'within_n_sds\\(2\\)' 5 times")
  expect_output(insist(our.iris, within_n_sds(3), Sepal.Length:Petal.Width, error_fun = just.show.error),
                "Column 'Sepal.Width' violates assertion 'within_n_sds\\(3\\)' 1 time")
  expect_output(insist(our.iris, within_n_sds(2), Sepal.Length:Petal.Width, error_fun = just.show.error),
                "Column 'Sepal.Length' violates assertion 'within_n_sds\\(2\\)' 6 times.*Column 'Sepal.Width' violates assertion 'within_n_sds\\(2\\)' 5 times")
})

test_that("insist raises *custom error* if verification fails", {
  expect_error(insist(our.iris, within_n_sds(2), Sepal.Length, error_fun=not.helpful),
               "unspecified error")
  expect_error(insist(our.iris.2, within_n_sds(2), Sepal.Length, error_fun=not.helpful),
               "unspecified error")
})

test_that("insist breaks appropriately", {
  expect_error(insist(within_n_sds(5), mtcars$vs),
               "insist requires columns to be selected. Check number of arguments")
  expect_error(insist(mtcars, within_n_sds(5), "vs:am"))
  expect_error(
    object = {
      insist(data = mtcars, predicate_generator = within_n_sds(5), tree)
      },
    regexp = "Column `tree` doesn't exist",
    class = "error"
    )
  expect_error(insist("tree"),
               "argument \"predicate_generator\" is missing, with no default")
  expect_error(insist(iris, within_n_sds(5), Petal.Width:Species),
               "argument must be a numeric vector")
})

test_that("skip_chain_opts doesn't affect functionality outside chain for insist", {
  expect_equal(insist(our.iris, within_n_sds(3), Sepal.Length, skip_chain_opts=TRUE), our.iris)
  expect_equal(insist(our.iris.3, within_n_sds(2), Sepal.Length, skip_chain_opts=TRUE), our.iris.3)
  expect_equal(insist(our.iris, within_n_sds(3), Sepal.Length, success_fun=give.validation, skip_chain_opts=TRUE),
               "great job!")
  expect_equal(insist(our.iris.3, within_n_sds(2), Sepal.Length, success_fun=function(x, ...){return("noice!")}, skip_chain_opts=TRUE),
               "noice!")
  expect_output(insist(our.iris, within_n_sds(2), Sepal.Length, error_fun=just.show.error, skip_chain_opts=TRUE),
                "Column 'Sepal.Length' violates assertion 'within_n_sds\\(2\\)' 6 times")
  expect_output(insist(our.iris.2, within_n_sds(2), Sepal.Length, error_fun=just.show.error, skip_chain_opts=TRUE),
                "Column 'Sepal.Length' violates assertion 'within_n_sds\\(2\\)' 5 times")
})

######################################


############### insist rows ###############
test_that("insist_rows returns data if verification passes", {
  expect_equal(insist_rows(our.iris, maha_dist, within_n_sds(6), dplyr::everything()), our.iris)
  expect_equal(insist_rows(our.iris, maha_dist, within_n_mads(10), Sepal.Length:Species), our.iris)
  expect_equal(insist_rows(our.iris, maha_dist, within_n_mads(11), Sepal.Length:Petal.Width),
               our.iris)
})

test_that("insist_rows returns correct result if verification passes (w/ `success_append`", {
  expect_equal(
    get_assertr_success(insist_rows(our.iris, maha_dist, within_n_sds(6), dplyr::everything(), success_fun=success_append)),
    success_result("insist_rows", "within_n_sds(6)", colnames(our.iris), "maha_dist", NA))
  expect_equal(
    get_assertr_success(insist_rows(our.iris, maha_dist, within_n_mads(10), Sepal.Length:Species, success_fun=success_append)),
    success_result("insist_rows", "within_n_mads(10)", colnames(our.iris), "maha_dist", NA))
  expect_equal(
    get_assertr_success(insist_rows(our.iris, maha_dist, within_n_mads(11), Sepal.Length:Petal.Width, success_fun=success_append)),
    success_result("insist_rows", "within_n_mads(11)", c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width"), "maha_dist", NA))
})

test_that("insist_rows raises error if verification fails", {
  expect_output(insist_rows(our.iris, maha_dist, within_n_sds(4), dplyr::everything(), error_fun = just.show.error),
                "Data frame row reduction 'maha_dist' violates predicate 'within_n_sds\\(4\\)' 1 time")
  expect_output(insist_rows(our.iris, maha_dist, within_n_sds(2), dplyr::everything(), error_fun = just.show.error),
                "Data frame row reduction 'maha_dist' violates predicate 'within_n_sds\\(2\\)' 8 times")
  expect_output(insist_rows(our.iris, maha_dist, within_n_mads(5), Sepal.Length:Species, error_fun = just.show.error),
                "Data frame row reduction 'maha_dist' violates predicate 'within_n_mads\\(5\\)' 1 time")
  expect_output(insist_rows(our.iris, maha_dist, within_n_mads(5), Sepal.Length:Petal.Width, error_fun = just.show.error),
                "Data frame row reduction 'maha_dist' violates predicate 'within_n_mads\\(5\\)' 4 times")
})

test_that("insist_rows raises *custom error* if verification fails", {
  expect_error(insist_rows(our.iris, maha_dist, within_n_mads(5), Sepal.Length:Petal.Width, error_fun = not.helpful),
               "unspecified error")
})

test_that("insist_rows breaks appropriately", {
  expect_error(insist_rows(within_n_sds(5), mtcars$vs),
               "argument \"predicate_generator\" is missing, with no default")
  expect_error(insist_rows(mtcars, within_n_sds(10), vs),
               "object 'vs' not found")
  expect_error(insist_rows(mtcars, maha_dist, within_n_sds(10), vs),
               "\"data\" needs to have at least two columns")
  expect_error(insist_rows(mtcars, maha_dist, within_bound(0, 10), vs, am),
               "could not find function \"within_bound\"")
  expect_error(insist_rows(), "argument \"row_reduction_fn\" is missing, with no default")
  expect_error(insist_rows(mtcars), "argument \"row_reduction_fn\" is missing, with no default")
  expect_error(insist_rows(mtcars, maha_dist, am, vs),
               "object 'am' not found")
  expect_error(insist_rows(mtcars, maha_dist, am, vs, carb),
               "object 'am' not found")

  expect_error(insist_rows(lm(Petal.Length ~ Petal.Width, data=iris)),
               "argument \"row_reduction_fn\" is missing, with no default")
})

test_that("skip_chain_opts doesn't affect functionality outside chain for insist_rows", {
  expect_equal(insist_rows(our.iris, maha_dist, within_n_sds(6), dplyr::everything(), skip_chain_opts=TRUE),
               our.iris)
  expect_equal(insist_rows(our.iris, maha_dist, within_n_mads(10), Sepal.Length:Species, skip_chain_opts=TRUE),
               our.iris)
  expect_output(insist_rows(our.iris, maha_dist, within_n_sds(4), dplyr::everything(), error_fun=just.show.error, skip_chain_opts=TRUE),
                "Data frame row reduction 'maha_dist' violates predicate 'within_n_sds\\(4\\)' 1 time")
  expect_output(insist_rows(our.iris, maha_dist, within_n_sds(2), dplyr::everything(), error_fun=just.show.error, skip_chain_opts=TRUE),
                "Data frame row reduction 'maha_dist' violates predicate 'within_n_sds\\(2\\)' 8 times")
  expect_error(insist_rows(within_n_sds(5), mtcars$vs, skip_chain_opts=TRUE),
               "argument \"predicate_generator\" is missing, with no default")
  expect_error(insist_rows(mtcars, within_n_sds(10), vs, skip_chain_opts=TRUE),
               "object 'vs' not found")
})

###########################################


########## chaining works ############

# A special error function for these tests, produces the error but no
# standard output.
error_no_output <- function (list_of_errors, data=NULL, ...) {
  stop("assertr stopped execution", call.=FALSE)
}

strip_attributes <- function(d){
  attr(d, "assertr_in_chain_error_fun_override") <- NULL
  attr(d, "assertr_in_chain_success_fun_override") <- NULL
  d
}

ret_num_off_errors <- function(errors, data=NULL, warn=FALSE, ...){
  if(!is.null(data) && !is.null(attr(data, "assertr_errors")))
    errors <- append(attr(data, "assertr_errors"), errors)
  num.of.errors <- length(errors)
  cat(sprintf("There %s %d error%s:\n",
              ifelse(num.of.errors==1,"is", "are"),
              num.of.errors,
              ifelse(num.of.errors==1,"", "s")))
}

success_message <- function(data=NULL, ...) {
  message("Assertion passed")
  return(data)
}

error_message <- function(errors, data=NULL) {
  message("Assertion failed")
  return(data)
}

##### !!! chaining: assert
test_that("assert works with chaining", {

  # only assert with no error
  code_to_test <- function() {
    test.df %>%
      chain_start %>%
      assert(in_set(0,1,2), x) %>%
      chain_end %>% strip_attributes
  }
  expect_equal(code_to_test(), test.df)

  # only assert with no error stores success correctly
  code_to_test <- function() {
    test.df %>%
      chain_start(store_success = TRUE) %>%
      assert(in_set(0,1,2), x) %>%
      chain_end %>% strip_attributes
  }
  expect_equal(
    get_assertr_success(code_to_test()),
    success_result("assert", "in_set(0, 1, 2)", "x", NA, NA))

  # only assert with print state on success in chain
  code_to_test <- function() {
    test.df %>%
      chain_start %>%
      assert(in_set(0,1,2), x, success_fun=success_message, skip_chain_opts=TRUE) %>%
      chain_end %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion passed")

  # only assert with error
  code_to_test <- function() {
    test.df %>%
      chain_start %>%
      assert(in_set(0,1), x) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There is 1 error")

  # only assert with printed state on error in chain
  code_to_test <- function() {
    test.df %>%
      chain_start %>%
      assert(in_set(0,1), x, error_fun=error_message, skip_chain_opts=TRUE) %>%
      chain_end %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion failed")

  # two asserts with no error
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert(in_set(0,1,2), x) %>%
      assert(within_bounds(1,2),y) %>%
      chain_end %>% strip_attributes
  }
  expect_equal(code_to_test(), test.df2)

  # two asserts with no error and storing success results
  code_to_test <- function() {
    test.df2 %>%
      chain_start(store_success=TRUE) %>%
      assert(in_set(0,1,2), x) %>%
      assert(within_bounds(1,2),y) %>%
      chain_end %>% strip_attributes
  }
  expect_equal(
    get_assertr_success(code_to_test()),
    append(
      success_result("assert", "in_set(0, 1, 2)", "x", NA, NA),
      success_result("assert", "within_bounds(1, 2)", "y", NA, NA)
    )
  )

  # only assert with error (1st)
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert(in_set(0,1), x) %>%
      assert(within_bounds(1,2),y) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There is 1 error")

  # two asserts with error (1st) and chain callback overwriten
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert(in_set(0,1), x, error_fun=error_message, skip_chain_opts=TRUE) %>%
      assert(within_bounds(1,2),y) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion failed")

  # only assert with error (2st)
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert(within_bounds(1,2),y) %>%
      assert(in_set(0,1), x) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There is 1 error")

  # only assert with two errors
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert(within_bounds(1,1.5),y) %>%
      assert(in_set(0,1), x) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There are 2 errors")

  # two asserts with two errors and one callback overwritten in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert(within_bounds(1,1.5),y, error_fun=error_message, skip_chain_opts=TRUE) %>%
      assert(in_set(0,1), x) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(expect_message(code_to_test(), "Assertion failed"), "There is 1 error")
})


##### !!! chaining: assert_rows
test_that("assert_rows works with chaining", {

  # only assert_rows with no error
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert_rows(col_concat, is_uniq, x, y) %>%
      chain_end %>% strip_attributes
  }
  expect_equal(code_to_test(), test.df2)

  # only assert_rows with no error and storing success result
  code_to_test <- function() {
    test.df2 %>%
      chain_start(store_success=TRUE) %>%
      assert_rows(col_concat, is_uniq, x, y) %>%
      chain_end %>% strip_attributes
  }
  expect_equal(
    get_assertr_success(code_to_test()),
    success_result("assert_rows", "is_uniq", c("x", "y"), "col_concat", NA)
  )

  # only assert_rows with print state on success in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert_rows(col_concat, is_uniq, x, y, success_fun=success_message, skip_chain_opts=TRUE) %>%
      chain_end %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion passed")

  # only assert_row with error
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert_rows(rowSums, not_na, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There is 1 error")

  # only assert_rows with printed state on error in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert_rows(rowSums, not_na, x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion failed")

  # two asserts_row with no error
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert_rows(rowSums, is.numeric, x, y, z) %>%
      assert_rows(col_concat, is.character, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_equal(code_to_test(), test.df2)

  # two asserts_row with no error ans storing success
  code_to_test <- function() {
    test.df2 %>%
      chain_start(store_success=TRUE) %>%
      assert_rows(rowSums, is.numeric, x, y, z) %>%
      assert_rows(col_concat, is.character, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_equal(
    get_assertr_success(code_to_test()),
    append(
      success_result("assert_rows", "is.numeric", c("x", "y", "z"), "rowSums", NA),
      success_result("assert_rows", "is.character", c("x", "y", "z"), "col_concat", NA)
    )
  )

  # only assert_rows with error (1st)
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert_rows(rowSums, is.character, x, y, z) %>%
      assert_rows(col_concat, is.character, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There is 1 error")

  # two assert_rows with error (1st) and callback overwritten in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert_rows(rowSums, is.character, x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
      assert_rows(col_concat, is.character, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion failed")

  # only assert_rows with error (2st)
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert_rows(col_concat, is.character, x, y, z) %>%
      assert_rows(rowSums, is.character, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There is 1 error")

  # only assert_rows with two error
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert_rows(col_concat, is.numeric, x, y, z) %>%
      assert_rows(rowSums, is.character, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There are 2 errors")

  # only assert_rows with two errors and one callback overwritten in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      assert_rows(col_concat, is.numeric, x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
      assert_rows(rowSums, is.character, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(expect_message(code_to_test(), "Assertion failed"))
})




##### !!! chaining: insist
test_that("insist works with chaining", {

  # only insist with no error
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist(within_n_mads(5), x, y, z) %>%
      chain_end %>% strip_attributes
  }
  expect_equal(code_to_test(), test.df2)

  # only insist with no error ans storing success
  code_to_test <- function() {
    test.df2 %>%
      chain_start(store_success=TRUE) %>%
      insist(within_n_mads(5), x, y, z) %>%
      chain_end %>% strip_attributes
  }
  expect_equal(
    get_assertr_success(code_to_test()),
    success_result("insist", "within_n_mads(5)", c("x", "y", "z"), NA, NA)
  )


  # only insist with print state on success in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist(within_n_mads(5), x, y, z, success_fun=success_message, skip_chain_opts=TRUE) %>%
      chain_end %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion passed")

  # only insist with error (3 of them, though)
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist(within_n_mads(.4), x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There are 3 errors")

  # only insist with printed state on error in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist(within_n_mads(.4), x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion failed")

  # two insists with no error
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist(within_n_mads(5), x, y, z) %>%
      insist(within_n_sds(5), x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_equal(code_to_test(), test.df2)

  # two insists with no error and storing success
  code_to_test <- function() {
    test.df2 %>%
      chain_start(store_success=TRUE) %>%
      insist(within_n_mads(5), x, y, z) %>%
      insist(within_n_sds(5), x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_equal(
    get_assertr_success(code_to_test()),
    append(
      success_result("insist", "within_n_mads(5)", c("x", "y", "z"), NA, NA),
      success_result("insist", "within_n_sds(5)", c("x", "y", "z"), NA, NA)
    )
  )

  # two insists with error (1st)
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist(within_n_mads(.4), x, y, z) %>%
      insist(within_n_sds(5), x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There are 3 errors")

  # two insists with error (1st) and callback overwritten in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist(within_n_mads(.4), x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
      insist(within_n_sds(5), x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion failed")

  # two insists with error (2st)
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist(within_n_sds(5), x, y, z) %>%
      insist(within_n_mads(.4), x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There are 3 errors")

  # two insists with two error
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist(within_n_sds(.4), x, y, z) %>%
      insist(within_n_mads(.4), x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There are 6 errors")

  # two insists with two errors and one callback overwritten in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist(within_n_sds(.4), x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
      insist(within_n_mads(.4), x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(expect_message(code_to_test(), "Assertion failed"))
})


##### !!! chaining: insist_rows
test_that("insist_rows works with chaining", {

  # only insist_rows with no error
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist_rows(maha_dist, function(x){function(...) TRUE}, x, y, z) %>%
      chain_end %>% strip_attributes
  }
  expect_equal(code_to_test(), test.df2)

  # only insist_rows with no error and storing success
  code_to_test <- function() {
    test.df2 %>%
      chain_start(store_success=TRUE) %>%
      insist_rows(maha_dist, function(x){function(...) TRUE}, x, y, z) %>%
      chain_end %>% strip_attributes
  }
  expect_equal(
    get_assertr_success(code_to_test()),
    success_result("insist_rows", as.character(expression(function(x){function(...) TRUE})), c("x", "y", "z"), "maha_dist", NA)
  )

  # only insist_rows with print state on success in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist_rows(maha_dist, function(x){function(...) TRUE}, x, y, z, success_fun=success_message, skip_chain_opts=TRUE) %>%
      chain_end %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion passed")

  # only insist_rows with error (3 of them, though)
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist_rows(maha_dist, function(x){function(...) FALSE}, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There is 1 error")

  # only insist_rows with printed state on error in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist_rows(maha_dist, function(x){function(...) FALSE}, x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion failed")

  # two insists_rows with no error
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist_rows(maha_dist, function(x){function(...) TRUE}, x, y, z) %>%
      insist_rows(col_concat, function(x){function(...) TRUE}, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_equal(code_to_test(), test.df2)

  # two insists_rows with no error and storing success results
  code_to_test <- function() {
    test.df2 %>%
      chain_start(store_success=TRUE) %>%
      insist_rows(maha_dist, function(x){function(...) TRUE}, x, y, z) %>%
      insist_rows(col_concat, function(x){function(...) TRUE}, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_equal(
    get_assertr_success(code_to_test()),
    append(
      success_result("insist_rows", as.character(expression(function(x){function(...) TRUE})), c("x", "y", "z"), "maha_dist", NA),
      success_result("insist_rows", as.character(expression(function(x){function(...) TRUE})), c("x", "y", "z"), "col_concat", NA)
    )
  )

  # two insists_rows with error (1st)
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist_rows(maha_dist, function(x){function(...) FALSE}, x, y, z) %>%
      insist_rows(col_concat, function(x){function(...) TRUE}, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There is 1 error")

  # two insists_rows with error (1st) and callback overwritten in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist_rows(maha_dist, function(x){function(...) FALSE}, x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
      insist_rows(col_concat, function(x){function(...) TRUE}, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion failed")

  # two insists with error (2st)
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist_rows(col_concat, function(x){function(...) TRUE}, x, y, z) %>%
      insist_rows(maha_dist, function(x){function(...) FALSE}, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There is 1 error")

  # two insists_rows with two errors
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist_rows(col_concat, function(x){function(...) FALSE}, x, y, z) %>%
      insist_rows(maha_dist, function(x){function(...) FALSE}, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There are 2 errors")

  # two insists_rows with two errors and one callback overwritten in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      insist_rows(col_concat, function(x){function(...) FALSE}, x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
      insist_rows(maha_dist, function(x){function(...) FALSE}, x, y, z) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(expect_message(code_to_test(), "Assertion failed"), "There is 1 error")
})


##### !!! chaining: verify
test_that("verify works with chaining", {

  # only verify with no error
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      verify(x >= 0) %>%
      chain_end %>% strip_attributes
  }
  expect_equal(code_to_test(), test.df2)

  # only verify with no error ans storing success results
  code_to_test <- function() {
    test.df2 %>%
      chain_start(store_success=TRUE) %>%
      verify(x >= 0) %>%
      chain_end %>% strip_attributes
  }
  expect_equal(
    get_assertr_success(code_to_test()),
    success_result("verify", "x >= 0", NA, NA, NA)
  )

  # only verify with print state on success in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      verify(x >= 0, success_fun=success_message, skip_chain_opts=TRUE) %>%
      chain_end %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion passed")

  # only verify with error
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      verify(x > 0) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There is 1 error")

  # only verify with printed state on error in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      verify(x > 0, error_fun=error_message, skip_chain_opts=TRUE) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion failed")

  # two verify with no error
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      verify(x >= 0) %>%
      verify(y > 0) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_equal(code_to_test(), test.df2)

  # two verify with no error and storing success results
  code_to_test <- function() {
    test.df2 %>%
      chain_start(store_success=TRUE) %>%
      verify(x >= 0) %>%
      verify(y > 0) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_equal(
    get_assertr_success(code_to_test()),
    append(
      success_result("verify", "x >= 0", NA, NA, NA),
      success_result("verify", "y > 0", NA, NA, NA)
    )
  )

  # two verify with error (1st)
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      verify(x > 0) %>%
      verify(y > 0) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There is 1 error")

  # two verify with error (1st) and callback overwritten in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      verify(x > 0, error_fun=error_message, skip_chain_opts=TRUE) %>%
      verify(y > 0) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_message(code_to_test(), "Assertion failed")

  # two verify with error (2st)
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      verify(y > 0) %>%
      verify(x > 0) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There is 1 error")

  # two verify with two errors
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      verify(y > 2) %>%
      verify(x > 0) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(code_to_test(), "There are 2 errors")

  # two verify with two errors and one callback overwritten in chain
  code_to_test <- function() {
    test.df2 %>%
      chain_start %>%
      verify(y > 2, error_fun=error_message, skip_chain_opts=TRUE) %>%
      verify(x > 0) %>%
      chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
  }
  expect_output(expect_message(code_to_test(), "Assertion failed"), "There is 1 error")
})
###################################


##### !!! rlang .data and unquoting
test_that("all assertions work with .data pronoun without chains", {
  # Define some data we might accidentally reference outside the test.df frame
  y <- 0:2

  ## verify() ##
  # Cases where the name exists:
  # Also test the logical versions here to make sure nothing too weird is happening.
  expect_equal(verify(test.df, .data$x <= 2), test.df)  # expect success
  expect_true(verify(test.df, .data$x <= 2, success_fun = success_logical))
  expect_output(verify(test.df, .data$x > 2, error_fun = just.show.error),
                "verification [.data$x > 2] failed! (3 failures)", fixed = TRUE)
  expect_false(verify(test.df, .data$x > 2, error_fun = error_logical))

  # Cases where the name doesn't exist:
  expect_error(verify(test.df, .data$y <= 2, error_fun = just.show.error))
  # expect success from y defined above
  expect_equal(verify(test.df, y <= 2), test.df)

  ## assert() ##
  expect_equal(assert(test.df, within_bounds(-Inf, 2), x), test.df)
  expect_output(
    expect_error(assert(test.df, within_bounds(2, Inf), x)),
    regexp="Column 'x' violates assertion 'within_bounds(2, Inf)' 2 times",
    fixed=TRUE
  )

  ## insist() ##
  expect_equal(insist(test.df, within_n_sds(1), x), test.df)
  expect_output(insist(test.df, within_n_sds(0.1), x,
    error_fun = just.show.error),
    "Column 'x' violates assertion 'within_n_sds(0.1)' 2 times", fixed = TRUE)
})

test_that("all assertions work with .data pronoun in chains", {
  # Define some data we might accidentally reference outside the test.df frame
  y <- 0:2

  ## verify() ##
  # Cases where the name exists:
  # Also test the logical versions here to make sure nothing too weird is happening.
  expect_equal(test.df %>% verify(x <= 2), test.df)
  expect_true(test.df %>% verify(x <= 2, success_fun = success_logical))
  expect_output(test.df %>% verify(x > 2, error_fun = just.show.error),
                "verification [x > 2] failed! (3 failures)", fixed = TRUE)
  expect_false(test.df %>% verify(x > 2, error_fun = error_logical))

  # Cases where the name doesn't exist:
  #expect_error(test.df %>% verify(y <= 2, error_fun = just.show.error))
  expect_error(test.df %>% verify(.data$y <= 2, error_fun = just.show.error))
  expect_equal(test.df %>% verify(y <= 2), test.df)

  ## assert() ##
  expect_equal(test.df %>% assert(within_bounds(-Inf, 2), x), test.df)
  expect_output(test.df %>% assert(within_bounds(2, Inf), x,
    error_fun = just.show.error),
    "Column 'x' violates assertion 'within_bounds(2, Inf)' 2 times", fixed = TRUE)

  ## insist() ##
  expect_equal(test.df %>% insist(within_n_sds(1), x), test.df)
  expect_output(test.df %>% insist(within_n_sds(0.1), x,
    error_fun = just.show.error),
    "Column 'x' violates assertion 'within_n_sds(0.1)' 2 times", fixed = TRUE)
})



test_that("all assertions work with !! unquoting", {
  x <- 2:4
  y <- 0:2
  z <- 3
  varname <- rlang::quo(x)

  ## verify() ##
  expect_equal(verify(test.df, !! x > 1), test.df)        # 2:4 > 1
  expect_equal(verify(test.df, !! x > .data$x), test.df)  # 2:4 > .data$x
  expect_equal(verify(test.df, !! y == .data$x), test.df) # 0:2 == .data$x
  expect_equal(verify(test.df, !! varname < 3), test.df)  # x < 3

  expect_output(verify(test.df, !! x < 1, error_fun = just.show.error),
    "verification [2:4 < 1] failed! (3 failures)", fixed = TRUE)
  expect_output(verify(test.df, !! x < x, error_fun = just.show.error),
    "verification [2:4 < x] failed! (3 failures)", fixed = TRUE)
  expect_output(verify(test.df, !! y != x, error_fun = just.show.error),
    "verification [0:2 != x] failed! (3 failures)", fixed = TRUE)
  expect_output(verify(test.df, !! varname > 3, error_fun = just.show.error),
    # this is a weird error message, but it's fine I guess
    "verification [(~x) > 3] failed! (3 failures)", fixed = TRUE)

  ## assert() ##
  # Note that !!min(x) becomes min(2:4), so this works:
  expect_equal(assert(test.df, within_bounds(-Inf, !!min(x)), x), test.df)
  expect_equal(assert(test.df, within_bounds(-Inf, 2), !! varname), test.df)

  expect_output(assert(test.df, within_bounds(2, Inf), !! varname,
    error_fun = just.show.error),
    "Column 'x' violates assertion 'within_bounds(2, Inf)' 2 times",
    fixed = TRUE)
  expect_output(assert(test.df, within_bounds(!!z-1, Inf), x,
    error_fun = just.show.error),
    "Column 'x' violates assertion 'within_bounds(3 - 1, Inf)' 2 times",
    fixed = TRUE)

  ## insist() ##
  expect_equal(test.df %>% insist(within_n_sds(!! z), !! varname), test.df)
  expect_output(test.df %>% insist(within_n_sds(!! z/10), !! varname,
    error_fun = just.show.error),
    "Column 'x' violates assertion 'within_n_sds(3/10)' 2 times", fixed = TRUE)
})

test_that("verify works with variable-argument-length is_uniq", {
  # These x, y, z should not be used by the is_uniq below because the
  # predicates use a data mask
  x <- 2:4
  y <- 0:2
  z <- 3
  varname <- rlang::quo(x)

  # test.df2 <- data.frame(x = c(0, 1, 2),
  #                        y = c(2, 1.5, 1),
  #                        z = c(0,NA, -1))
  expect_equal(verify(test.df2, is_uniq(x)), test.df2)
  expect_equal(verify(test.df2, is_uniq(x, y)), test.df2)
  expect_equal(verify(test.df2, is_uniq(x, y, z, allow.na=TRUE)), test.df2)
  expect_equal(verify(test.df2, is_uniq(!!varname)), test.df2)

  df_dups <- data.frame(x = c(0, 0, 1, 2),
                             y = c(1, 2, 2, NA),
                             z = c(1, 1, 2, 3))
  expect_output(verify(df_dups, is_uniq(x, z), error_fun = just.show.error),
    "verification [is_uniq(x, z)] failed! (2 failures)", fixed = TRUE)
  expect_equal(verify(df_dups, is_uniq(x, y, allow.na = TRUE)), df_dups)
  expect_output(verify(df_dups, is_uniq(x, y), error_fun = just.show.error),
    "verification [is_uniq(x, y)] failed! (1 failure)", fixed = TRUE)

})

test_that("description is correctly stored and displayed in results", {

  description <- "vs and am should be only 0 or 1."

  # Error

  check_error <- mtcars %>%
    assert(in_set(0, 2), am, vs, error_fun = error_return,
           description=description)

  # error outside chain
  expect_equal(
    check_error[[1]][["description"]],
    description
  )

  expect_output(
    print(check_error[[1]]),
    description
  )

  # error inside chain
  check_error <- mtcars %>%
    chain_start %>%
    assert(in_set(0, 2), am, vs, description=description) %>%
    chain_end(error_fun = error_return)

  expect_equal(
    check_error[[1]][["description"]],
    description
  )

  expect_output(
    print(check_error[[1]]),
    description
  )

  # Success

  check_success_df <- function() {
    mtcars %>%
      assert(in_set(0, 1), am, vs, success_fun=success_df_return,
             description=description)
  }

  check_success_report <- function() {
    mtcars %>%
      assert(in_set(0, 1), am, vs, success_fun=success_report,
             description=description)
  }

  # success outside chain
  expect_equal(
    check_success_df()[1, "description"],
    description
  )

  expect_output(
    print(check_success_report()),
    description
  )

  # success inside chain
  check_success_df <- function() {
    mtcars %>%
      chain_start(store_success=TRUE) %>%
      assert(in_set(0, 1), am, vs, description=description) %>%
      chain_end(success_fun=success_df_return)
  }

  check_success_report <- function() {
    mtcars %>%
      chain_start(store_success=TRUE) %>%
      assert(in_set(0, 1), am, vs, success_fun=success_report,
             description=description) %>%
      chain_end(success_fun=success_df_return)
  }

  expect_equal(
    check_success_df()[1, "description"],
    description
  )

  expect_output(
    print(check_success_report()),
    description
  )

  # Defect

  check_defect_df <- function() {
    mtcars %>%
      dplyr::select(-am) %>%
      verify(has_all_names("am", "vs"), obligatory=TRUE, error_fun=error_append) %>%
      assert(in_set(0, 1), am, vs, defect_fun=defect_df_return,
             description=description)
  }

  check_defect_report <- function() {
    mtcars %>%
      dplyr::select(-am) %>%
      verify(has_all_names("am", "vs"), obligatory=TRUE, error_fun=error_append) %>%
      assert(in_set(0, 1), am, vs, defect_fun=defect_report,
             description=description)
  }

  # defect outside chain
  expect_equal(
    check_defect_df()[1, "description"],
    description
  )

  expect_output(
    print(check_defect_report()),
    description
  )

  # defect inside chain
  check_defect_df <- function() {
    mtcars %>%
      select(-am) %>%
      chain_start %>%
      verify(has_all_names("am", "vs"), obligatory=TRUE) %>%
      assert(in_set(0, 1), am, vs, description=description) %>%
      chain_end(defect_fun=defect_df_return)
  }

  check_defect_report <- function() {
    mtcars %>%
      select(-am) %>%
      chain_start %>%
      verify(has_all_names("am", "vs"), obligatory=TRUE) %>%
      assert(in_set(0, 1), am, vs, defect_fun=defect_report,
             description=description) %>%
      chain_end(defect_fun=defect_df_return)
  }

  expect_equal(
    check_success_df()[1, "description"],
    description
  )

  expect_output(
    print(check_success_report()),
    description
  )

})

test_that("handle predicates applied to the whole data, and not to subframe", {
  a_tibble <- tibble::tibble(
    a = c(0, 0),
    b = c(0,0)
  ) %>%
    head( n = 0)

  expect_silent({
    assert(data = a_tibble, predicate = function(x) nrow(x) == 0L, dplyr::everything())
  })
})