From d88c3ca74aa648298d79b7f1fa38df3eac76a37d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 11:59:12 +0100 Subject: [PATCH 1/8] convert all instances of tmpfile and tmpdir --- NAMESPACE | 5 ++ R/support-test.R | 6 +-- R/xportr-package.R | 2 + tests/testthat/test-metadata.R | 2 +- tests/testthat/test-type.R | 2 +- tests/testthat/test-write.R | 91 ++++++++-------------------------- 6 files changed, 34 insertions(+), 74 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index d2f10378..2b2cce37 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -68,3 +68,8 @@ importFrom(utils,capture.output) importFrom(utils,packageVersion) importFrom(utils,str) importFrom(utils,tail) +importFrom(withr,defer) +importFrom(withr,local_envvar) +importFrom(withr,local_file) +importFrom(withr,local_message_sink) +importFrom(withr,local_tempfile) diff --git a/R/support-test.R b/R/support-test.R index d223a6d6..3d344ffa 100644 --- a/R/support-test.R +++ b/R/support-test.R @@ -122,10 +122,10 @@ local_cli_theme <- function(.local_envir = parent.frame()) { `.alert-success` = list(before = NULL) ) - withr::local_options(list(cli.user_theme = cli_theme_tests), .local_envir = .local_envir) - withr::local_envvar(list(NO_COLOR = "yes"), .local_envir = .local_envir) + withr::local_options(list(cli.user_theme = cli_theme_tests), .frame = .local_envir) + local_envvar(list(NO_COLOR = "yes"), .local_envir = .local_envir) app <- cli::start_app(output = "message", .auto_close = FALSE) - withr::defer(cli::stop_app(app), envir = .local_envir) + defer(cli::stop_app(app), envir = .local_envir) } #' Test if multiple vars in spec will result in warning message diff --git a/R/xportr-package.R b/R/xportr-package.R index 197ad5be..cb609f37 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -108,6 +108,8 @@ #' @importFrom tm stemDocument #' @importFrom graphics stem #' @importFrom magrittr %>% extract2 +#' @importFrom withr local_file local_tempfile local_message_sink defer +#' local_envvar #' "_PACKAGE" diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index e50a0741..065ff1dd 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -618,7 +618,7 @@ test_that("xportr_*: Domain is kept in between calls", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track # messages - withr::local_message_sink(tempfile()) + local_message_sink(local_tempfile()) adsl <- minimal_table(30) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index aa31baf1..94cc7a1b 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -152,7 +152,7 @@ test_that("xportr_type: Variables retain column attributes, besides class", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track # messages - withr::local_message_sink(tempfile()) + local_message_sink(local_tempfile()) df_type_label <- adsl %>% xportr_metadata(domain = "adsl") %>% diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index d53c7eb0..2016c25e 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -1,20 +1,14 @@ data_to_save <- dplyr::tibble(X = c(1, 2, NA), Y = c("a", "", "c"), Z = c(1, 2, 3)) test_that("xportr_write: exported data can be saved to a file", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - - on.exit(unlink(tmpdir)) + tmp <- local_file("xyz.xpt") xportr_write(data_to_save, path = tmp) expect_equal(read_xpt(tmp), data_to_save) }) test_that("xportr_write: exported data can still be saved to a file with a label", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - - on.exit(unlink(tmpdir)) + tmp <- local_file("xyz.xpt") suppressWarnings( xportr_write(data_to_save, @@ -27,10 +21,7 @@ test_that("xportr_write: exported data can still be saved to a file with a label }) test_that("xportr_write: exported data can be saved to a file with a metadata", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - - on.exit(unlink(tmpdir)) + tmp <- local_file("xyz.xpt") xportr_write( data_to_save, @@ -45,10 +36,7 @@ test_that("xportr_write: exported data can be saved to a file with a metadata", }) test_that("xportr_write: exported data can be saved to a file with a existing metadata", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - - on.exit(unlink(tmpdir)) + tmp <- local_file("xyz.xpt") df <- xportr_df_label( data_to_save, @@ -64,15 +52,10 @@ test_that("xportr_write: exported data can be saved to a file with a existing me }) test_that("xportr_write: expect error when invalid multibyte string is passed in label", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - - on.exit(unlink(tmpdir)) - expect_error( xportr_write( data_to_save, - tmp, + local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", label = "Lorizzle ipsizzle dolizzl\xe7 pizzle" @@ -82,38 +65,27 @@ test_that("xportr_write: expect error when invalid multibyte string is passed in }) test_that("xportr_write: expect error when file name is over 8 characters long", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, paste0(paste(letters[1:9], collapse = ""), ".xpt")) - - on.exit(unlink(tmpdir)) - - expect_error(xportr_write(data_to_save, tmp)) + expect_error( + xportr_write( + data_to_save, + local_file(paste0(paste(letters[1:9], collapse = ""), ".xpt")) + ) + ) }) test_that("xportr_write: expect error when file name contains non-ASCII symbols or special characters", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, ".xpt") - - on.exit(unlink(tmpdir)) - - expect_error(xportr_write(data_to_save, tmp)) + expect_error( + xportr_write(data_to_save, local_file(".xpt"), strict_checks = TRUE) + ) }) test_that("xportr_write: expect warning when file name contains underscore and strict_checks = FALSE", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "test_.xpt") - - on.exit(unlink(tmpdir)) - - expect_warning(xportr_write(data_to_save, tmp, strict_checks = FALSE)) + expect_warning( + xportr_write(data_to_save, local_file("test_.xpt"), strict_checks = FALSE) + ) }) test_that("xportr_write: expect error when label contains non-ASCII symbols or special characters", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - - on.exit(unlink(tmpdir)) - expect_error( xportr_write( data_to_save, @@ -122,7 +94,7 @@ test_that("xportr_write: expect error when label contains non-ASCII symbols or s xportr_write( data_to_save, domain = "data_to_save", - tmp, + path = local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", label = "çtestç" @@ -134,16 +106,11 @@ test_that("xportr_write: expect error when label contains non-ASCII symbols or s }) test_that("xportr_write: expect error when label is over 40 characters", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - - on.exit(unlink(tmpdir)) - expect_error( xportr_write( data_to_save, domain = "data_to_save", - tmp, + path = local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", label = paste(rep("a", 41), collapse = "") @@ -153,15 +120,11 @@ test_that("xportr_write: expect error when label is over 40 characters", { }) test_that("xportr_write: expect error when an xpt validation fails with strict_checks set to TRUE", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") attr(data_to_save$X, "format.sas") <- "foo" - on.exit(unlink(tmpdir)) - expect_error( xportr_write( - data_to_save, tmp, + data_to_save, local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", @@ -173,15 +136,11 @@ test_that("xportr_write: expect error when an xpt validation fails with strict_c }) test_that("xportr_write: expect warning when an xpt validation fails with strict_checks set to FALSE", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") attr(data_to_save$X, "format.sas") <- "foo" - on.exit(unlink(tmpdir)) - expect_warning( xportr_write( - data_to_save, tmp, + data_to_save, local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", @@ -192,19 +151,13 @@ test_that("xportr_write: expect warning when an xpt validation fails with strict ) }) - test_that("xportr_write: Capture errors by haven and report them as such", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") attr(data_to_save$X, "format.sas") <- "E8601LXw.asdf" - on.exit(unlink(tmpdir)) - - expect_error( suppressWarnings( xportr_write( - data_to_save, tmp, + data_to_save, local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", From adecc2724b0f8a42061d96c5dc05ee83ff2d50bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 12:05:54 +0100 Subject: [PATCH 2/8] docs: adds NEWS entry --- NEWS.md | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 73c35fec..e6d3647a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,7 +4,6 @@ * `xportr_write()` now accepts `metadata` argument which can be used to set the dataset label to stay consistent with the other `xportr_*` functions. It is noteworthy that the dataset label set using the `xportr_df_label()` function will be retained during the `xportr_write()`. * Exporting a new dataset `dataset_spec` that contains the Dataset Specification for ADSL. (#179) - * Added a check for character variable lengths up to 200 bytes in `xpt_validate()`(#91, #189). * File name check is moved to strict_checks condition to allow underscores in the file name. Underscores are allowed in xpt but not per FDA requirements. (#126) @@ -13,7 +12,6 @@ * The `domain` argument for xportr functions will no longer be dynamically determined by the name of the data frame passed as the .df argument. This was done to make the use of xportr functions more explicit. (#182) - * The `label` argument from the `xportr_write()` function is deprecated in favor of the `metadata` argument. (#179) * The `metacore` argument, which was renamed to `metadata` in the following six xportr functions: (`xportr_df_label()`, `xportr_format()`, `xportr_label()`, `xportr_length()`, `xportr_order()`, and `xportr_type()`) in version `0.3.0` with a soft deprecation warning, has now been hard deprecated. Please update your code to use the new `metadata` argument in place of `metacore`. @@ -22,6 +20,10 @@ done to make the use of xportr functions more explicit. (#182) * Created development version of the website (#187) * Additional guidance for options added in deep dive vignette (#81) +## Miscellaneous + +* Tests use `{withr}` to create temporary files that are automatically deleted (#219) + # xportr 0.3.1 ## New Features and Bug Fixes From 5ef7db4cdb9756413e94dada2b3da2b99d3abea0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 12:14:55 +0100 Subject: [PATCH 3/8] rever to use double colon from suggests --- NAMESPACE | 5 ----- R/support-test.R | 4 ++-- R/xportr-package.R | 2 -- tests/testthat/test-metadata.R | 2 +- tests/testthat/test-type.R | 2 +- tests/testthat/test-write.R | 26 +++++++++++++------------- 6 files changed, 17 insertions(+), 24 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 2b2cce37..d2f10378 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -68,8 +68,3 @@ importFrom(utils,capture.output) importFrom(utils,packageVersion) importFrom(utils,str) importFrom(utils,tail) -importFrom(withr,defer) -importFrom(withr,local_envvar) -importFrom(withr,local_file) -importFrom(withr,local_message_sink) -importFrom(withr,local_tempfile) diff --git a/R/support-test.R b/R/support-test.R index 3d344ffa..ddd38ee8 100644 --- a/R/support-test.R +++ b/R/support-test.R @@ -123,9 +123,9 @@ local_cli_theme <- function(.local_envir = parent.frame()) { ) withr::local_options(list(cli.user_theme = cli_theme_tests), .frame = .local_envir) - local_envvar(list(NO_COLOR = "yes"), .local_envir = .local_envir) + withr::local_envvar(list(NO_COLOR = "yes"), .local_envir = .local_envir) app <- cli::start_app(output = "message", .auto_close = FALSE) - defer(cli::stop_app(app), envir = .local_envir) + withr::defer(cli::stop_app(app), envir = .local_envir) } #' Test if multiple vars in spec will result in warning message diff --git a/R/xportr-package.R b/R/xportr-package.R index cb609f37..197ad5be 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -108,8 +108,6 @@ #' @importFrom tm stemDocument #' @importFrom graphics stem #' @importFrom magrittr %>% extract2 -#' @importFrom withr local_file local_tempfile local_message_sink defer -#' local_envvar #' "_PACKAGE" diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 065ff1dd..cae37e0a 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -618,7 +618,7 @@ test_that("xportr_*: Domain is kept in between calls", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track # messages - local_message_sink(local_tempfile()) + withr::local_message_sink(withr::local_tempfile()) adsl <- minimal_table(30) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index 94cc7a1b..865b16aa 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -152,7 +152,7 @@ test_that("xportr_type: Variables retain column attributes, besides class", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track # messages - local_message_sink(local_tempfile()) + withr::local_message_sink(withr::local_tempfile()) df_type_label <- adsl %>% xportr_metadata(domain = "adsl") %>% diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 2016c25e..1d6d3b45 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -1,14 +1,14 @@ data_to_save <- dplyr::tibble(X = c(1, 2, NA), Y = c("a", "", "c"), Z = c(1, 2, 3)) test_that("xportr_write: exported data can be saved to a file", { - tmp <- local_file("xyz.xpt") + tmp <- withr::local_file("xyz.xpt") xportr_write(data_to_save, path = tmp) expect_equal(read_xpt(tmp), data_to_save) }) test_that("xportr_write: exported data can still be saved to a file with a label", { - tmp <- local_file("xyz.xpt") + tmp <- withr::local_file("xyz.xpt") suppressWarnings( xportr_write(data_to_save, @@ -21,7 +21,7 @@ test_that("xportr_write: exported data can still be saved to a file with a label }) test_that("xportr_write: exported data can be saved to a file with a metadata", { - tmp <- local_file("xyz.xpt") + tmp <- withr::local_file("xyz.xpt") xportr_write( data_to_save, @@ -36,7 +36,7 @@ test_that("xportr_write: exported data can be saved to a file with a metadata", }) test_that("xportr_write: exported data can be saved to a file with a existing metadata", { - tmp <- local_file("xyz.xpt") + tmp <- withr::local_file("xyz.xpt") df <- xportr_df_label( data_to_save, @@ -55,7 +55,7 @@ test_that("xportr_write: expect error when invalid multibyte string is passed in expect_error( xportr_write( data_to_save, - local_file("xyz.xpt"), + withr::local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", label = "Lorizzle ipsizzle dolizzl\xe7 pizzle" @@ -68,20 +68,20 @@ test_that("xportr_write: expect error when file name is over 8 characters long", expect_error( xportr_write( data_to_save, - local_file(paste0(paste(letters[1:9], collapse = ""), ".xpt")) + withr::local_file(paste0(paste(letters[1:9], collapse = ""), ".xpt")) ) ) }) test_that("xportr_write: expect error when file name contains non-ASCII symbols or special characters", { expect_error( - xportr_write(data_to_save, local_file(".xpt"), strict_checks = TRUE) + xportr_write(data_to_save, withr::local_file(".xpt"), strict_checks = TRUE) ) }) test_that("xportr_write: expect warning when file name contains underscore and strict_checks = FALSE", { expect_warning( - xportr_write(data_to_save, local_file("test_.xpt"), strict_checks = FALSE) + xportr_write(data_to_save, withr::local_file("test_.xpt"), strict_checks = FALSE) ) }) @@ -94,7 +94,7 @@ test_that("xportr_write: expect error when label contains non-ASCII symbols or s xportr_write( data_to_save, domain = "data_to_save", - path = local_file("xyz.xpt"), + path = withr::local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", label = "çtestç" @@ -110,7 +110,7 @@ test_that("xportr_write: expect error when label is over 40 characters", { xportr_write( data_to_save, domain = "data_to_save", - path = local_file("xyz.xpt"), + path = withr::local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", label = paste(rep("a", 41), collapse = "") @@ -124,7 +124,7 @@ test_that("xportr_write: expect error when an xpt validation fails with strict_c expect_error( xportr_write( - data_to_save, local_file("xyz.xpt"), + data_to_save, withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", @@ -140,7 +140,7 @@ test_that("xportr_write: expect warning when an xpt validation fails with strict expect_warning( xportr_write( - data_to_save, local_file("xyz.xpt"), + data_to_save, withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", @@ -157,7 +157,7 @@ test_that("xportr_write: Capture errors by haven and report them as such", { expect_error( suppressWarnings( xportr_write( - data_to_save, local_file("xyz.xpt"), + data_to_save, withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", From 7a523e0666ba30b69b0ce6d89c3a7b4fc5363dfa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 12:36:31 +0100 Subject: [PATCH 4/8] make withr optional following CRAN guidelines --- R/support-test.R | 16 ++++++++++------ tests/testthat/test-depreciation.R | 12 ++++++------ tests/testthat/test-length.R | 12 ++++++------ tests/testthat/test-metadata.R | 4 +++- tests/testthat/test-pkg-load.R | 12 ++++++------ tests/testthat/test-type.R | 4 +++- tests/testthat/test-write.R | 13 +++++++++++++ 7 files changed, 47 insertions(+), 26 deletions(-) diff --git a/R/support-test.R b/R/support-test.R index ddd38ee8..de38f3d0 100644 --- a/R/support-test.R +++ b/R/support-test.R @@ -122,10 +122,14 @@ local_cli_theme <- function(.local_envir = parent.frame()) { `.alert-success` = list(before = NULL) ) - withr::local_options(list(cli.user_theme = cli_theme_tests), .frame = .local_envir) - withr::local_envvar(list(NO_COLOR = "yes"), .local_envir = .local_envir) - app <- cli::start_app(output = "message", .auto_close = FALSE) - withr::defer(cli::stop_app(app), envir = .local_envir) + # Use rlang::local_options instead of withr (Suggest package) + local_options(cli.user_theme = cli_theme_tests, .frame = .local_envir) + app <- cli::start_app(output = "message", .auto_close = FALSE, .envir = .local_envir) + + if (requireNamespace("withr", quietly = TRUE)) { + withr::local_envvar(NO_COLOR = "yes", .frame = .local_envir) + withr::defer(cli::stop_app(app), envir = .local_envir) + } } #' Test if multiple vars in spec will result in warning message @@ -147,7 +151,7 @@ multiple_vars_in_spec_helper <- function(FUN) { dplyr::bind_rows(metadata) %>% dplyr::rename(Dataset = "dataset") - withr::local_options(list(xportr.length_verbose = "message")) + local_options(xportr.length_verbose = "message") # Setup temporary options with active verbose and Remove empty lines in cli theme local_cli_theme() @@ -175,7 +179,7 @@ multiple_vars_in_spec_helper2 <- function(FUN) { dplyr::bind_rows(metadata) %>% dplyr::rename(Dataset = "dataset") - withr::local_options(list(xportr.length_verbose = "message", xportr.domain_name = "Dataset")) + local_options(xportr.length_verbose = "message", xportr.domain_name = "Dataset") # Setup temporary options with active verbose and Remove empty lines in cli theme local_cli_theme() diff --git a/tests/testthat/test-depreciation.R b/tests/testthat/test-depreciation.R index 2679ecc9..d1eb0cd2 100644 --- a/tests/testthat/test-depreciation.R +++ b/tests/testthat/test-depreciation.R @@ -1,5 +1,5 @@ test_that("xportr_df_label: deprecated metacore gives an error", { - withr::local_options(lifecycle_verbosity = "quiet") + local_options(lifecycle_verbosity = "quiet") df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", label = "Label") @@ -7,7 +7,7 @@ test_that("xportr_df_label: deprecated metacore gives an error", { }) test_that("xportr_format: deprecated metacore gives an error", { - withr::local_options(lifecycle_verbosity = "quiet") + local_options(lifecycle_verbosity = "quiet") df <- data.frame(x = 1, y = 2) df_meta <- data.frame( dataset = "df", @@ -19,7 +19,7 @@ test_that("xportr_format: deprecated metacore gives an error", { }) test_that("xportr_label: using the deprecated metacore argument gives an error", { - withr::local_options(lifecycle_verbosity = "quiet") + local_options(lifecycle_verbosity = "quiet") df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", variable = "x", label = "foo") @@ -28,7 +28,7 @@ test_that("xportr_label: using the deprecated metacore argument gives an error", }) test_that("xportr_length: using the deprecated metacore argument gives an error", { - withr::local_options(lifecycle_verbosity = "quiet") + local_options(lifecycle_verbosity = "quiet") df <- data.frame(x = "a", y = "b") df_meta <- data.frame( dataset = "df", @@ -41,7 +41,7 @@ test_that("xportr_length: using the deprecated metacore argument gives an error" }) test_that("xportr_order: using the deprecated metacore argument gives an error", { - withr::local_options(lifecycle_verbosity = "quiet") + local_options(lifecycle_verbosity = "quiet") df <- data.frame(c = 1:5, a = "a", d = 5:1, b = LETTERS[1:5]) df_meta <- data.frame( @@ -54,7 +54,7 @@ test_that("xportr_order: using the deprecated metacore argument gives an error", }) test_that("xportr_type: using the deprecated metacore argument gives an error", { - withr::local_options(lifecycle_verbosity = "quiet") + local_options(lifecycle_verbosity = "quiet") df <- data.frame( Subj = as.character(c(123, 456, 789, "", NA, NA_integer_)), Different = c("a", "b", "c", "", NA, NA_character_), diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index e3adce3f..0def33be 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -10,7 +10,7 @@ test_that("xportr_length: Accepts valid domain names in metadata object", { metadata <- minimal_metadata(dataset = TRUE, length = TRUE, var_names = colnames(adsl)) # Setup temporary options with active verbose - withr::local_options(list(xportr.length_verbose = "message")) + local_options(xportr.length_verbose = "message") # Test minimal call with valid data and without domain adsl %>% @@ -50,7 +50,7 @@ test_that("xportr_length: CDISC data frame is being piped after another xportr f ) # Setup temporary options with active verbose - withr::local_options(list(xportr.length_verbose = "message")) + local_options(xportr.length_verbose = "message") adsl %>% xportr_type(metadata, domain = "adsl", verbose = "message") %>% @@ -69,9 +69,9 @@ test_that("xportr_length: Impute character lengths based on class", { mutate(length = length - 1) # Setup temporary options with `verbose = "none"` - withr::local_options(list(xportr.length_verbose = "none")) + local_options(xportr.length_verbose = "none") # Define controlled `character_types` for this test - withr::local_options(list(xportr.character_types = c("character", "date"))) + local_options(xportr.character_types = c("character", "date")) # Remove empty lines in cli theme local_cli_theme() @@ -104,7 +104,7 @@ test_that("xportr_length: Throws message when variables not present in metadata" metadata <- minimal_metadata(dataset = TRUE, length = TRUE, var_names = c("x")) # Setup temporary options with `verbose = "message"` - withr::local_options(list(xportr.length_verbose = "message")) + local_options(xportr.length_verbose = "message") # Remove empty lines in cli theme local_cli_theme() @@ -170,7 +170,7 @@ test_that("xportr_length: Column length of known/unkown character types is 200/8 expect_equal(impute_length(Sys.Date()), 200) expect_equal(impute_length(Sys.time()), 200) - withr::local_options(list(xportr.character_types = c("character", "date"))) + local_options(xportr.character_types = c("character", "date")) expect_equal(impute_length(Sys.time()), 8) }) diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index cae37e0a..443166d9 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -618,7 +618,9 @@ test_that("xportr_*: Domain is kept in between calls", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track # messages - withr::local_message_sink(withr::local_tempfile()) + if (requireNamespace("withr", quietly = TRUE)) { + withr::local_message_sink(withr::local_tempfile()) + } adsl <- minimal_table(30) diff --git a/tests/testthat/test-pkg-load.R b/tests/testthat/test-pkg-load.R index 82341de1..be913992 100644 --- a/tests/testthat/test-pkg-load.R +++ b/tests/testthat/test-pkg-load.R @@ -1,21 +1,21 @@ test_that(".onLoad: Unset options get initialised on package load with defaults", { skip_if(getOption("testthat_interactive")) - withr::with_options( - list(xportr.df_domain_name = NULL), + with_options( { expect_no_error(.onLoad()) expect_equal(getOption("xportr.df_domain_name"), "dataset") - } + }, + xportr.df_domain_name = NULL ) }) test_that(".onLoad: Initialised options are retained and not overwritten", { skip_if(getOption("testthat_interactive")) - withr::with_options( - list(xportr.df_domain_name = "custom_domain"), + with_options( { expect_no_error(.onLoad()) expect_equal(getOption("xportr.df_domain_name"), "custom_domain") - } + }, + xportr.df_domain_name = "custom_domain" ) }) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index 865b16aa..3bc09e7a 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -152,7 +152,9 @@ test_that("xportr_type: Variables retain column attributes, besides class", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track # messages - withr::local_message_sink(withr::local_tempfile()) + if (requireNamespace("withr", quietly = TRUE)) { + withr::local_message_sink(withr::local_tempfile()) + } df_type_label <- adsl %>% xportr_metadata(domain = "adsl") %>% diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 1d6d3b45..d11aadc3 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -1,6 +1,7 @@ data_to_save <- dplyr::tibble(X = c(1, 2, NA), Y = c("a", "", "c"), Z = c(1, 2, 3)) test_that("xportr_write: exported data can be saved to a file", { + skip_if_not_installed("withr") tmp <- withr::local_file("xyz.xpt") xportr_write(data_to_save, path = tmp) @@ -8,6 +9,7 @@ test_that("xportr_write: exported data can be saved to a file", { }) test_that("xportr_write: exported data can still be saved to a file with a label", { + skip_if_not_installed("withr") tmp <- withr::local_file("xyz.xpt") suppressWarnings( @@ -21,6 +23,7 @@ test_that("xportr_write: exported data can still be saved to a file with a label }) test_that("xportr_write: exported data can be saved to a file with a metadata", { + skip_if_not_installed("withr") tmp <- withr::local_file("xyz.xpt") xportr_write( @@ -36,6 +39,7 @@ test_that("xportr_write: exported data can be saved to a file with a metadata", }) test_that("xportr_write: exported data can be saved to a file with a existing metadata", { + skip_if_not_installed("withr") tmp <- withr::local_file("xyz.xpt") df <- xportr_df_label( @@ -52,6 +56,7 @@ test_that("xportr_write: exported data can be saved to a file with a existing me }) test_that("xportr_write: expect error when invalid multibyte string is passed in label", { + skip_if_not_installed("withr") expect_error( xportr_write( data_to_save, @@ -65,6 +70,7 @@ test_that("xportr_write: expect error when invalid multibyte string is passed in }) test_that("xportr_write: expect error when file name is over 8 characters long", { + skip_if_not_installed("withr") expect_error( xportr_write( data_to_save, @@ -74,18 +80,21 @@ test_that("xportr_write: expect error when file name is over 8 characters long", }) test_that("xportr_write: expect error when file name contains non-ASCII symbols or special characters", { + skip_if_not_installed("withr") expect_error( xportr_write(data_to_save, withr::local_file(".xpt"), strict_checks = TRUE) ) }) test_that("xportr_write: expect warning when file name contains underscore and strict_checks = FALSE", { + skip_if_not_installed("withr") expect_warning( xportr_write(data_to_save, withr::local_file("test_.xpt"), strict_checks = FALSE) ) }) test_that("xportr_write: expect error when label contains non-ASCII symbols or special characters", { + skip_if_not_installed("withr") expect_error( xportr_write( data_to_save, @@ -106,6 +115,7 @@ test_that("xportr_write: expect error when label contains non-ASCII symbols or s }) test_that("xportr_write: expect error when label is over 40 characters", { + skip_if_not_installed("withr") expect_error( xportr_write( data_to_save, @@ -120,6 +130,7 @@ test_that("xportr_write: expect error when label is over 40 characters", { }) test_that("xportr_write: expect error when an xpt validation fails with strict_checks set to TRUE", { + skip_if_not_installed("withr") attr(data_to_save$X, "format.sas") <- "foo" expect_error( @@ -136,6 +147,7 @@ test_that("xportr_write: expect error when an xpt validation fails with strict_c }) test_that("xportr_write: expect warning when an xpt validation fails with strict_checks set to FALSE", { + skip_if_not_installed("withr") attr(data_to_save$X, "format.sas") <- "foo" expect_warning( @@ -152,6 +164,7 @@ test_that("xportr_write: expect warning when an xpt validation fails with strict }) test_that("xportr_write: Capture errors by haven and report them as such", { + skip_if_not_installed("withr") attr(data_to_save$X, "format.sas") <- "E8601LXw.asdf" expect_error( From 1eb4ac53ba9f6780dfbbbb0b9afd4637678af4d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 13:47:00 +0100 Subject: [PATCH 5/8] fix: problem with test coverage and use of minimal_table --- NAMESPACE | 1 + R/support-test.R | 6 ++- R/write.R | 1 + R/xportr-package.R | 2 +- tests/testthat/test-df_label.R | 8 +--- tests/testthat/test-write.R | 73 ++++++++++++++++++---------------- 6 files changed, 47 insertions(+), 44 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index d2f10378..6231bf16 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,7 @@ importFrom(cli,cli_h2) importFrom(cli,cli_text) importFrom(dplyr,across) importFrom(dplyr,arrange) +importFrom(dplyr,as_tibble) importFrom(dplyr,bind_cols) importFrom(dplyr,case_when) importFrom(dplyr,distinct) diff --git a/R/support-test.R b/R/support-test.R index de38f3d0..0fd5cc10 100644 --- a/R/support-test.R +++ b/R/support-test.R @@ -46,9 +46,11 @@ minimal_table <- function(n_rows = 3, cols = c("x", "y")) { size = n_rows, replace = TRUE ), - d = sample(Sys.Date() + c(1, -1, 10, -10), size = n_rows, replace = TRUE) + d = sample(Sys.Date() + c(1, -1, 10, -10), size = n_rows, replace = TRUE), + e = sample(c(1, 2), replace = TRUE, size = n_rows) ) %>% - select(all_of(cols)) + mutate(e = if_else(seq_along(e) %% 2 == 0, NA, e)) %>% + select(all_of(tolower(cols))) } #' Minimal metadata data frame mock for a ADaM dataset diff --git a/R/write.R b/R/write.R index ebe5e200..7b25f097 100644 --- a/R/write.R +++ b/R/write.R @@ -67,6 +67,7 @@ xportr_write <- function(.df, ) metadata <- data.frame(dataset = domain, label = label) } + if (!is.null(metadata)) { .df <- xportr_df_label(.df, metadata = metadata, domain = domain) } diff --git a/R/xportr-package.R b/R/xportr-package.R index 197ad5be..7f79e685 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -95,7 +95,7 @@ #' @import rlang haven #' @importFrom dplyr left_join bind_cols filter select rename rename_with n #' everything arrange group_by summarize mutate ungroup case_when distinct -#' tribble if_else across +#' tribble if_else across as_tibble #' @importFrom glue glue glue_collapse #' @importFrom cli cli_alert_info cli_h2 cli_alert_success cli_div cli_text #' cli_alert_danger diff --git a/tests/testthat/test-df_label.R b/tests/testthat/test-df_label.R index eae3969d..ec1b9a44 100644 --- a/tests/testthat/test-df_label.R +++ b/tests/testthat/test-df_label.R @@ -1,11 +1,5 @@ test_that("xportr_df_label: error when metadata is not set", { - adsl <- data.frame( - USUBJID = c(1001, 1002, 1003), - SITEID = c(001, 002, 003), - AGE = c(63, 35, 27), - SEX = c("M", "F", "M") - ) - + adsl <- minimal_table() expect_error( xportr_df_label(adsl), diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index d11aadc3..b6c784dc 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -1,11 +1,12 @@ -data_to_save <- dplyr::tibble(X = c(1, 2, NA), Y = c("a", "", "c"), Z = c(1, 2, 3)) +data_to_save <- function() minimal_table(cols = c("e", "b", "x")) %>% rename_with(toupper) %>% as_tibble() test_that("xportr_write: exported data can be saved to a file", { skip_if_not_installed("withr") tmp <- withr::local_file("xyz.xpt") + local_data <- data_to_save() - xportr_write(data_to_save, path = tmp) - expect_equal(read_xpt(tmp), data_to_save) + xportr_write(local_data, path = tmp) + expect_equal(read_xpt(tmp), local_data) }) test_that("xportr_write: exported data can still be saved to a file with a label", { @@ -13,7 +14,7 @@ test_that("xportr_write: exported data can still be saved to a file with a label tmp <- withr::local_file("xyz.xpt") suppressWarnings( - xportr_write(data_to_save, + xportr_write(data_to_save(), path = tmp, label = "Lorem ipsum dolor sit amet", domain = "data_to_save" @@ -27,7 +28,7 @@ test_that("xportr_write: exported data can be saved to a file with a metadata", tmp <- withr::local_file("xyz.xpt") xportr_write( - data_to_save, + data_to_save(), path = tmp, domain = "data_to_save", metadata = data.frame( @@ -43,7 +44,7 @@ test_that("xportr_write: exported data can be saved to a file with a existing me tmp <- withr::local_file("xyz.xpt") df <- xportr_df_label( - data_to_save, + data_to_save(), domain = "data_to_save", data.frame( dataset = "data_to_save", @@ -59,7 +60,7 @@ test_that("xportr_write: expect error when invalid multibyte string is passed in skip_if_not_installed("withr") expect_error( xportr_write( - data_to_save, + data_to_save(), withr::local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", @@ -73,23 +74,26 @@ test_that("xportr_write: expect error when file name is over 8 characters long", skip_if_not_installed("withr") expect_error( xportr_write( - data_to_save, + data_to_save(), withr::local_file(paste0(paste(letters[1:9], collapse = ""), ".xpt")) - ) + ), + "`\\.df` file name must be 8 characters or less\\." ) }) test_that("xportr_write: expect error when file name contains non-ASCII symbols or special characters", { skip_if_not_installed("withr") expect_error( - xportr_write(data_to_save, withr::local_file(".xpt"), strict_checks = TRUE) + xportr_write(data_to_save(), withr::local_file(".xpt"), strict_checks = TRUE), + "`\\.df` cannot contain any non-ASCII, symbol or underscore characters\\." ) }) test_that("xportr_write: expect warning when file name contains underscore and strict_checks = FALSE", { skip_if_not_installed("withr") expect_warning( - xportr_write(data_to_save, withr::local_file("test_.xpt"), strict_checks = FALSE) + xportr_write(data_to_save(), withr::local_file("test_.xpt"), strict_checks = FALSE), + "`\\.df` cannot contain any non-ASCII, symbol or underscore characters\\." ) }) @@ -97,20 +101,15 @@ test_that("xportr_write: expect error when label contains non-ASCII symbols or s skip_if_not_installed("withr") expect_error( xportr_write( - data_to_save, - tmp, - expect_error( - xportr_write( - data_to_save, - domain = "data_to_save", - path = withr::local_file("xyz.xpt"), - metadata = data.frame( - dataset = "data_to_save", - label = "çtestç" - ) - ) + data_to_save(), + domain = "data_to_save", + path = withr::local_file("xyz.xpt"), + metadata = data.frame( + dataset = "data_to_save", + label = "çtestç" ) - ) + ), + "`label` cannot contain any non-ASCII, symbol or special characters" ) }) @@ -118,59 +117,65 @@ test_that("xportr_write: expect error when label is over 40 characters", { skip_if_not_installed("withr") expect_error( xportr_write( - data_to_save, + data_to_save(), domain = "data_to_save", path = withr::local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", label = paste(rep("a", 41), collapse = "") ) - ) + ), + "Length of dataset label must be 40 characters or less" ) }) test_that("xportr_write: expect error when an xpt validation fails with strict_checks set to TRUE", { skip_if_not_installed("withr") - attr(data_to_save$X, "format.sas") <- "foo" + local_data <- data_to_save() + attr(local_data$X, "format.sas") <- "foo" expect_error( xportr_write( - data_to_save, withr::local_file("xyz.xpt"), + local_data, withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", label = "label" ), strict_checks = TRUE - ) + ), + "Format 'X' must have a valid format\\." ) }) test_that("xportr_write: expect warning when an xpt validation fails with strict_checks set to FALSE", { skip_if_not_installed("withr") - attr(data_to_save$X, "format.sas") <- "foo" + local_data <- data_to_save() + attr(local_data$X, "format.sas") <- "foo" expect_warning( xportr_write( - data_to_save, withr::local_file("xyz.xpt"), + local_data, withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", label = "label" ), strict_checks = FALSE - ) + ), + "Format 'X' must have a valid format\\." ) }) test_that("xportr_write: Capture errors by haven and report them as such", { skip_if_not_installed("withr") - attr(data_to_save$X, "format.sas") <- "E8601LXw.asdf" + local_data <- data_to_save() + attr(local_data$X, "format.sas") <- "E8601LXw.asdf" expect_error( suppressWarnings( xportr_write( - data_to_save, withr::local_file("xyz.xpt"), + local_data, withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", From 80bddf90397185af41f3a57f6dec6c9f85717fae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 17:39:50 +0100 Subject: [PATCH 6/8] style: one line function divided in more lines --- tests/testthat/test-write.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index b6c784dc..7c263556 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -1,4 +1,8 @@ -data_to_save <- function() minimal_table(cols = c("e", "b", "x")) %>% rename_with(toupper) %>% as_tibble() +data_to_save <- function() { + minimal_table(cols = c("e", "b", "x")) %>% + rename_with(toupper) %>% + as_tibble() +} test_that("xportr_write: exported data can be saved to a file", { skip_if_not_installed("withr") From 1c9f556e2b2ef29a66e3dfc66836b30a65a1aafc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 15 Feb 2024 14:35:27 +0100 Subject: [PATCH 7/8] chore: correct error expectation and indentation --- tests/testthat/test-write.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 7c263556..0517a462 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -81,7 +81,7 @@ test_that("xportr_write: expect error when file name is over 8 characters long", data_to_save(), withr::local_file(paste0(paste(letters[1:9], collapse = ""), ".xpt")) ), - "`\\.df` file name must be 8 characters or less\\." + "\\.df file name must be 8 characters or less\\." ) }) @@ -140,7 +140,8 @@ test_that("xportr_write: expect error when an xpt validation fails with strict_c expect_error( xportr_write( - local_data, withr::local_file("xyz.xpt"), + local_data, + withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", @@ -159,7 +160,8 @@ test_that("xportr_write: expect warning when an xpt validation fails with strict expect_warning( xportr_write( - local_data, withr::local_file("xyz.xpt"), + local_data, + withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", @@ -179,7 +181,8 @@ test_that("xportr_write: Capture errors by haven and report them as such", { expect_error( suppressWarnings( xportr_write( - local_data, withr::local_file("xyz.xpt"), + local_data, + withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", From 3f6c8db0c00425f69a2a2fb5457f3fe930a30b1a Mon Sep 17 00:00:00 2001 From: bms63 Date: Mon, 19 Feb 2024 13:23:10 +0000 Subject: [PATCH 8/8] [skip actions] Bump version to 0.3.1.9019 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index a0b254df..46da9b09 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9018 +Version: 0.3.1.9019 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")),