Convert to testthat 3e

DESCRIPTION

@@ -25,7 +25,7 @@ Imports:
     grDevices,
     stats
 Suggests:
-    testthat,
+    testthat (>= 3.0.0),
     knitr,
     rmarkdown,
     covr
@@ -41,4 +41,5 @@ License: GPL (>= 2)
 VignetteBuilder: knitr
 RoxygenNote: 7.1.1
 Roxygen: list(markdown = TRUE, roclets=c('rd', 'collate', 'namespace'))
+Config/testthat/edition: 3
 Encoding: UTF-8

tests/testthat.R

@@ -1,3 +1,3 @@
 Sys.setenv("R_TESTS" = "")
-if(require(testthat) & require(hts))
+if(require(testthat) && require(hts))
   test_check("hts")

tests/testthat/test-aggts.R

@@ -1,19 +1,17 @@
 # A unit test for aggts() function
-context("Tests on input")
-test_that("tests for a non-gts object", {
+test_that("tests for a non-gts object (input)", {
   set.seed(1234)
   mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10))
 
-  expect_that(aggts(mts), throws_error())
+  expect_error(aggts(mts))
 })
 
-context("Tests on output")
-test_that("tests for a non-gts object", {
+test_that("tests for a non-gts object (output)", {
   set.seed(1234)
   mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10))
   node.list <- list(3, c(2, 3, 1), c(2, 2, 1, 1, 1, 3))
   hts <- hts(mts, nodes = node.list)
   out <- dim(aggts(hts))
 
-  expect_that(out, equals(c(50, 20)))
+  expect_identical(out, c(50L, 20L))
 })

tests/testthat/test-combinef.R

@@ -1,18 +1,13 @@
 # A unit test for combinef() function
-context("Tests on inputs")
-
-test_that("tests for hts at the bottom level", {
+test_that("tests for hts at the bottom level (inputs)", {
   set.seed(1234)
   mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10))
   node.list <- list(3, c(2, 3, 1), c(2, 2, 1, 1, 1, 3))
 
-  expect_that(combinef(mts, nodes = node.list, algorithms = "lu"), 
-              throws_error())
+  expect_error(combinef(mts, nodes = node.list, algorithms = "lu"))
 })
 
-context("Tests on outputs")
-
-test_that("tests for hts", {
+test_that("tests for hts (outputs)", {
   set.seed(1234)
   mts <- ts(matrix(5 + sort(rnorm(50)), nrow = 5, ncol = 10))
   node.list <- list(3, c(2, 3, 1), c(2, 2, 1, 1, 1, 3))
@@ -21,11 +16,11 @@ test_that("tests for hts", {
   out1 <- combinef(allf, nodes = node.list, keep = "bottom", algorithms = "lu")
   out2 <- combinef(allf, nodes = node.list, keep = "gts", algorithms = "lu")
 
-  expect_that(dim(out1), equals(c(5, 10)))
+  expect_identical(dim(out1), c(5L, 10L))
   expect_true(is.hts(out2))
 })
 
-test_that("tests for gts", {
+test_that("tests for gts (outputs)", {
   set.seed(1234)
   mts <- ts(5 + matrix(sort(rnorm(270)), nrow = 10, ncol = 27), 
             start = c(2001, 1), frequency = 12)
@@ -36,6 +31,6 @@ test_that("tests for gts", {
                    algorithms = "lu")
   out2 <- combinef(allts(gts), groups = g, keep = "gts", algorithms = "lu")
 
-  expect_that(dim(out1), equals(c(10, 27)))
-  expect_that(dim(out2$bts), equals(c(10, 27)))
+  expect_identical(dim(out1), c(10L, 27L))
+  expect_identical(dim(out2$bts), c(10L, 27L))
 })

tests/testthat/test-gts.R

@@ -1,14 +1,12 @@
 # A unit test for gts() function
-context("Tests on output")
-
 test_that("tests for labels", {
   set.seed(1234)
   mts <- ts(5 + matrix(sort(rnorm(2700)), nrow = 100, ncol = 27), 
             start = c(2001, 1), frequency = 12)
   g <- matrix(c(rep(1:3, each = 9), rep(c(rep(1, 3), rep(2, 3), rep(3, 3)), 3),
               rep(1:3, 9)), nrow = 3, byrow = TRUE)
   output <- paste0("G", 1:3)
-  expect_that(names(gts(mts, g)$labels), equals(output))
+  expect_named(gts(mts, g)$labels, output)
 })
 
 test_that("tests for specified labels", {
@@ -18,7 +16,7 @@ test_that("tests for specified labels", {
   g <- matrix(c(rep(1:3, each = 9), rep(c(rep(1, 3), rep(2, 3), rep(3, 3)), 3),
               rep(1:3, 9)), nrow = 3, byrow = TRUE)
   rownames(g) <- c("Sex", "Purpose", "Frames")
-  expect_that(names(gts(mts, g)$labels), equals(rownames(g)))
+  expect_named(gts(mts, g)$labels, rownames(g))
 })
 
 test_that("tests for gmatrix", {
@@ -32,7 +30,7 @@ test_that("tests for gmatrix", {
   output <- gts(mts, g)$groups
   dimnames(output) <- NULL
 
-  expect_that(output, equals(gmat))
+  expect_identical(output, gmat)
 })
 
 test_that("tests for matrix with characters", {
@@ -41,11 +39,11 @@ test_that("tests for matrix with characters", {
             start = c(2001, 1), frequency = 12)
   gchar <- matrix(c(rep("Male", 8), rep("Female", 8), rep(LETTERS[3:10], 2)),
                   nrow = 2, byrow = TRUE)
-  g <- matrix(c(rep(1, 8), rep(2, 8), rep(1:8, 2)), nrow = 2, byrow = T)
-  gmat <- rbind(rep(1, 16), g, seq(1, 16))
+  g <- matrix(c(rep(1L, 8L), rep(2L, 8L), rep(1:8, 2)), nrow = 2, byrow = TRUE)
+  gmat <- rbind(rep(1L, 16L), g, 1:16)
   class(gmat) <- "gmatrix"
   output <- gts(mts, gchar)$groups
   dimnames(output) <- NULL
 
-  expect_that(output, equals(gmat))
+  expect_identical(output, gmat)
 })

tests/testthat/test-hts.R

@@ -1,64 +1,72 @@
 # A unit test for hts() function
-context("Tests on inputs")
-
 test_that("tests for y as a mts", {
   set.seed(1234)
   sts <- ts(rnorm(100), start = c(2001, 1), frequency = 12)
   node.list <- list(3, c(2, 3, 1), c(2, 2, 1, 1, 1, 3))
 
-  expect_that(hts(sts, node.list), throws_error())
+  expect_error(hts(sts, node.list))
 })
 
 test_that("tests for node as a list", {
   set.seed(1234)
   mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10))
   node.mat <- matrix(1:10, nrow = 2, ncol = 5)
 
-  expect_that(hts(mts, node.mat), throws_error())
+  expect_error(hts(mts, node.mat))
 })
 
 test_that("tests for node by default", {
   set.seed(1234)
   mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10))
-  nodes <- list("Level 1" = 10)
+  nodes <- list("Level 1" = 10L)
 
-  expect_that(hts(mts)$nodes, equals(nodes))
+  expect_identical(hts(mts)$nodes, nodes)
 })
 
 test_that("tests for the root node not specified", {
   set.seed(1234)
   mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10))
   node.list <- list(c(2, 3, 1), c(2, 2, 1, 1, 1, 3))
 
-  expect_that(hts(mts, node.list), throws_error())
+  expect_error(hts(mts, node.list))
 })
 
 test_that("tests for the terminal nodes wrong", {
   set.seed(1234)
   mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10))
   node.list <- list(1, c(2, 3, 1), c(2, 2, 1, 2, 1, 3))
 
-  expect_that(hts(mts, node.list), throws_error())
+  expect_error(hts(mts, node.list))
 })
 
 test_that("tests for the middle nodes wrong", {
   set.seed(1234)
   mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10))
   node.list <- list(1, c(2, 4, 1), c(2, 2, 1, 1, 1, 3))
 
-  expect_that(hts(mts, node.list), throws_error())
+  expect_error(hts(mts, node.list))
 })
 
-context("tests on output")
-
-test_that("tests for the gmatrix", {
+test_that("tests for the gmatrix (output)", {
   node.list <- list(3, c(2, 3, 1), c(2, 2, 1, 1, 1, 3))
-  g <- matrix(c(rep(1, 10), rep(1, 4), rep(2, 3), rep(3, 3), rep(1, 2), 
-                rep(2, 2), seq(3, 5), rep(6, 3), seq(1, 10)), ncol = 10, 
-                byrow = TRUE)
+  g <- matrix(
+    c(
+      rep(1L, 10L),
+      rep(1L, 4L),
+      rep(2L, 3L),
+      rep(3L, 3L),
+      rep(1L, 2L),
+      rep(2L, 2L),
+      3:5,
+      rep(6L, 3L),
+      1:10
+    ),
+    ncol = 10,
+    byrow = TRUE
+  )
   class(g) <- "gmatrix"
 
   output <- GmatrixH(node.list)
   dimnames(output) <- NULL
-  expect_that(output, equals(g))
+  expect_identical(output, g)
 })

tests/testthat/test-smatrix.R

@@ -6,7 +6,7 @@ test_that("tests for hts", {
   hts <- hts(mts, nodes = node.list)
   s <- 1/rowSums(smatrix(hts))
 
-  expect_that(InvS4h(node.list), equals(s))
+  expect_identical(InvS4h(node.list), s)
 })
 
 test_that("tests for gts", {
@@ -20,5 +20,5 @@ test_that("tests for gts", {
   out <- InvS4g(gts$groups)
   names(out) <- NULL
 
-  expect_that(out, equals(s))
+  expect_identical(out, s)
 })