Skip to content

Commit

Permalink
Use withr in tests of data_write() (#464)
Browse files Browse the repository at this point in the history
* Use `withr` in tests of `data_write()`

* styling
  • Loading branch information
etiennebacher committed Oct 8, 2023
1 parent 6c3bcf5 commit b2d3b1b
Showing 1 changed file with 94 additions and 98 deletions.
192 changes: 94 additions & 98 deletions tests/testthat/test-data_write.R
Original file line number Diff line number Diff line change
Expand Up @@ -17,117 +17,113 @@ 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")
})
})


Expand All @@ -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)
})
})

0 comments on commit b2d3b1b

Please sign in to comment.