Supply classes of custom error conditions in tests (richfitz#113)

Supply classes of custom error conditions in tests
wlandau · Jul 19, 2019 · 0c64f1e · 0c64f1e
2 parents 5c54752 + c604485
commit 0c64f1e
Show file tree

Hide file tree

Showing 4 changed files with 26 additions and 11 deletions.
diff --git a/inst/spec/test-external.R b/inst/spec/test-external.R
@@ -58,5 +58,6 @@ testthat::test_that("simple", {
   testthat::expect_false(st$exists("z", ns))
   testthat::expect_error(suppressWarnings(st$get("z", ns)),
                          "key 'z' ('objects') not found, with error:",
-                         fixed = TRUE)
+                         fixed = TRUE,
+                         class = "KeyErrorExternal")
 })
diff --git a/inst/spec/test-storr.R b/inst/spec/test-storr.R
@@ -35,7 +35,8 @@ testthat::test_that("basic", {
 
   testthat::expect_error(st$get(key),
                          sprintf("key '%s' ('objects') not found", key),
-                         fixed = TRUE)
+                         fixed = TRUE,
+                         class = "KeyError")
 
   d <- runif(100)
   hash <- st$hash_object(d)
@@ -219,7 +220,8 @@ testthat::test_that("hash_algorithm", {
 
     h_other <- setdiff(hash_algos, h)[[1L]]
     testthat::expect_error(.driver_create(dr, hash_algorithm = h_other),
-                           "Incompatible value for hash_algorithm")
+                           "Incompatible value for hash_algorithm",
+                           class = "ConfigError")
 
     testthat::expect_equal(.driver_create(dr)$hash_algorithm, h)
 
@@ -241,7 +243,8 @@ testthat::test_that("get_value", {
   testthat::expect_equal(st$get_value(h), x)
 
   testthat::expect_error(st$get_value("nosuchhash"),
-                         "hash 'nosuchhash' not found")
+                         "hash 'nosuchhash' not found",
+                         class = "HashError")
 })
 
 

diff --git a/tests/testthat/test-defunct.R b/tests/testthat/test-defunct.R
@@ -1,6 +1,12 @@
 context("defunct")
 
 test_that("defunct functions", {
-  expect_error(driver_redis_api(), "redux::driver_redis_api", fixed = TRUE)
-  expect_error(storr_redis_api(), "redux::storr_redis_api", fixed = TRUE)
+  expect_error(driver_redis_api(),
+               "redux::driver_redis_api",
+               fixed = TRUE,
+               class = "defunctError")
+  expect_error(storr_redis_api(),
+               "redux::storr_redis_api",
+               fixed = TRUE,
+               class = "defunctError")
 })
diff --git a/tests/testthat/test-driver-rds.R b/tests/testthat/test-driver-rds.R
@@ -51,7 +51,8 @@ test_that("mangledless compatibility", {
 
   ## Pointing another driver here without mangling is an error:
   expect_error(driver_rds(path, mangle_key = FALSE),
-               "Incompatible value for mangle_key")
+               "Incompatible value for mangle_key",
+               class = "ConfigError")
 
   ## But omitting the argument (NULL mangledness) is OK
   dr2 <- driver_rds(path)
@@ -67,7 +68,8 @@ test_that("mangledless compatibility", {
 
   ## Pointing another driver here without mangling is an error:
   expect_error(driver_rds(path2, mangle_key = TRUE),
-               "Incompatible value for mangle_key")
+               "Incompatible value for mangle_key",
+               class = "ConfigError")
 
   ## But omitting the argument (NULL mangledness) is OK
   dr4 <- driver_rds(path2)
@@ -84,7 +86,8 @@ test_that("mangledness padding compatibility", {
 
   ## Pointing another driver here without mangling is an error:
   expect_error(driver_rds(path, mangle_key_pad = TRUE),
-               "Incompatible value for mangle_key_pad")
+               "Incompatible value for mangle_key_pad",
+               class = "ConfigError")
 
   ## But omitting the argument (NULL mangledness) is OK
   dr2 <- driver_rds(path)
@@ -100,7 +103,8 @@ test_that("mangledness padding compatibility", {
 
   ## Pointing another driver here without mangling is an error:
   expect_error(driver_rds(path2, mangle_key = TRUE, mangle_key_pad = FALSE),
-               "Incompatible value for mangle_key")
+               "Incompatible value for mangle_key",
+               class = "ConfigError")
 
   ## But omitting the argument (NULL mangledness) is OK
   dr4 <- driver_rds(path2)
@@ -173,7 +177,8 @@ test_that("backward compatibility", {
 
   path <- copy_to_tmp("v1.0.1_clear")
   expect_error(storr_rds(path, hash_algorithm = "sha1"),
-               "Incompatible value for hash_algorithm")
+               "Incompatible value for hash_algorithm",
+               class = "ConfigError")
 })
 
 test_that("mangledness padding backward compatibility", {