Error chaining broken with assert_rows and insist_rows

[peterwicksstringfield]

If assert_rows or insist_rows is called during a chain, and it finds no new errors, and there are existing errors from the earlier parts of the chain, it will return an empty string. This breaks the chain. To continue the chain, these functions should always call either the success function or the error function and return the data set.

Here is a transcript of a session exhibiting the problem. I believe that the output from the first chain is correct, and that that from the second and third is incorrect. Indeed, all three chains should give the same output.

> library(assertr)
> library(magrittr)
> test.df = data.frame(x=c(1,0,2))
> test.df %>% chain_start %>% verify(x>0) %>% chain_end
There is 1 error:

- verification [x > 0] failed! (1 failure)

Error: assertr stopped execution
> test.df %>% chain_start %>% verify(x>0) %>% assert_rows(col_concat, is_uniq, x) %>% chain_end
[1] ""
> test.df %>% chain_start %>% verify(x>0) %>% assert_rows(col_concat, is_uniq, x) %>% assert_rows(col_concat, is_uniq, x) %>% chain_end
Error in UseMethod("select_") : 
  no applicable method for 'select_' applied to an object of class "character"
> 

Patch file below.

First commit adds tests (which fail), second fixes bug (making tests pass). Consider squashing or rewriting them.

From 844789702f93338fabdaad222a4997bd56853cfc Mon Sep 17 00:00:00 2001
From: Peter Wicks Stringfield <peterwicksstringfield@gmail.com>
Date: Tue, 21 Mar 2017 16:20:38 -0500
Subject: [PATCH 1/2] add tests for chaining error

---
 tests/testthat/test-assertions.R | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)

diff --git a/tests/testthat/test-assertions.R b/tests/testthat/test-assertions.R
index beb085a..84b791f 100644
--- a/tests/testthat/test-assertions.R
+++ b/tests/testthat/test-assertions.R
@@ -24,6 +24,7 @@ mnexmpl.data[12,1] <- NA
 nanmnexmpl.data <- mnexmpl.data
 nanmnexmpl.data[10,1] <- 0/0
 
+test.df <- data.frame(x = c(0,1,2))
 
 # custom error (or success) messages
 yell <- function(message){
@@ -560,3 +561,38 @@ test_that("insist_rows breaks appropriately (using se)", {
 ###########################################
 
 
+########## 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)
+}
+
+test_that("assert_rows works with chaining", {
+  code_to_test <- function () {
+    test.df %>%
+      chain_start %>%
+      # This gives one error.
+      assert(within_bounds(1, Inf), x) %>%
+      # This gives no errors.
+      assert_rows(col_concat, is_uniq, x) %>%
+      assert_rows(col_concat, is_uniq, x) %>%
+      chain_end(error_fun = error_no_output)
+  }
+  expect_error(code_to_test(),
+               "assertr stopped execution")
+})
+
+test_that("insist_rows works with chaining", {
+  code_to_test <- function () {
+    test.df %>%
+      chain_start %>%
+      assert(within_bounds(1, Inf), x) %>%
+      insist_rows(col_concat, function (a_vector) {function (xx) TRUE}, x) %>%
+      insist_rows(col_concat, function (a_vector) {function (xx) TRUE}, x) %>%
+      chain_end(error_fun = error_no_output)
+  }
+  expect_error(code_to_test(),
+               "assertr stopped execution")
+})
-- 
1.9.1


From ff69f4ff6fa4537b97f811403290e4b739f4c1fa Mon Sep 17 00:00:00 2001
From: Peter Wicks Stringfield <peterwicksstringfield@gmail.com>
Date: Tue, 21 Mar 2017 16:20:52 -0500
Subject: [PATCH 2/2] fix chaining error

---
 R/assertions.R | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/R/assertions.R b/R/assertions.R
index cbb2173..b43cb48 100644
--- a/R/assertions.R
+++ b/R/assertions.R
@@ -253,7 +253,10 @@ assert_rows_ <- function(data, row_reduction_fn, predicate, ..., .dots,
 
   num.violations <- sum(!log.vec)
   if(num.violations==0)
-    return("")
+    # There are errors, just no new ones, so calling success
+    # is inappropriate, so we must call the error function.
+    # NOT calling either function would break the pipeline.
+    return(error_fun(list(), data=data))
   loc.violations <- which(!log.vec)
 
   error <- make.assertr.assert_rows.error(name.of.row.redux.fn,
@@ -517,7 +520,10 @@ insist_rows_ <- function(data, row_reduction_fn, predicate_generator, ...,
 
   num.violations <- sum(!log.vec)
   if(num.violations==0)
-    return("")
+    # There are errors, just no new ones, so calling success
+    # is inappropriate, so we must call the error function.
+    # NOT calling either function would break the pipeline.
+    return(error_fun(list(), data=data))
   loc.violations <- which(!log.vec)
 
   error <- make.assertr.assert_rows.error(name.of.row.redux.fn,
-- 
1.9.1

After patch:

> library(assertr)
> library(magrittr)
> test.df = data.frame(x=c(1,0,2))
> test.df %>% chain_start %>% verify(x>0) %>% chain_end
There is 1 error:

- verification [x > 0] failed! (1 failure)

Error: assertr stopped execution
> test.df %>% chain_start %>% verify(x>0) %>% assert_rows(col_concat, is_uniq, x) %>% chain_end
There is 1 error:

- verification [x > 0] failed! (1 failure)

Error: assertr stopped execution
> test.df %>% chain_start %>% verify(x>0) %>% assert_rows(col_concat, is_uniq, x) %>% assert_rows(col_concat, is_uniq, x) %>% chain_end
There is 1 error:

- verification [x > 0] failed! (1 failure)

Error: assertr stopped execution
> 

[tonyfischetti]

Thank you so much for the catch!!! Would you like to submit this as a pull request? That way I can merge it and you can be listed as a contributor officially! :)
If not, I can just make the changes with your patches

[tonyfischetti]

That was a huge mistake. Thanks for catching it and thanks again for the pull request!

[peterwicksstringfield]

Not a problem, thanks for the snazzy R package :).

[tonyfischetti]

Turns out verify was acting incorrectly as well. I found that out by adding a whole mess of tests!
It's fixed now and I'm resubmitting to CRAN