expect_warning -> expect_snapshot when regex arg present

also transitioned on output of `translate`

Author: simonpcouch

tests/testthat/test_boost_tree_C50.R

@@ -143,13 +143,11 @@ test_that('argument checks for data dimensions', {
     set_engine("C5.0") %>%
     set_mode("classification")
 
-  expect_warning(
-    f_fit  <- spec %>% fit(species ~ ., data = penguins),
-    "1000 samples were requested"
+  expect_snapshot(
+    f_fit  <- spec %>% fit(species ~ ., data = penguins)
   )
-  expect_warning(
-    xy_fit <- spec %>% fit_xy(x = penguins[, -1], y = penguins$species),
-    "1000 samples were requested"
+  expect_snapshot(
+    xy_fit <- spec %>% fit_xy(x = penguins[, -1], y = penguins$species)
   )
 
   expect_equal(f_fit$fit$control$minCases,  nrow(penguins))

tests/testthat/test_boost_tree_xgboost.R

@@ -285,12 +285,11 @@ test_that('early stopping', {
     regex = NA
   )
 
-  expect_warning(
+  expect_snapshot(
     reg_fit <-
       boost_tree(trees = 20, stop_iter = 30, mode = "regression") %>%
       set_engine("xgboost", validation = .1) %>%
-      fit(mpg ~ ., data = mtcars[-(1:4), ]),
-    regex = "`early_stop` was reduced to 19"
+      fit(mpg ~ ., data = mtcars[-(1:4), ])
   )
   expect_error(
     reg_fit <-
@@ -347,8 +346,7 @@ test_that('xgboost data conversion', {
   expect_equal(xgboost::getinfo(from_df$data, name = "label")[1:5],  rep(1, 5))
 
   mtcars_y <- factor(mtcars$mpg < 15, levels = c(TRUE, FALSE, "na"), labels = c("low", "high", "missing"))
-  expect_warning(from_df <- parsnip:::as_xgb_data(mtcar_x, mtcars_y, event_level = "second"),
-                 regexp = "`event_level` can only be set for binary variables.")
+  expect_snapshot(from_df <- parsnip:::as_xgb_data(mtcar_x, mtcars_y, event_level = "second"))
 
 })
 
@@ -395,13 +393,11 @@ test_that('argument checks for data dimensions', {
   penguins_dummy <- model.matrix(species ~ ., data = penguins)
   penguins_dummy <- as.data.frame(penguins_dummy[, -1])
 
-  expect_warning(
-    f_fit  <- spec %>% fit(species ~ ., data = penguins),
-    "1000 samples were requested"
+  expect_snapshot(
+    f_fit  <- spec %>% fit(species ~ ., data = penguins)
   )
-  expect_warning(
-    xy_fit <- spec %>% fit_xy(x = penguins_dummy, y = penguins$species),
-    "1000 samples were requested"
+  expect_snapshot(
+    xy_fit <- spec %>% fit_xy(x = penguins_dummy, y = penguins$species)
   )
   expect_equal(f_fit$fit$params$colsample_bynode, 1)
   expect_equal(f_fit$fit$params$min_child_weight, nrow(penguins))

tests/testthat/test_decision_tree.R

@@ -56,13 +56,11 @@ test_that('argument checks for data dimensions', {
     set_engine("rpart") %>%
     set_mode("regression")
 
-  expect_warning(
-    f_fit  <- spec %>% fit(body_mass_g ~ ., data = penguins),
-    "1000 samples were requested but there were 333 rows in the data. 333 will be used."
+  expect_snapshot(
+    f_fit  <- spec %>% fit(body_mass_g ~ ., data = penguins)
   )
-  expect_warning(
-    xy_fit <- spec %>% fit_xy(x = penguins[, -6], y = penguins$body_mass_g),
-    "1000 samples were requested but there were 333 rows in the data. 333 will be used."
+  expect_snapshot(
+    xy_fit <- spec %>% fit_xy(x = penguins[, -6], y = penguins$body_mass_g)
   )
 
   expect_equal(f_fit$fit$control$minsplit,  nrow(penguins))

tests/testthat/test_failed_models.R

@@ -25,13 +25,13 @@ test_that('numeric model', {
     set_engine("lm") %>%
     fit(compounds ~ ., data = hpc_bad, control = ctrl)
 
-  expect_warning(num_res <- predict(lm_mod, hpc_bad[1:11, -1]))
+  expect_snapshot(num_res <- predict(lm_mod, hpc_bad[1:11, -1]))
   expect_equal(num_res, NULL)
 
-  expect_warning(ci_res <- predict(lm_mod, hpc_bad[1:11, -1], type = "conf_int"))
+  expect_snapshot(ci_res <- predict(lm_mod, hpc_bad[1:11, -1], type = "conf_int"))
   expect_equal(ci_res, NULL)
 
-  expect_warning(pi_res <- predict(lm_mod, hpc_bad[1:11, -1], type = "pred_int"))
+  expect_snapshot(pi_res <- predict(lm_mod, hpc_bad[1:11, -1], type = "pred_int"))
   expect_equal(pi_res, NULL)
 
 })
@@ -44,22 +44,16 @@ test_that('classification model', {
     set_engine("glm") %>%
     fit(Class ~ log(funded_amnt) + int_rate + big_num, data = lending_club, control = ctrl)
 
-  expect_warning(
-    cls_res <-
-      predict(log_reg, lending_club %>%  dplyr::slice(1:7) %>% dplyr::select(-Class))
+  expect_snapshot(
+    predict(log_reg, lending_club %>%  dplyr::slice(1:7) %>% dplyr::select(-Class))
   )
-  expect_equal(cls_res, NULL)
 
-  expect_warning(
-    prb_res <-
-      predict(log_reg, lending_club %>%  dplyr::slice(1:7) %>% dplyr::select(-Class), type = "prob")
+  expect_snapshot(
+    predict(log_reg, lending_club %>%  dplyr::slice(1:7) %>% dplyr::select(-Class), type = "prob")
   )
-  expect_equal(prb_res, NULL)
 
-  expect_warning(
-    ci_res <-
-      predict(log_reg, lending_club %>%  dplyr::slice(1:7) %>% dplyr::select(-Class), type = "conf_int")
+  expect_snapshot(
+    predict(log_reg, lending_club %>%  dplyr::slice(1:7) %>% dplyr::select(-Class), type = "conf_int")
   )
-  expect_equal(ci_res, NULL)
 })
 

tests/testthat/test_mlp.R

@@ -40,7 +40,7 @@ test_that('updating', {
 test_that('bad input', {
   expect_error(mlp(mode = "time series"))
   expect_error(translate(mlp(mode = "classification") %>% set_engine("wat?")))
-  expect_warning(translate(mlp(mode = "regression") %>% set_engine("nnet", formula = y ~ x)))
+  expect_snapshot(translate(mlp(mode = "regression") %>% set_engine("nnet", formula = y ~ x)))
   expect_error(translate(mlp(mode = "classification", x = x, y = y) %>% set_engine("keras")))
   expect_error(translate(mlp(mode = "regression", formula = y ~ x) %>% set_engine()))
 })

tests/testthat/test_multinom_reg.R

@@ -42,5 +42,5 @@ test_that('bad input', {
   expect_error(multinom_reg(mode = "regression"))
   expect_error(translate(multinom_reg(penalty = 0.1) %>% set_engine("wat?")))
   expect_error(multinom_reg(penalty = 0.1) %>% set_engine())
-  expect_warning(translate(multinom_reg(penalty = 0.1) %>% set_engine("glmnet", x = hpc[,1:3], y = hpc$class)))
+  expect_snapshot(translate(multinom_reg(penalty = 0.1) %>% set_engine("glmnet", x = hpc[,1:3], y = hpc$class)))
 })

tests/testthat/test_nearest_neighbor_kknn.R

@@ -199,14 +199,12 @@ test_that('argument checks for data dimensions', {
     set_engine("kknn") %>%
     set_mode("regression")
 
-  expect_warning(
-    f_fit  <- spec %>% fit(body_mass_g ~ ., data = penguins),
-    "1000 samples were requested but there were 333 rows in the data. 328 will be used."
+  expect_snapshot(
+    f_fit  <- spec %>% fit(body_mass_g ~ ., data = penguins)
   )
 
-  expect_warning(
-    xy_fit <- spec %>% fit_xy(x = penguins[, -6], y = penguins$body_mass_g),
-    "1000 samples were requested but there were 333 rows in the data. 328 will be used."
+  expect_snapshot(
+    xy_fit <- spec %>% fit_xy(x = penguins[, -6], y = penguins$body_mass_g)
   )
 
   expect_equal(f_fit$fit$best.parameters$k,  nrow(penguins) - 5)

tests/testthat/test_nullmodel.R

@@ -4,7 +4,7 @@ test_that('bad input', {
   expect_error(translate(null_model(mode = "regression") %>% set_engine()))
   expect_error(translate(null_model() %>% set_engine("wat?")))
   expect_error(translate(null_model(formula = y ~ x)))
-  expect_warning(
+  expect_snapshot(
     translate(
       null_model(mode = "regression") %>% set_engine("parsnip", x = hpc[,1:3], y = hpc$class)
     )

tests/testthat/test_surv_reg.R

@@ -25,5 +25,5 @@ test_that('bad input', {
 
 test_that("deprecation warning", {
   rlang::local_options(lifecycle_verbosity = "warning")
-  expect_warning(surv_reg())
+  expect_snapshot(surv_reg())
 })