Merge pull request #78 from asardaes/testthat3

Update most tests to 3rd edition of testthat

DESCRIPTION

@@ -44,6 +44,7 @@ LinkingTo:
     RcppThread
 Suggests:
     doParallel,
+    iterators,
     knitr,
     rmarkdown,
     testthat
@@ -60,6 +61,7 @@ LazyData: TRUE
 RoxygenNote: 7.3.1
 Roxygen: list(markdown = TRUE)
 VignetteBuilder: knitr
+Config/testthat/edition: 3
 Collate: 
     'CENTROIDS-dba.R'
     'CENTROIDS-pam.R'

tests/testthat/helper-all.R

@@ -48,3 +48,27 @@ expect_equal_slots <- function(current, target, slots = c("cluster", "centroids"
                      info = paste("slot =", object_slot))
     }
 }
+
+expect_known_rds <- function(object, path, ..., info = NULL, update = TRUE) {
+    file <- if (missing(path)) paste0("rds/", rlang::enexpr(object)) else path
+
+    if (!file.exists(file)) {
+        warning("Creating reference value", call. = FALSE)
+        saveRDS(object, file, version = 2)
+        succeed()
+    }
+    else {
+        ref_val <- readRDS(file)
+        comp <- compare(object, ref_val, ...)
+        if (update && !comp$equal) {
+            saveRDS(object, file, version = version)
+        }
+        expect(comp$equal,
+               sprintf("%s has changed from known value recorded in %s.\n%s",
+                       file,
+                       encodeString(file, quote = "'"),
+                       comp$message),
+               info = info)
+    }
+    invisible(object)
+}

tests/testthat/unit/methods.R → tests/testthat/test-01-unit-01-methods.R

@@ -1,5 +1,3 @@
-context("    Generics for included classes")
-
 # ==================================================================================================
 # setup
 # ==================================================================================================

tests/testthat/unit/misc.R → tests/testthat/test-01-unit-02-misc.R

@@ -1,5 +1,3 @@
-context("    Miscellaneous functions")
-
 # ==================================================================================================
 # setup
 # ==================================================================================================

tests/testthat/unit/distances.R → tests/testthat/test-01-unit-03-distances.R

@@ -1,5 +1,3 @@
-context("    Included distances")
-
 # ==================================================================================================
 # setup
 # ==================================================================================================
@@ -213,7 +211,7 @@ test_that("dtw_lb gives the same result regardless of dtw.func.", {
                                     window.size = 15L, step.pattern = dtw::symmetric1)
     distmat_with_dtw <- dtw_lb(data_reinterpolated[1L:50L], data_reinterpolated[51L:100L],
                                window.size = 15L, step.pattern = dtw::symmetric1, dtw.func = "dtw")
-    expect_equal(distmat_with_dtwbasic, distmat_with_dtw, check.attributes = FALSE)
+    expect_equal(distmat_with_dtwbasic, distmat_with_dtw, ignore_attr = TRUE)
 })
 
 test_that("dtw_lb gives the same result for different nn.margin and corresponding inputs.", {

tests/testthat/unit/centroids.R → tests/testthat/test-01-unit-04-centroids.R

@@ -1,5 +1,3 @@
-context("    Centroids")
-
 # ==================================================================================================
 # setup
 # ==================================================================================================
@@ -192,7 +190,7 @@ test_that("Operations with pam centroid complete successfully.", {
                                 k = k,
                                 cent = x[c(1L,20L)],
                                 cl_old = 0L),
-                 check.attributes = FALSE)
+                 ignore_attr = TRUE)
 
     ## ---------------------------------------------------------- sparse non-symmetric
     pt_ctrl$symmetric <- FALSE
@@ -212,7 +210,7 @@ test_that("Operations with pam centroid complete successfully.", {
                                 k = k,
                                 cent = x_mv[c(1L,20L)],
                                 cl_old = 0L),
-                 check.attributes = FALSE)
+                 ignore_attr = TRUE)
 
     ## ---------------------------------------------------------- refs
     assign("cent_pam", cent_pam, persistent)
@@ -226,7 +224,7 @@ test_that("Operations with pam centroid complete successfully.", {
     expect_identical(attr(pam_cent_no_distmat, "series_id"), 7L)
     pam_cent_with_distmat <- pam_cent(x[6L:10L], distmat = dm)
     expect_identical(attr(pam_cent_with_distmat, "series_id"), 2L)
-    expect_equal(pam_cent_with_distmat, pam_cent_no_distmat, check.attributes = FALSE)
+    expect_equal(pam_cent_with_distmat, pam_cent_no_distmat, ignore_attr = TRUE)
 })
 
 # ==================================================================================================

tests/testthat/unit/cvis.R → tests/testthat/test-01-unit-05-cvis.R

@@ -1,5 +1,3 @@
-context("    CVIs")
-
 # ==================================================================================================
 # setup
 # ==================================================================================================
@@ -22,8 +20,16 @@ test_that("CVI calculations are consistent regardless of quantity or order of CV
                      args = tsclust_args(dist = list(window.size = 18L)),
                      seed = 123)
 
-    expect_warning(base_cvis <- cvi(pc_mv, rep(1L:4L, each = 5L), "valid"))
-    expect_warning(i_cvis <- cvi(pc_mv, type = "internal"))
+    expect_warning(
+        expect_warning(
+            base_cvis <- cvi(pc_mv, rep(1L:4L, each = 5L), "valid")
+        )
+    )
+    expect_warning(
+        expect_warning(
+            i_cvis <- cvi(pc_mv, type = "internal")
+        )
+    )
     e_cvis <- cvi(pc_mv, rep(1L:4L, each = 5L), type = "external")
     expect_identical(base_cvis, c(e_cvis, i_cvis))
 
@@ -43,12 +49,22 @@ test_that("CVI calculations are consistent regardless of quantity or order of CV
 
     # when missing elements
     pc_mv@distmat <- NULL
-    expect_warning(this_cvis <- cvi(pc_mv, type = "internal"))
+    expect_warning(
+        expect_warning(
+            this_cvis <- cvi(pc_mv, type = "internal")
+        )
+    )
     considered_cvis <- names(this_cvis)
     expect_true(all(base_cvis[considered_cvis] == this_cvis))
 
     pc_mv@datalist <- list()
-    expect_warning(this_cvis <- cvi(pc_mv, type = "internal"))
+    expect_warning(
+        expect_warning(
+            expect_warning(
+                this_cvis <- cvi(pc_mv, type = "internal")
+            )
+        )
+    )
     considered_cvis <- names(this_cvis)
     expect_true(all(base_cvis[considered_cvis] == this_cvis))
 
@@ -157,7 +173,11 @@ test_that("CVIs work also for hierarchical and TADPole", {
                   distance = "gak", sigma = 100,
                   window.size = 18L)
 
-    expect_warning(cvis_tadp <- cvi(tadp, labels_subset))
+    expect_warning(
+        expect_warning(
+            cvis_tadp <- cvi(tadp, labels_subset)
+        )
+    )
     cvis_hc <- cvi(hc, labels_subset)
 
     # refs

tests/testthat/unit/configs.R → tests/testthat/test-01-unit-06-configs.R

@@ -1,5 +1,3 @@
-context("    Configs")
-
 # ==================================================================================================
 # setup
 # ==================================================================================================

tests/testthat/integration/proxy.R → tests/testthat/test-02-integration-01-proxy.R

@@ -1,5 +1,3 @@
-context("    Proxy distances")
-
 # ==================================================================================================
 # setup
 # ==================================================================================================
@@ -23,7 +21,7 @@ test_that("Included proxy distances can be called and give expected dimensions."
 
         d2 <- proxy::dist(x, x, method = distance, window.size = 15L, sigma = 100, normalize = TRUE)
         if (distance != "sdtw") {
-            expect_equal(unclass(d2), as.matrix(d), check.attributes = FALSE,
+            expect_equal(unclass(d2), as.matrix(d), ignore_attr = TRUE,
                          info = paste(distance, "double-arg"))
         }
 
@@ -38,9 +36,9 @@ test_that("Included proxy distances can be called and give expected dimensions."
         # dtw_lb will give different results below because of how it works
         if (distance == "dtw_lb") next
 
-        expect_equal(d3, d2[1L, , drop = FALSE], check.attributes = FALSE,
+        expect_equal(d3, d2[1L, , drop = FALSE], ignore_attr = TRUE,
                      info = paste(distance, "one-vs-many-vs-distmat"))
-        expect_equal(d4, d2[ , 1L, drop = FALSE], check.attributes = FALSE,
+        expect_equal(d4, d2[ , 1L, drop = FALSE], ignore_attr = TRUE,
                      info = paste(distance, "many-vs-one-vs-distmat"))
 
         dots <- list()
@@ -59,7 +57,7 @@ test_that("Included proxy distances can be called and give expected dimensions."
             })
         })
         if (distance == "sdtw") diag(manual_distmat) <- 0
-        expect_equal(as.matrix(d), manual_distmat, check.attributes = FALSE,
+        expect_equal(as.matrix(d), manual_distmat, ignore_attr = TRUE,
                      info = paste("manual distmat vs proxy version using", distance))
     }
 })
@@ -90,7 +88,7 @@ test_that("Included proxy distances can be called for pairwise = TRUE and give e
         expect_null(dim(d), paste("distance =", distance))
         expect_identical(length(d), length(x), info = paste(distance, "pairwise single-arg"))
         if (distance != "sdtw")
-            expect_equal(d, rep(0, length(d)), check.attributes = FALSE,
+            expect_equal(d, rep(0, length(d)), ignore_attr = TRUE,
                          info = paste(distance, "pairwise single all zero"))
 
         d2 <- proxy::dist(x, x, method = distance,
@@ -100,7 +98,7 @@ test_that("Included proxy distances can be called for pairwise = TRUE and give e
         expect_null(dim(d2), paste("distance =", distance))
         expect_identical(length(d2), length(x), info = paste(distance, "pairwise double-arg"))
         if (distance != "sdtw")
-            expect_equal(d, rep(0, length(d2)), check.attributes = FALSE,
+            expect_equal(d, rep(0, length(d2)), ignore_attr = TRUE,
                          info = paste(distance, "pairwise double all zero"))
 
         expect_error(proxy::dist(x[1L:3L], x[4L:5L], method = distance,
@@ -120,7 +118,7 @@ test_that("Included proxy similarities can be called and give expected dimension
         expect_identical(dim(d), c(length(x), length(x)), info = paste(distance, "single-arg"))
 
         d2 <- proxy::simil(x, x, method = distance, sigma = 100)
-        expect_equal(d2, d, check.attributes = FALSE,
+        expect_equal(d2, d, ignore_attr = TRUE,
                      info = paste(distance, "double-arg"))
 
         d3 <- proxy::simil(x[1L], x, method = distance, sigma = 100)
@@ -131,9 +129,9 @@ test_that("Included proxy similarities can be called and give expected dimension
         class(d4) <- c("matrix", "array")
         expect_identical(dim(d4), c(length(x), 1L), info = paste(distance, "many-vs-one"))
 
-        expect_equal(d3, d[1L, , drop = FALSE], check.attributes = FALSE,
+        expect_equal(d3, d[1L, , drop = FALSE], ignore_attr = TRUE,
                      info = paste(distance, "one-vs-many-vs-distmat"))
-        expect_equal(d4, d[ , 1L, drop = FALSE], check.attributes = FALSE,
+        expect_equal(d4, d[ , 1L, drop = FALSE], ignore_attr = TRUE,
                      info = paste(distance, "many-vs-one-vs-distmat"))
     }
 })