Refactor and update tests for testthat v3

Author: torfason

tests/testthat/test-labelled_light.R

@@ -1,19 +1,23 @@
 
 test_that("threadbare() works",{
+
   # Data
   attach(test_data_labelled_light)
+  withr::defer(detach(test_data_labelled_light))
 
   # Test regular function
   expect_equal(threadbare(zulu_vec), letters)
 
   # Lists should throw errors
   expect_error(threadbare(cars))
+
 })
 
 test_that("labelled_light ll_labelled() works", {
 
   # Data
   attach(test_data_labelled_light)
+  withr::defer(detach(test_data_labelled_light))
 
   # Empty constructor
   expect_silent(ll_labelled(letters))
@@ -37,6 +41,7 @@ test_that("labelled_light ll_assert_*() works", {
 
   # Data
   attach(test_data_labelled_light)
+  withr::defer(detach(test_data_labelled_light))
 
   # Test valid labelled variables
   expect_silent(ll_assert_labelled(fruit_lbl))
@@ -47,13 +52,15 @@ test_that("labelled_light ll_assert_*() works", {
 
   # Test invalid labelled variables
   expect_error(ll_assert_labelled(fruit_fct))
+
 })
 
 
 test_that("labelled_light ll_var_label() get/set works", {
 
   # Data
   attach(test_data_labelled_light)
+  withr::defer(detach(test_data_labelled_light))
 
   # Get label
   expect_null(ll_var_label(fruit_lbl))
@@ -73,6 +80,9 @@ test_that("labelled_light ll_val_labels() get/set works", {
 
   # Data
   attach(test_data_labelled_light)
+  withr::defer(detach(test_data_labelled_light))
+
+  # Set some variables
   letters_lbl <- ll_labelled(letters)
   char_veggie_labels <- c(Carrot = 2, Potato = 3,
     Tomato = 5, Cucumber = 7, Broccoli = 11 )
@@ -100,6 +110,9 @@ test_that("labelled_light ll_to_character() works", {
 
   # Data
   attach(test_data_labelled_light)
+  withr::defer(detach(test_data_labelled_light))
+
+  # Set some variables
   result_fruit_lbl_default <-
     c("Lime", "Peach", "Orange", "Lime", "Apple", "Banana", "Apple",
       "Orange", "Apple", "Apple", "Banana", "Apple", "Peach", "Orange",

tests/testthat/test-utils_ddply_helper.R

@@ -11,10 +11,11 @@ test_that("ddply_helper works correctly", {
   result_mean <- ddply_helper(df, mean)
   result_sqrt <- ddply_helper(df, sqrt)
 
-  expect_is(result_sum, "data.frame")
-  expect_is(result_mean, "data.frame")
-  expect_is(result_sqrt, "data.frame")
-  expect_error(ddply_helper(df, unique)) # Mismatched column lengths
+  result_sum  |> expect_s3_class("data.frame")
+  result_mean |> expect_s3_class("data.frame")
+  result_sqrt |> expect_s3_class("data.frame")
+
+  ddply_helper(df, unique) |>expect_error() # Mismatched column lengths
 
   # Test with a tibble (if tibble package is available)
   if (requireNamespace("tibble", quietly = TRUE)) {
@@ -24,10 +25,11 @@ test_that("ddply_helper works correctly", {
     result_mean_tb <- ddply_helper(tb, mean)
     result_sqrt_tb <- ddply_helper(tb, sqrt)
 
-    expect_is(result_sum_tb, "tbl_df")
-    expect_is(result_mean_tb, "tbl_df")
-    expect_is(result_sqrt_tb, "tbl_df")
-    expect_error(ddply_helper(tb, unique)) # Mismatched column lengths
+    result_sum_tb |> expect_s3_class("tbl_df")
+    result_mean_tb |> expect_s3_class("tbl_df")
+    result_sqrt_tb |> expect_s3_class("tbl_df")
+
+    ddply_helper(tb, unique) |> expect_error() # Mismatched column lengths
 
     expect_equal(tibble::as_tibble(result_sum), result_sum_tb)
     expect_equal(tibble::as_tibble(result_sqrt), result_sqrt_tb)
@@ -38,8 +40,8 @@ test_that("ddply_helper works correctly", {
   result_zero_sum <- ddply_helper(df_zero_row, sum)
   result_zero_sqrt <- ddply_helper(df_zero_row, sqrt)
 
-  expect_is(result_zero_sum, "data.frame")
-  expect_is(result_zero_sqrt, "data.frame")
+  expect_s3_class(result_zero_sum, "data.frame")
+  expect_s3_class(result_zero_sqrt, "data.frame")
   expect_equal(ncol(result_zero_sum), 1)  # columns should be maintained
   expect_equal(ncol(result_zero_sqrt), 1) # columns should be maintained
   expect_equal(nrow(result_zero_sum), 1)  # aggregate fun
@@ -49,7 +51,7 @@ test_that("ddply_helper works correctly", {
   df_zero_col <- data.frame()
   result_zero_col <- ddply_helper(df_zero_col, sum)
 
-  expect_is(result_zero_col, "data.frame")
+  expect_s3_class(result_zero_col, "data.frame")
   expect_equal(ncol(result_zero_col), 0)
   expect_equal(nrow(result_zero_col), 0)
 

tests/testthat/test-zmisc.R renamed to tests/testthat/test-zample.R

@@ -1,7 +1,6 @@
 
 
 #### Test zample() ####
-context("zample")
 test_that("zample works", {
 
     # Expected first ten samples with seed at 1
@@ -42,49 +41,4 @@ test_that("zample works", {
 })
 
 
-#### Test zeq() ####
-context("zeq")
-test_that("zeq works", {
 
-    # Positive intervals should equal seq
-    expect_equal( zeq(1,2),      seq(1,2)    )
-    expect_equal( zeq(1,10),     seq(1,10)   )
-    expect_equal( zeq(5,10),     seq(5,10)   )
-    expect_equal( zeq(20,20),    seq(20,20)  )
-
-    # Identity should have length one
-    expect_equal( zeq(1,1),           1     )
-
-    # End one less than start gives empty sequence
-    expect_equal( zeq(1,0),    numeric(0)  )
-
-    # End lower than start by two or more gives error
-    expect_error( zeq(2,0) )
-})
-
-
-#### Test zingle() ####
-context("zingle")
-test_that("zingle works", {
-
-    # Check that if all equal, return first item
-    expect_equal( zingle(rep(10,10)), 10 )
-    expect_equal( zingle(rep("a",20)), "a" )
-    expect_equal( zingle(as.factor(rep("a",20))), as.factor("a") )
-
-    # Check that if not all equal, an error is thrown
-    expect_error( zingle(1:2) )
-
-    # Check that NAs behave as expected with na.rm
-    expect_equal( zingle(c( 1, 1,NA, 1, 1), na.rm=TRUE),   1 )
-    expect_equal( zingle(c(NA,NA,NA, 1,NA), na.rm=TRUE),   1 )
-    expect_equal( zingle(c(NA,NA,NA,NA,NA), na.rm=TRUE),   NA )
-
-    # Check that without na.rm=TRUE, NAs cause an error
-    expect_error( zingle(c( 1, 1,NA, 1, 1)) )
-    expect_error( zingle(c(NA,NA,NA, 1,NA)) )
-    expect_error( zingle(c(NA,NA,NA,NA,NA)) )
-
-    # Check that the result never has names
-    expect_named( zingle(c(a=1,b=1)), NULL)
-})

tests/testthat/test-zeq.R

@@ -0,0 +1,19 @@
+
+#### Test zeq() ####
+test_that("zeq works", {
+
+  # Positive intervals should equal seq
+  expect_equal( zeq(1,2),      seq(1,2)    )
+  expect_equal( zeq(1,10),     seq(1,10)   )
+  expect_equal( zeq(5,10),     seq(5,10)   )
+  expect_equal( zeq(20,20),    seq(20,20)  )
+
+  # Identity should have length one
+  expect_equal( zeq(1,1),           1     )
+
+  # End one less than start gives empty sequence
+  expect_equal( zeq(1,0),    numeric(0)  )
+
+  # End lower than start by two or more gives error
+  expect_error( zeq(2,0) )
+})

tests/testthat/test-zingle.R

@@ -0,0 +1,25 @@
+
+#### Test zingle() ####
+test_that("zingle works", {
+
+  # Check that if all equal, return first item
+  expect_equal( zingle(rep(10,10)), 10 )
+  expect_equal( zingle(rep("a",20)), "a" )
+  expect_equal( zingle(as.factor(rep("a",20))), as.factor("a") )
+
+  # Check that if not all equal, an error is thrown
+  expect_error( zingle(1:2) )
+
+  # Check that NAs behave as expected with na.rm
+  expect_equal( zingle(c( 1, 1,NA, 1, 1), na.rm=TRUE),   1 )
+  expect_equal( zingle(c(NA,NA,NA, 1,NA), na.rm=TRUE),   1 )
+  expect_equal( zingle(c(NA,NA,NA,NA,NA), na.rm=TRUE),   NA )
+
+  # Check that without na.rm=TRUE, NAs cause an error
+  expect_error( zingle(c( 1, 1,NA, 1, 1)) )
+  expect_error( zingle(c(NA,NA,NA, 1,NA)) )
+  expect_error( zingle(c(NA,NA,NA,NA,NA)) )
+
+  # Check that the result never has names
+  expect_named( zingle(c(a=1,b=1)), NULL)
+})