Use withr in tests of data_write()

easystats · Oct 8, 2023 · be7957b · be7957b
1 parent 6c3bcf5
commit be7957b
Showing 1 changed file with 95 additions and 98 deletions.
diff --git a/tests/testthat/test-data_write.R b/tests/testthat/test-data_write.R
@@ -17,117 +17,114 @@ d$e42dep <- droplevels(d$e42dep)
 
 # SPSS -------------------------------------
 
-tmp <- tempfile(fileext = ".sav")
-on.exit(unlink(tmp))
-
 test_that("data_write, SPSS", {
-  expect_message(data_write(d, tmp))
-  d2 <- data_read(tmp, verbose = FALSE)
-
-  expect_equal(
-    to_factor(d, select = c("e16sex", "c172code")),
-    d2,
-    ignore_attr = TRUE
-  )
+  skip_if_not_installed("withr")
+  withr::with_tempfile("tmp", fileext = ".sav", code = {
+    expect_message(data_write(d, tmp))
+    d2 <- data_read(tmp, verbose = FALSE)
+    expect_equal(
+      to_factor(d, select = c("e16sex", "c172code")),
+      d2,
+      ignore_attr = TRUE
+    )
+  })
 })
 
 
-tmp <- tempfile(fileext = ".sav")
-on.exit(unlink(tmp))
-
 test_that("data_write, SPSS, mixed types of labelled vectors", {
-  d <- data.frame(
-    a = 1:3,
-    b = letters[1:3],
-    c = factor(letters[1:3]),
-    d = as.Date(c("2022-01-01", "2022-02-01", "2022-03-01")),
-    e = c(TRUE, FALSE, FALSE),
-    stringsAsFactors = FALSE
-  )
-
-  # Date and Logical cannot be labelled
-  d$a <- assign_labels(d$a, variable = "First", values = c("one", "two", "three"))
-  d$b <- assign_labels(d$b, variable = "Second", values = c("A", "B", "C"))
-  d$c <- assign_labels(d$c, variable = "Third", values = c("ey", "bee", "see"))
-
-  # expect message, but no error
   skip_if_not_installed("withr")
-  withr::with_tempdir(code = {
-    expect_message(data_write(d, "test.sav"), regex = "Preparing")
+  withr::with_tempfile("tmp", fileext = ".sav", code = {
+    d <- data.frame(
+      a = 1:3,
+      b = letters[1:3],
+      c = factor(letters[1:3]),
+      d = as.Date(c("2022-01-01", "2022-02-01", "2022-03-01")),
+      e = c(TRUE, FALSE, FALSE),
+      stringsAsFactors = FALSE
+    )
+
+    # Date and Logical cannot be labelled
+    d$a <- assign_labels(d$a, variable = "First", values = c("one", "two", "three"))
+    d$b <- assign_labels(d$b, variable = "Second", values = c("A", "B", "C"))
+    d$c <- assign_labels(d$c, variable = "Third", values = c("ey", "bee", "see"))
+
+    expect_message(data_write(d, tmp), regex = "Preparing")
   })
 })
 
 
 
 # Stata -------------------------------------
 
-tmp <- tempfile(fileext = ".dta")
-on.exit(unlink(tmp))
-
 test_that("data_write, Stata", {
-  data_write(d, tmp, verbose = FALSE)
-  d2 <- data_read(tmp, verbose = FALSE)
-
-  expect_equal(
-    to_factor(d, select = c("e16sex", "c172code")),
-    d2,
-    ignore_attr = TRUE
-  )
+  skip_if_not_installed("withr")
+  withr::with_tempfile("tmp", fileext = ".dta", code = {
+    data_write(d, tmp, verbose = FALSE)
+    d2 <- data_read(tmp, verbose = FALSE)
+
+    expect_equal(
+      to_factor(d, select = c("e16sex", "c172code")),
+      d2,
+      ignore_attr = TRUE
+    )
+  })
 })
 
 
 
 # csv -------------------------
 
-tmp <- tempfile(fileext = ".csv")
-on.exit(unlink(tmp))
-
 test_that("data_write, CSV, keep numeric", {
-  data_write(d, tmp)
-  d2 <- data_read(tmp)
-
-  expect_equal(
-    to_numeric(d, dummy_factors = FALSE, preserve_levels = TRUE),
-    d2,
-    ignore_attr = TRUE
-  )
+  skip_if_not_installed("withr")
+  withr::with_tempfile("tmp", fileext = ".csv", code = {
+    data_write(d, tmp)
+    d2 <- data_read(tmp)
+
+    expect_equal(
+      to_numeric(d, dummy_factors = FALSE, preserve_levels = TRUE),
+      d2,
+      ignore_attr = TRUE
+    )
+  })
 })
 
 test_that("data_write, CSV, convert to factor", {
-  data_write(d, tmp, convert_factors = TRUE)
-  d2 <- data_read(tmp)
-  out <- to_factor(d, select = c("e16sex", "c172code"))
-  out$e16sex <- as.character(out$e16sex)
-  out$c172code <- as.character(out$c172code)
-  out$e42dep <- as.numeric(as.character(out$e42dep))
-
-  expect_equal(out, d2, ignore_attr = TRUE)
+  skip_if_not_installed("withr")
+  withr::with_tempfile("tmp", fileext = ".csv", code = {
+    data_write(d, tmp, convert_factors = TRUE)
+    d2 <- data_read(tmp)
+    out <- to_factor(d, select = c("e16sex", "c172code"))
+    out$e16sex <- as.character(out$e16sex)
+    out$c172code <- as.character(out$c172code)
+    out$e42dep <- as.numeric(as.character(out$e42dep))
+    expect_equal(out, d2, ignore_attr = TRUE)
+  })
 })
 
-# main file
-tmp <- tempfile(fileext = ".csv")
-on.exit(unlink(tmp))
-
-# file for labels
-fpath <- dirname(tmp)
-fname <- sub("\\.csv$", "", basename(tmp))
-tmp2 <- paste0(fpath, .Platform$file.sep, fname, "_labels.csv")
-on.exit(unlink(tmp2))
-
 test_that("data_write, CSV, create labels file", {
-  data(efc)
-  expect_message(data_write(efc, tmp, save_labels = TRUE))
-  d <- data_read(tmp2)
-
-  expect_identical(d$variable[2], "e16sex")
-  expect_identical(d$label[2], "elder's gender")
-  expect_identical(d$labels[2], "1=male; 2=female")
-
-  expect_message(data_write(efc, tmp, save_labels = TRUE, delimiter = ";"))
-  d <- data_read(tmp2)
-  expect_identical(d$variable[2], "e16sex")
-  expect_identical(d$label[2], "elder's gender")
-  expect_identical(d$labels[2], "1=male; 2=female")
+  skip_if_not_installed("withr")
+  withr::with_tempfile("tmp", fileext = ".csv", code = {
+
+    # file for labels
+    fpath <- dirname(tmp)
+    fname <- sub("\\.csv$", "", basename(tmp))
+    tmp2 <- paste0(fpath, .Platform$file.sep, fname, "_labels.csv")
+    on.exit(unlink(tmp2))
+
+    data(efc)
+    expect_message(data_write(efc, tmp, save_labels = TRUE))
+    d <- data_read(tmp2)
+
+    expect_identical(d$variable[2], "e16sex")
+    expect_identical(d$label[2], "elder's gender")
+    expect_identical(d$labels[2], "1=male; 2=female")
+
+    expect_message(data_write(efc, tmp, save_labels = TRUE, delimiter = ";"))
+    d <- data_read(tmp2)
+    expect_identical(d$variable[2], "e16sex")
+    expect_identical(d$label[2], "elder's gender")
+    expect_identical(d$labels[2], "1=male; 2=female")
+  })
 })
 
 
@@ -141,19 +138,19 @@ test_that("data_write, no file extension", {
 
 # writing character vector works for missing value labels ------------------
 
-tmp <- tempfile(fileext = ".sav")
-on.exit(unlink(tmp))
-
 test_that("data_write, existing variable label but missing value labels", {
-  d <- data.frame(
-    a = letters[1:3],
-    stringsAsFactors = FALSE
-  )
-  d$a <- assign_labels(d$a, variable = "First")
-  # expect message, but no error
-  expect_message(data_write(d, tmp), regex = "Preparing")
-
-  # check if data is really the same
-  d2 <- data_read(tmp)
-  expect_identical(d2, d)
+  skip_if_not_installed("withr")
+  withr::with_tempfile("tmp", fileext = ".sav", code = {
+    d <- data.frame(
+      a = letters[1:3],
+      stringsAsFactors = FALSE
+    )
+    d$a <- assign_labels(d$a, variable = "First")
+    # expect message, but no error
+    expect_message(data_write(d, tmp), regex = "Preparing")
+
+    # check if data is really the same
+    d2 <- data_read(tmp, verbose = FALSE)
+    expect_identical(d2, d)
+  })
 })