Refactor expect_grepl_error() (#1005)

tests/testthat/_snaps/after-wrappers.md

@@ -168,6 +168,39 @@
       [55] "with_columns"            "with_columns_seq"       
       [57] "with_context"            "with_row_index"         
 
+---
+
+    Code
+      ls(.pr[[private_key]])
+    Output
+       [1] "clone_in_rust"           "collect"                
+       [3] "collect_in_background"   "debug_plan"             
+       [5] "describe_optimized_plan" "describe_plan"          
+       [7] "drop"                    "drop_nulls"             
+       [9] "explode"                 "fetch"                  
+      [11] "fill_nan"                "fill_null"              
+      [13] "filter"                  "first"                  
+      [15] "get_optimization_toggle" "group_by"               
+      [17] "group_by_dynamic"        "join"                   
+      [19] "join_asof"               "last"                   
+      [21] "max"                     "mean"                   
+      [23] "median"                  "melt"                   
+      [25] "min"                     "print"                  
+      [27] "profile"                 "quantile"               
+      [29] "rename"                  "reverse"                
+      [31] "rolling"                 "schema"                 
+      [33] "select"                  "select_seq"             
+      [35] "set_optimization_toggle" "shift"                  
+      [37] "shift_and_fill"          "sink_csv"               
+      [39] "sink_ipc"                "sink_json"              
+      [41] "sink_parquet"            "slice"                  
+      [43] "sort_by_exprs"           "std"                    
+      [45] "sum"                     "tail"                   
+      [47] "to_dot"                  "unique"                 
+      [49] "unnest"                  "var"                    
+      [51] "with_columns"            "with_columns_seq"       
+      [53] "with_context"            "with_row_index"         
+
 # public and private methods of each class Expr
 
     Code

tests/testthat/helper.R

@@ -23,31 +23,24 @@ expect_different = function(x, y) {
 #' expect_grepl_error(stop("orange and carrot"), "carrot")
 #' expect_grepl_error(stop("orange and carrot"), c("carrot", "orange"))
 expect_grepl_error = function(expr, expected_err = NULL, do_not_repeat_call = TRUE, ...) {
-  # turn of including call in err msg
-  if (do_not_repeat_call) {
-    withr::local_options(polars.do_not_repeat_call = TRUE)
-  }
+  withr::local_options(polars.do_not_repeat_call = do_not_repeat_call)
 
-  # capture err msg
-  err = NULL
+  expr_fails = FALSE
   err = tryCatch(expr, error = function(e) {
-    as.character(e)
+    expr_fails <<- TRUE
+    conditionMessage(e)
   })
 
-  # restore previous options state
-  if (do_not_repeat_call) {
-    withr::local_options(polars.do_not_repeat_call = FALSE)
-  }
+  match_patterns = vapply(
+    expected_err,
+    \(x) grepl(x, err, ignore.case = TRUE),
+    FUN.VALUE = logical(1)
+  ) |> all()
 
-  # check if error message contains pattern
-  founds = sapply(expected_err, \(x) isTRUE(grepl(x, err, ignore.case = TRUE)[1]))
-
-  if (!all(founds)) {
-    # ... if not use testthat to point out the difference
-    expect_identical(expected_err[which(!founds)[1]], err, ...)
-  }
-
-  invisible(err)
+  expect(
+    expr_fails & match_patterns,
+    failure_message = paste(deparse(substitute(expr)), "does not throw the expected error")
+  )
 }
 
 make_print_cases = function() {

tests/testthat/test-after-wrappers.R

@@ -37,5 +37,5 @@ patrick::with_parameters_test_that("public and private methods of each class",
 test_that("check the polars object is valid", {
   raw = as_polars_df(mtcars) |>
     serialize(connection = NULL)
-  expect_error(print(unserialize(raw)), "restart the R session")
+  expect_grepl_error(print(unserialize(raw)), "restart the R session")
 })

tests/testthat/test-as_polars.R

@@ -32,7 +32,7 @@ if (requireNamespace("arrow", quietly = TRUE) && requireNamespace("nanoarrow", q
 
       if (inherits(x, "nanoarrow_array_stream")) {
         # The stream should be released after conversion
-        expect_error(x$get_next(), "already been released")
+        expect_grepl_error(x$get_next(), "already been released")
       }
 
       actual = as.data.frame(pl_df)
@@ -81,19 +81,19 @@ patrick::with_parameters_test_that("rownames option of as_polars_df",
 
 
 test_that("as_polars_df throws error when rownames is not a single string or already used", {
-  expect_error(as_polars_df(mtcars, rownames = "cyl"), "already used")
-  expect_error(as_polars_df(mtcars, rownames = c("cyl", "disp")), "must be a single string")
-  expect_error(as_polars_df(mtcars, rownames = 1), "must be a single string")
-  expect_error(as_polars_df(mtcars, rownames = NA_character_), "must be a single string")
-  expect_error(
+  expect_grepl_error(as_polars_df(mtcars, rownames = "cyl"), "already used")
+  expect_grepl_error(as_polars_df(mtcars, rownames = c("cyl", "disp")), "must be a single string")
+  expect_grepl_error(as_polars_df(mtcars, rownames = 1), "must be a single string")
+  expect_grepl_error(as_polars_df(mtcars, rownames = NA_character_), "must be a single string")
+  expect_grepl_error(
     as_polars_df(data.frame(a = 1, a = 2, check.names = FALSE), rownames = "a_1"),
     "already used"
   )
 })
 
 
 test_that("as_polars_df throws error when make_names_unique = FALSE and there are duplicated column names", {
-  expect_error(
+  expect_grepl_error(
     as_polars_df(data.frame(a = 1, a = 2, check.names = FALSE), make_names_unique = FALSE),
     "not allowed"
   )
@@ -119,7 +119,7 @@ test_that("schema option and schema_overrides for as_polars_df.data.frame", {
     data.frame(a = as.character(1:3), b = 4:6)
   )
 
-  expect_error(as_polars_df(mtcars, schema = "cyl"), "schema length does not match")
+  expect_grepl_error(as_polars_df(mtcars, schema = "cyl"), "schema length does not match")
 })
 
 
@@ -153,7 +153,7 @@ if (requireNamespace("arrow", quietly = TRUE) && requireNamespace("nanoarrow", q
 
       if (inherits(x, "nanoarrow_array_stream")) {
         # The stream should be released after conversion
-        expect_error(x$get_next(), "already been released")
+        expect_grepl_error(x$get_next(), "already been released")
 
         # Re-create the stream for the next test
         x = nanoarrow::as_nanoarrow_array_stream(data.frame(x = 1))
@@ -239,7 +239,7 @@ test_that("from arrow Table and ChunkedArray", {
     lapply(at$columns, \(x) length(as_polars_series.ChunkedArray(x, rechunk = FALSE)$chunk_lengths())),
     lapply(at$columns, \(x) x$num_chunks)
   )
-  expect_error(expect_identical(
+  expect_grepl_error(expect_identical(
     lapply(at$columns, \(x) length(as_polars_series.ChunkedArray(x, rechunk = TRUE)$chunk_lengths())),
     lapply(at$columns, \(x) x$num_chunks)
   ))
@@ -252,7 +252,7 @@ test_that("from arrow Table and ChunkedArray", {
     lapply(at$columns, \(x) x$num_chunks)
   )
 
-  expect_error(expect_identical(
+  expect_grepl_error(expect_identical(
     as_polars_df.ArrowTabular(at, rechunk = TRUE)$
       select(pl$all()$map_batches(\(s) s$chunk_lengths()))$
       to_list() |>
@@ -290,7 +290,7 @@ test_that("from arrow Table and ChunkedArray", {
   )
   iris_str = iris
   iris_str$Species = as.character(iris_str$Species)
-  expect_error(expect_equal(df$to_list(), as.list(iris_str)))
+  expect_grepl_error(expect_equal(df$to_list(), as.list(iris_str)))
   expect_equal(df$to_list(), as.list(iris_str), tolerance = 0.0001)
 
   # change column name via char schema
@@ -350,7 +350,7 @@ patrick::with_parameters_test_that("as_polars_df for nanoarrow_array_stream",
 
     pl_df = as_polars_df(x)
     expect_s3_class(pl_df, "RPolarsDataFrame")
-    expect_error(x$get_next(), "already been released")
+    expect_grepl_error(x$get_next(), "already been released")
 
     expect_identical(dim(pl_df), c(2L, 2L))
   },
@@ -363,7 +363,7 @@ patrick::with_parameters_test_that("as_polars_series for nanoarrow_array_stream"
 
     pl_series = as_polars_series(x)
     expect_s3_class(pl_series, "RPolarsSeries")
-    expect_error(x$get_next(), "already been released")
+    expect_grepl_error(x$get_next(), "already been released")
 
     expect_identical(length(pl_series), 2L)
   },

tests/testthat/test-completion.R

@@ -7,7 +7,7 @@ test_that("code completion: method names are found", {
 })
 
 test_that("code completion: check mode name", {
-  expect_error(
+  expect_grepl_error(
     polars_code_completion_activate(mode = "foobar"),
     "should be one of"
   )

tests/testthat/test-concat.R

@@ -45,7 +45,7 @@ test_that("concat dataframe", {
   )
 
   # type 'relaxed' vertical concatenation is not allowed by default
-  expect_error(pl$concat(l_ver[[1L]], pl$DataFrame(a = 2, b = 42L), how = "vertical"), "data types don't match")
+  expect_grepl_error(pl$concat(l_ver[[1L]], pl$DataFrame(a = 2, b = 42L), how = "vertical"), "data types don't match")
 
   # check lazy eager is identical
   l_ver_lazy = lapply(l_ver, \(df) df$lazy())

tests/testthat/test-context.R

@@ -18,8 +18,8 @@ patrick::with_parameters_test_that("lazy functions in context",
     x = df$select(pl[[pola]]("mpg", "hp"))$to_data_frame()
     y = data.frame(lapply(mtcars[, c("mpg", "hp")], base))
     expect_equal(x, y, ignore_attr = TRUE)
-    expect_error(df$select(pl[[pola]]()))
-    expect_error(df$select(pl[[pola]]("mpg", pl$col("hp"))))
+    expect_grepl_error(df$select(pl[[pola]]()))
+    expect_grepl_error(df$select(pl[[pola]]("mpg", pl$col("hp"))))
   },
   .cases = make_cases()
 )

tests/testthat/test-csv-read.R

@@ -83,7 +83,7 @@ test_that("arg raise_if_empty works", {
   tmpf = tempfile()
   writeLines("", tmpf)
 
-  expect_error(
+  expect_grepl_error(
     pl$read_csv(tmpf),
     "no data: empty CSV"
   )
@@ -136,7 +136,7 @@ test_that("arg encoding works", {
   tmpf = tempfile()
   write.csv(dat, tmpf, row.names = FALSE)
 
-  expect_error(
+  expect_grepl_error(
     pl$read_csv(tmpf, encoding = "foo"),
     "encoding choice"
   )
@@ -164,7 +164,7 @@ test_that("multiple files errors if different schema", {
   write.csv(dat1, tmpf1, row.names = FALSE)
   write.csv(dat2, tmpf2, row.names = FALSE)
 
-  expect_error(
+  expect_grepl_error(
     pl$read_csv(c(tmpf1, tmpf2)),
     "lengths don't match"
   )
@@ -176,7 +176,7 @@ test_that("bad paths", {
     c(ctx$BadArgument, ctx$PlainErrorMessage),
     c("path", "path cannot have zero length")
   )
-  expect_error(
+  expect_grepl_error(
     pl$read_csv("not a valid path"),
     "failed to locate file"
   )

tests/testthat/test-csv-write.R

@@ -14,7 +14,7 @@ test_that("write_csv: path works", {
 })
 
 test_that("write_csv: null_values works", {
-  expect_error(
+  expect_grepl_error(
     dat_pl$write_csv(temp_out, null_values = NULL)
   )
   dat_pl$write_csv(temp_out, null_values = "hello")

tests/testthat/test-dataframe.R

@@ -107,7 +107,7 @@ test_that("get set properties", {
   expect_different(df2$columns, df$columns)
 
   # cannot set property without setter method
-  expect_error(df$height <- 10)
+  expect_grepl_error(df$height <- 10)
 
   # other getable properties
   expect_equal(df$height, 5L)
@@ -159,14 +159,14 @@ test_that("DataFrame, custom schema", {
     pl$DataFrame(list(schema = 1), schema = list(schema = pl$Float32))
   )
   # incorrect datatype
-  expect_error(pl$DataFrame(x = 1, schema = list(schema = foo)))
-  expect_error(
+  expect_grepl_error(pl$DataFrame(x = 1, schema = list(schema = foo)))
+  expect_grepl_error(
     pl$DataFrame(x = 1, schema = list(x = "foo")),
     "expected RPolarsDataType"
   )
 
   # wrong variable name in schema
-  expect_error(
+  expect_grepl_error(
     pl$DataFrame(x = 1, schema = list(schema = pl$Float32)),
     "Some columns in `schema` are not in the DataFrame"
   )
@@ -418,7 +418,7 @@ test_that("get column", {
     )
   )
 
-  expect_error(
+  expect_grepl_error(
     pl$DataFrame(iris)$get_column("wrong_name")
   )
 })
@@ -547,13 +547,13 @@ test_that("head lazy/eager", {
 
   # lazy bounds
   expect_identical(df$head(0)$to_data_frame(), rdf[integer(), ])
-  expect_error(ldf$head(-1))
-  expect_error(ldf$head(2^32))
+  expect_grepl_error(ldf$head(-1))
+  expect_grepl_error(ldf$head(2^32))
   expect_identical(ldf$head(2^32 - 1)$collect()$to_data_frame(), rdf)
 
   # eager bounds
   expect_identical(ldf$head(0)$collect()$to_data_frame(), rdf[integer(), ])
-  expect_error(df$head(2^32))
+  expect_grepl_error(df$head(2^32))
   expect_identical(df$head(2^32 - 1)$to_data_frame(), rdf)
 })
 
@@ -735,7 +735,7 @@ test_that("drop_nulls", {
   expect_equal(tmp$drop_nulls("hp")$height, 32, ignore_attr = TRUE)
   expect_equal(tmp$drop_nulls(c("mpg", "hp"))$height, 29, ignore_attr = TRUE)
 
-  expect_error(
+  expect_grepl_error(
     pl$DataFrame(mtcars)$drop_nulls("bad column name")$height,
     "not found: unable to find column \"bad column name\""
   )
@@ -840,11 +840,11 @@ test_that("sort", {
   expect_true(is.na(b$mpg[1]))
 
   # error if descending is NULL
-  expect_error(
+  expect_grepl_error(
     df$sort("mpg", descending = NULL),
     "must be of length 1 or of the same length as `by`"
   )
-  expect_error(
+  expect_grepl_error(
     df$sort(c("mpg", "drat"), descending = NULL),
     "must be of length 1 or of the same length as `by`"
   )
@@ -1090,7 +1090,7 @@ test_that("describe", {
   expect_snapshot(df$describe())
   expect_snapshot(pl$DataFrame(mtcars)$describe())
   expect_snapshot(pl$DataFrame(mtcars)$describe(interpolation = "linear"))
-  expect_error(pl$DataFrame(mtcars)$describe("not a percentile"))
+  expect_grepl_error(pl$DataFrame(mtcars)$describe("not a percentile"))
 
   # min/max different depending on categorical ordering
   expect_snapshot(df$select(pl$col("cat")$cast(pl$Categorical("lexical")))$describe())
@@ -1199,8 +1199,8 @@ test_that("sample", {
   expect_identical(df$sample(frac = 0.1)$height, 15)
 
   # must pass either n or fraction and not both
-  expect_error(df$sample(), "Pass either arg")
-  expect_error(df$sample(n = 2, fraction = 0.1), "not both")
+  expect_grepl_error(df$sample(), "Pass either arg")
+  expect_grepl_error(df$sample(n = 2, fraction = 0.1), "not both")
 
   # single check of some conversion errors
   ctx = df$sample(frac = 0.1, seed = "not even a written number") |> get_err_ctx()
@@ -1409,8 +1409,8 @@ test_that("partition_by", {
   )
 
   # Test errors
-  expect_error(df$partition_by("foo"), "not found: foo")
-  expect_error(df$partition_by(pl$Int8), "There is no column to partition by")
+  expect_grepl_error(df$partition_by("foo"), "not found: foo")
+  expect_grepl_error(df$partition_by(pl$Int8), "There is no column to partition by")
 
   # Test `as_nested_list = TRUE`
   expect_true(