diff --git a/tests/testthat/test-data_write.R b/tests/testthat/test-data_write.R index 5e9db3ccb..fecdc4767 100644 --- a/tests/testthat/test-data_write.R +++ b/tests/testthat/test-data_write.R @@ -17,43 +17,38 @@ 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") }) }) @@ -61,73 +56,74 @@ test_that("data_write, SPSS, mixed types of labelled vectors", { # 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 +137,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) + }) })