tests: use more specialised testthat functions (#1228)

* tests: use `expect_no_warning()` and `expect_no_error()`

* tests: use more specialised testthat functions

* tests: use more `expect_identical()`

* tests: more expect_match

DESCRIPTION

@@ -69,7 +69,7 @@ Suggests:
     remotes,
     RhpcBLASctl,
     rpart,
-    testthat (>= 3.1.0)
+    testthat (>= 3.2.0)
 Encoding: UTF-8
 Config/testthat/edition: 3
 Config/testthat/parallel: false

inst/testthat/helper_expectations.R

@@ -517,7 +517,7 @@ expect_measure = function(m) {
   testthat::expect_output(print(m), "Measure")
 
   if ("requires_no_prediction" %in% m$properties) {
-    testthat::expect_true(is.null(m$predict_sets))
+    testthat::expect_null(m$predict_sets)
   }
 
   expect_id(m$id)

tests/testthat/test_DataBackendRbind.R

@@ -19,9 +19,9 @@ test_that("DataBackendRbind", {
 
 
   # all col-hashes are mutually disjoint
-  expect_true(length(intersect(b1$col_hashes, b2$col_hashes)) == 0)
-  expect_true(length(intersect(b$col_hashes, b1$col_hashes)) == 0)
-  expect_true(length(intersect(b$col_hashes, b2$col_hashes)) == 0)
+  expect_length(intersect(b1$col_hashes, b2$col_hashes), 0)
+  expect_length(intersect(b$col_hashes, b1$col_hashes), 0)
+  expect_length(intersect(b$col_hashes, b2$col_hashes), 0)
 
 })
 

tests/testthat/test_Learner.R

@@ -21,8 +21,8 @@ test_that("Learners are called with invoke / small footprint of call", {
   learner$train(task)
   call = as.character(learner$model$call)
   expect_character(call, min.len = 1L, any.missing = FALSE)
-  expect_true(any(grepl("task$formula()", call, fixed = TRUE)))
-  expect_true(any(grepl("task$data", call, fixed = TRUE)))
+  expect_match(call, "task$formula()", fixed = TRUE, all = FALSE)
+  expect_match(call, "task$data", fixed = TRUE, all = FALSE)
   expect_lt(sum(nchar(call)), 1000)
 })
 
@@ -236,7 +236,7 @@ test_that("empty predict set (#421)", {
   learner$train(task, hout$train_set(1))
   pred = learner$predict(task, hout$test_set(1))
   expect_prediction(pred)
-  expect_true(any(grepl("No data to predict on", learner$log$msg)))
+  expect_match(learner$log$msg, "No data to predict on", all = FALSE)
 })
 
 test_that("fallback learner is deep cloned (#511)", {
@@ -330,7 +330,7 @@ test_that("validation task's backend is removed", {
   task = tsk("mtcars")
   task$internal_valid_task = 1:10
   learner$train(task)
-  expect_true(is.null(learner$state$train_task$internal_valid_task$backend))
+  expect_null(learner$state$train_task$internal_valid_task$backend)
 })
 
 test_that("manual $train() stores validation hash and validation ids", {
@@ -348,7 +348,7 @@ test_that("manual $train() stores validation hash and validation ids", {
   # nothing is stored for learners that don't do it
   l2 = lrn("classif.featureless")
   l2$train(task)
-  expect_true(is.null(l2$state$internal_valid_task_hash))
+  expect_null(l2$state$internal_valid_task_hash)
 })
 
 test_that("error when training a learner that sets valiadte to 'predefined' on a task without a validation task", {
@@ -421,15 +421,15 @@ test_that("internal_valid_task is created correctly", {
   task$internal_valid_task = partition(task)$test
   learner$train(task)
   learner$validate = NULL
-  expect_true(is.null(learner$internal_valid_scores))
-  expect_true(is.null(learner$task$internal_valid_task))
+  expect_null(learner$internal_valid_scores)
+  expect_null(learner$task$internal_valid_task)
 
   # validate = NULL (but task has none)
   learner1 = LearnerClassifTest$new()
   task1 = tsk("iris")
   learner1$train(task1)
-  expect_true(is.null(learner1$internal_valid_scores))
-  expect_true(is.null(learner1$task$internal_valid_task))
+  expect_null(learner1$internal_valid_scores)
+  expect_null(learner1$task$internal_valid_task)
 
   # validate = "test"
   LearnerClassifTest2 = R6Class("LearnerClassifTest2", inherit = LearnerClassifDebug,
@@ -455,7 +455,7 @@ test_that("internal_valid_task is created correctly", {
   resampling = rsmp("holdout")$instantiate(task2)
   learner2$expected_valid_ids = resampling$test_set(1)
   learner2$expected_train_ids = resampling$train_set(1)
-  expect_error(resample(task2, learner2, resampling), regexp = NA)
+  expect_no_error(resample(task2, learner2, resampling))
 
   # ratio works
   LearnerClassifTest3 = R6Class("LearnerClassifTest3", inherit = LearnerClassifDebug,
@@ -477,7 +477,7 @@ test_that("internal_valid_task is created correctly", {
   learner4 = lrn("classif.debug", validate = 0.2)
   task = tsk("iris")
   learner4$train(task)
-  expect_true(is.null(task$internal_valid_task))
+  expect_null(task$internal_valid_task)
 })
 
 test_that("compatability check on validation task", {

tests/testthat/test_Measure.R

@@ -167,7 +167,7 @@ test_that("primary iters are respected", {
 
   jaccard = msr("sim.jaccard")
   expect_error(rr1$aggregate(jaccard), "primary_iters")
-  expect_error(rr2$aggregate(jaccard), NA)
+  expect_no_error(rr2$aggregate(jaccard))
   jaccard$properties = c(jaccard$properties, "primary_iters")
   x1 = rr1$aggregate(jaccard)
   x2 = rr3$aggregate(jaccard)
@@ -176,7 +176,7 @@ test_that("primary iters are respected", {
 
 test_that("no predict_sets required (#1094)", {
   m = msr("internal_valid_score")
-  expect_equal(m$predict_sets, NULL)
+  expect_null(m$predict_sets)
   rr = resample(tsk("iris"), lrn("classif.debug", validate = 0.3, predict_sets = NULL), rsmp("holdout"))
   expect_double(rr$aggregate(m))
   expect_warning(rr$aggregate(msr("classif.ce")), "needs predict sets")

tests/testthat/test_Task.R

@@ -633,7 +633,7 @@ test_that("internal_valid_task is printed", {
   task = tsk("iris")
   task$internal_valid_task = c(1:10, 51:60, 101:110)
   out = capture_output(print(task))
-  expect_true(grepl(pattern = "* Validation Task: (30x5)", fixed = TRUE, x = out))
+  expect_match(out, "* Validation Task: (30x5)", fixed = TRUE)
 })
 
 test_that("task hashes during resample", {

tests/testthat/test_as_learner.R

@@ -14,10 +14,10 @@ test_that("as_learner conversion", {
 test_that("discard_state", {
   learner = lrn("classif.rpart")$train(tsk("iris"))
   learner2 = as_learner(learner, clone = TRUE, discard_state = TRUE)
-  expect_true(is.null(learner2$state))
+  expect_null(learner2$state)
   expect_false(is.null(learner$state))
 
   learner3 = lrn("classif.rpart")
   as_learner(learner3, clone = FALSE, discard_state = TRUE)
-  expect_true(is.null(learner3$state))
+  expect_null(learner3$state)
 })

tests/testthat/test_benchmark.R

@@ -367,16 +367,16 @@ test_that("benchmark_grid works if paired = TRUE", {
   # design[, identical(task), by = task]]
   # expect(identical(design$resampling[class(learner)[[1]] ==)]))
   expect_true(nrow(design) == 4L) #
-  expect_true(identical(design$task[[1]], design$task[[2]]))
-  expect_true(identical(design$task[[3]], design$task[[4]]))
+  expect_identical(design$task[[1]], design$task[[2]])
+  expect_identical(design$task[[3]], design$task[[4]])
   expect_false(identical(design$task[[1]], design$task[[3]]))
 
-  expect_true(identical(design$resampling[[1]], design$resampling[[2]]))
-  expect_true(identical(design$resampling[[3]], design$resampling[[4]]))
+  expect_identical(design$resampling[[1]], design$resampling[[2]])
+  expect_identical(design$resampling[[3]], design$resampling[[4]])
   expect_false(identical(design$resampling[[1]], design$resampling[[3]]))
 
-  expect_true(identical(design$learner[[1]], design$learner[[3]]))
-  expect_true(identical(design$learner[[2]], design$learner[[4]]))
+  expect_identical(design$learner[[1]], design$learner[[3]])
+  expect_identical(design$learner[[2]], design$learner[[4]])
   expect_false(identical(design$learner[[2]], design$learner[[3]]))
 
 

tests/testthat/test_encapsulate.R

@@ -24,7 +24,7 @@ test_that("evaluate / single step", {
   expect_data_table(log, nrows = 2L, ncols = 3L, any.missing = FALSE)
   expect_factor(log$class)
   expect_set_equal(as.character(log$class), c("output", "warning"))
-  expect_true(all(grepl("->train()", log$msg, fixed = TRUE)))
+  expect_match(log$msg, "->train()", fixed = TRUE)
   expect_true("output" %in% log$class)
   expect_true("warning" %in% log$class)
   expect_false("error" %in% log$class)
@@ -40,7 +40,7 @@ test_that("evaluate / single step", {
   expect_data_table(log, nrows = 2L, ncols = 3L, any.missing = FALSE)
   expect_factor(log$class)
   expect_equal(as.character(log$class), c("output", "warning"))
-  expect_true(all(grepl("->predict()", log$msg, fixed = TRUE)))
+  expect_match(log$msg, "->predict()",  fixed = TRUE)
 })
 
 test_that("evaluate / resample", {

tests/testthat/test_hashes.R

@@ -8,8 +8,8 @@ expect_hash_changes = function(x) {
     expect_false(identical(x$hash, hash_before))
   }
   x$id = id_before
-  expect_true(identical(x$id, id_before))
-  expect_true(identical(x$hash, hash_before))
+  expect_identical(x$id, id_before)
+  expect_identical(x$hash, hash_before)
 }
 
 test_that("task$hash", {

tests/testthat/test_lgr.R

@@ -23,6 +23,6 @@ test_that("log to text file", {
   lines = readLines(f)
   expect_true(any(startsWith(lines, "INFO")))
   expect_true(any(startsWith(lines, "DEBUG")))
-  expect_true(any(grepl("'iris'", lines, fixed = TRUE)))
-  expect_true(any(grepl("'classif.featureless'", lines, fixed = TRUE)))
+  expect_match(lines, "'iris'", fixed = TRUE, all = FALSE)
+  expect_match(lines, "'classif.featureless'", lines, fixed = TRUE, all = FALSE)
 })

tests/testthat/test_marshal.R

@@ -56,7 +56,7 @@ test_that("marshal count works for LearnerClassifDebug", {
 
   learner2 = lrn("classif.debug", count_marshaling = FALSE)
   learner2$train(task)
-  expect_true(is.null(learner2$model$marshal_count))
+  expect_null(learner2$model$marshal_count)
   model1 = learner2$model
   model2 = learner2$marshal()$unmarshal()$model
   expect_equal(model1, model2)

tests/testthat/test_resample.R

@@ -212,13 +212,13 @@ test_that("marshaling works when store_models is FALSE", {
     resample(task, learner, resampling, store_models = FALSE, unmarshal = TRUE)
   })
   expect_resample_result(rr)
-  expect_true(is.null(rr$learners[[1]]$model))
+  expect_null(rr$learners[[1]]$model)
 
   rr1 = with_future(future::sequential, {
     resample(task, learner, resampling, store_models = FALSE, unmarshal = TRUE)
   })
   expect_resample_result(rr1)
-  expect_true(is.null(rr1$learners[[1]]$model))
+  expect_null(rr1$learners[[1]]$model)
 })
 
 

tests/testthat/test_warn_deprecated.R

@@ -4,10 +4,10 @@ test_that("warn_deprecated works as expected", {
 
   oldopts = options(mlr3.warn_deprecated = TRUE)
   expect_warning(warn_deprecated("test"), "^test is deprecated and will be removed in the future\\.$")
-  expect_warning(warn_deprecated("test"), NA) # no second warning
+  expect_no_warning(warn_deprecated("test")) # no second warning
 
   oldopts = options(mlr3.warn_deprecated = FALSE)
-  expect_warning(warn_deprecated("test2"), NA) # no warning when options disallow it
+  expect_no_warning(warn_deprecated("test2")) # no warning when options disallow it
 
   options(oldopts)
 })
@@ -24,11 +24,11 @@ test_that("deprecated_binding works as expected", {
   mco = MyClass$new()
   expect_warning({fooval = mco$foo}, "^MyClass\\$foo is deprecated and will be removed in the future\\.$")
   expect_equal(fooval, "bar")
-  expect_warning({fooval = mco$foo}, NA) # no second warning
+  expect_no_warning({fooval = mco$foo}) # no second warning
   expect_equal(fooval, "bar")
 
   oldopts = options(mlr3.warn_deprecated = FALSE)
-  expect_warning({foo2val = mco$foo2}, NA) # no warning when options disallow it
+  expect_no_warning({foo2val = mco$foo2}) # no warning when options disallow it
   expect_equal(foo2val, 1)
   mco$val = 2
   expect_equal(mco$foo2, 2)