From 29cc4e43dd71932021f9b9ee64c3c40bae3b5e94 Mon Sep 17 00:00:00 2001 From: Tim Barnett Date: Fri, 22 Nov 2024 12:26:05 +0000 Subject: [PATCH 1/5] Writes test readout files to temporary directory #222 --- tests/testthat/test-process_cut.R | 15 +++++++++------ tests/testthat/test-read_out.R | 29 ++++++++++++++++------------- 2 files changed, 25 insertions(+), 19 deletions(-) diff --git a/tests/testthat/test-process_cut.R b/tests/testthat/test-process_cut.R index 2882a80..e8fe747 100644 --- a/tests/testthat/test-process_cut.R +++ b/tests/testthat/test-process_cut.R @@ -63,6 +63,9 @@ expected <- list( ae = ae_cut, lb = lb_cut, ts = ts_cut ) +# Create temporary directory for testing output file +temp_dir <- tempdir() + # Test that every type of datacut gives the expected result, when special_dm=TRUE ----------- test_that("Test that every type of datacut gives the expected result, when special_dm=TRUE", { @@ -186,10 +189,10 @@ test_that("Test that Correct .Rmd file is ran successfully when read_out = TRUE" cut_var = DCUTDTM, special_dm = TRUE, read_out = TRUE, - out_path = "~/dummyfile" + out_path = paste0(temp_dir,"/dummyfile") ) - expect_true(dir.exists("~/dummyfile") & (length(list.files("~/dummyfile")) > 0)) - unlink("~/dummyfile", recursive = TRUE) + expect_true(dir.exists(temp_dir) & (length(list.files(paste0(temp_dir,"/dummyfile")))) > 0) + unlink(paste0(temp_dir,"/dummyfile"), recursive = TRUE) }) # Test that every type of datacut gives the expected result, when special_dm=FALSE ----------- @@ -230,8 +233,8 @@ test_that("Test that Correct .Rmd file is ran successfully when read_out = TRUE" cut_var = DCUTDTM, special_dm = FALSE, read_out = TRUE, - out_path = "~/dummyfile" + out_path = paste0(temp_dir,"/dummyfile") ) - expect_true(dir.exists("~/dummyfile") & (length(list.files("~/dummyfile")) > 0)) - unlink("~/dummyfile", recursive = TRUE) + expect_true(dir.exists(temp_dir) & (length(list.files(paste0(temp_dir,"/dummyfile"))) > 0)) + unlink(paste0(temp_dir,"/dummyfile"), recursive = TRUE) }) diff --git a/tests/testthat/test-read_out.R b/tests/testthat/test-read_out.R index 668ee3f..02e9e73 100644 --- a/tests/testthat/test-read_out.R +++ b/tests/testthat/test-read_out.R @@ -70,6 +70,9 @@ dm_cut <- tibble::tribble( "AB12345-005", "Y", "2022-12-01", "Y", "2022-12-01", NA, NA ) +# Create temporary directory for testing output file +temp_dir <- tempdir() + # Testing --------------------------------------------------------------------------------------------------------- # Test that .Rmd gives the expected result when all fields are set to default or contain valid data ----------- @@ -82,7 +85,7 @@ test_that("Correct .Rmd file is run successfully when fields contain correct dat date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = "." + out_path = temp_dir ) # Assert that the output file is generated successfully expect_true(file.exists(result)) @@ -92,7 +95,7 @@ test_that("Correct .Rmd file is run successfully when fields contain correct dat # Test that Correct .Rmd file is ran successfully when fields are empty test_that("Correct .Rmd file is ran successfully when fields are empty", { # Call read_out() to generate the .Rmd file - result <- read_out() + result <- read_out(out_path = temp_dir) # Assert that the output file is generated successfully expect_true(file.exists(result)) unlink(result, recursive = TRUE) @@ -108,7 +111,7 @@ test_that("Test that read_out() errors dcut data frame does not contain the var date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = "." + out_path = temp_dir )) }) @@ -122,7 +125,7 @@ test_that("Test that read_out() errors when patient_cut_data input is not a list date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = "." + out_path = temp_dir ), regexp = "patient_cut_data must be a list. \n Note: If you have not used or do not with to view patient cut on any SDTMv domains, then @@ -138,7 +141,7 @@ test_that("Test that read_out() errors when elements in the patient_cut_data lis date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = "." + out_path = temp_dir )) }) @@ -151,7 +154,7 @@ test_that("Test that read_out() errors when data frames in patient_cut_data are date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = "." + out_path = temp_dir ), regexp = "All elements patient_cut_data must be named with corresponding domain" ) @@ -167,7 +170,7 @@ test_that("Test that read_out() errors when date_cut_data input is not a list", date_cut_data = ae, dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = "." + out_path = temp_dir ), regexp = "date_cut_data must be a list. \n Note: If you have not used or do not with to view date cut on any SDTMv domains, then please @@ -183,7 +186,7 @@ test_that("Test that read_out() errors when elements in the date_cut_data list a date_cut_data = list("ae", "lb"), dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = "." + out_path = temp_dir )) }) @@ -196,7 +199,7 @@ test_that("Test that read_out() errors when data frames in date_cut_data are unn date_cut_data = list(ae, lb), dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = "." + out_path = temp_dir ), regexp = "All elements in date_cut_data must be named with corresponding domain" ) @@ -211,7 +214,7 @@ test_that("Test that read_out() errors when dm_cut data frame does not contain t date_cut_data = dt_cut_data, dm_cut = sc, no_cut_list = no_cut_ls, - out_path = "." + out_path = temp_dir )) }) @@ -226,7 +229,7 @@ test_that("Test that read_out() errors when no_cut_list is not a list", { date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = ds, - out_path = "." + out_path = temp_dir ), regexp = "no_cut_list must be a list. \n Note: If you have not used or do not with to view the SDTMv domains where no cut has been @@ -243,7 +246,7 @@ test_that("Test that read_out() errors when elements in the no_cut_list list are date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = ls("ts"), - out_path = "." + out_path = temp_dir )) }) @@ -256,7 +259,7 @@ test_that("Test that read_out() errors when elements in the no_cut_list list are date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = list(ts, ae), - out_path = "." + out_path = temp_dir ), regexp = "All elements in no_cut_list must be named with corresponding domain" ) From 0a33413f87cf8ce2e0b7503f3de090c3a6ea14fd Mon Sep 17 00:00:00 2001 From: Tim Barnett Date: Fri, 22 Nov 2024 13:46:08 +0000 Subject: [PATCH 2/5] styler on test #222 --- tests/testthat/test-process_cut.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-process_cut.R b/tests/testthat/test-process_cut.R index e8fe747..f453f5e 100644 --- a/tests/testthat/test-process_cut.R +++ b/tests/testthat/test-process_cut.R @@ -189,10 +189,10 @@ test_that("Test that Correct .Rmd file is ran successfully when read_out = TRUE" cut_var = DCUTDTM, special_dm = TRUE, read_out = TRUE, - out_path = paste0(temp_dir,"/dummyfile") + out_path = paste0(temp_dir, "/dummyfile") ) - expect_true(dir.exists(temp_dir) & (length(list.files(paste0(temp_dir,"/dummyfile")))) > 0) - unlink(paste0(temp_dir,"/dummyfile"), recursive = TRUE) + expect_true(dir.exists(temp_dir) & (length(list.files(paste0(temp_dir, "/dummyfile")))) > 0) + unlink(paste0(temp_dir, "/dummyfile"), recursive = TRUE) }) # Test that every type of datacut gives the expected result, when special_dm=FALSE ----------- @@ -233,8 +233,8 @@ test_that("Test that Correct .Rmd file is ran successfully when read_out = TRUE" cut_var = DCUTDTM, special_dm = FALSE, read_out = TRUE, - out_path = paste0(temp_dir,"/dummyfile") + out_path = paste0(temp_dir, "/dummyfile") ) - expect_true(dir.exists(temp_dir) & (length(list.files(paste0(temp_dir,"/dummyfile"))) > 0)) - unlink(paste0(temp_dir,"/dummyfile"), recursive = TRUE) + expect_true(dir.exists(temp_dir) & (length(list.files(paste0(temp_dir, "/dummyfile"))) > 0)) + unlink(paste0(temp_dir, "/dummyfile"), recursive = TRUE) }) From 3902e0facd6c5657b54cf072442bdea0a8c351c7 Mon Sep 17 00:00:00 2001 From: Tim Barnett Date: Thu, 28 Nov 2024 08:06:48 +0000 Subject: [PATCH 3/5] Update default path location of readout to tempdir --- R/read_out.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/read_out.R b/R/read_out.R index a20b0ca..997b5d7 100644 --- a/R/read_out.R +++ b/R/read_out.R @@ -76,7 +76,7 @@ read_out <- function(dcut = NULL, date_cut_data = NULL, dm_cut = NULL, no_cut_list = NULL, - out_path = ".") { + out_path = tempdir()) { if (!is.null(dcut)) { assert_data_frame(dcut, required_vars = exprs(USUBJID, DCUTDTC) From b8d54b80143640c591486768f32f739764bc8d1b Mon Sep 17 00:00:00 2001 From: Tim Barnett Date: Thu, 28 Nov 2024 08:15:08 +0000 Subject: [PATCH 4/5] Update roxygen header for read_out.R #222 --- R/read_out.R | 2 +- man/read_out.Rd | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/read_out.R b/R/read_out.R index 997b5d7..abd6cf3 100644 --- a/R/read_out.R +++ b/R/read_out.R @@ -17,7 +17,7 @@ #' @param no_cut_list List of of quoted SDTMv domain names in which no cut should be applied. To be #' left blank if no domains are to remain exactly as source. #' @param out_path A character vector of file save path for the summary file; -#' the default corresponds to the working directory, `getwd()`. +#' the default corresponds to a temporary directory, `tempdir()`. #' #' @return Returns a .html file summarizing the changes made to data during a datacut. #' diff --git a/man/read_out.Rd b/man/read_out.Rd index 8378d18..93b4fad 100644 --- a/man/read_out.Rd +++ b/man/read_out.Rd @@ -10,7 +10,7 @@ read_out( date_cut_data = NULL, dm_cut = NULL, no_cut_list = NULL, - out_path = "." + out_path = tempdir() ) } \arguments{ @@ -32,7 +32,7 @@ the variables DCUT_TEMP_REMOVE and DCUT_TEMP_DTHCHANGE.} left blank if no domains are to remain exactly as source.} \item{out_path}{A character vector of file save path for the summary file; -the default corresponds to the working directory, \code{getwd()}.} +the default corresponds to a temporary directory, \code{tempdir()}.} } \value{ Returns a .html file summarizing the changes made to data during a datacut. From 79e11c887b6d59212813336f90d9de6ae876724d Mon Sep 17 00:00:00 2001 From: Tim Barnett Date: Thu, 28 Nov 2024 08:28:17 +0000 Subject: [PATCH 5/5] Point tests to default tempdir approach #222 --- tests/testthat/test-read_out.R | 29 +++++++++++++---------------- 1 file changed, 13 insertions(+), 16 deletions(-) diff --git a/tests/testthat/test-read_out.R b/tests/testthat/test-read_out.R index 02e9e73..4704f82 100644 --- a/tests/testthat/test-read_out.R +++ b/tests/testthat/test-read_out.R @@ -70,9 +70,6 @@ dm_cut <- tibble::tribble( "AB12345-005", "Y", "2022-12-01", "Y", "2022-12-01", NA, NA ) -# Create temporary directory for testing output file -temp_dir <- tempdir() - # Testing --------------------------------------------------------------------------------------------------------- # Test that .Rmd gives the expected result when all fields are set to default or contain valid data ----------- @@ -85,7 +82,7 @@ test_that("Correct .Rmd file is run successfully when fields contain correct dat date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = temp_dir + out_path = tempdir() ) # Assert that the output file is generated successfully expect_true(file.exists(result)) @@ -95,7 +92,7 @@ test_that("Correct .Rmd file is run successfully when fields contain correct dat # Test that Correct .Rmd file is ran successfully when fields are empty test_that("Correct .Rmd file is ran successfully when fields are empty", { # Call read_out() to generate the .Rmd file - result <- read_out(out_path = temp_dir) + result <- read_out(out_path = tempdir()) # Assert that the output file is generated successfully expect_true(file.exists(result)) unlink(result, recursive = TRUE) @@ -111,7 +108,7 @@ test_that("Test that read_out() errors dcut data frame does not contain the var date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = temp_dir + out_path = tempdir() )) }) @@ -125,7 +122,7 @@ test_that("Test that read_out() errors when patient_cut_data input is not a list date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = temp_dir + out_path = tempdir() ), regexp = "patient_cut_data must be a list. \n Note: If you have not used or do not with to view patient cut on any SDTMv domains, then @@ -141,7 +138,7 @@ test_that("Test that read_out() errors when elements in the patient_cut_data lis date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = temp_dir + out_path = tempdir() )) }) @@ -154,7 +151,7 @@ test_that("Test that read_out() errors when data frames in patient_cut_data are date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = temp_dir + out_path = tempdir() ), regexp = "All elements patient_cut_data must be named with corresponding domain" ) @@ -170,7 +167,7 @@ test_that("Test that read_out() errors when date_cut_data input is not a list", date_cut_data = ae, dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = temp_dir + out_path = tempdir() ), regexp = "date_cut_data must be a list. \n Note: If you have not used or do not with to view date cut on any SDTMv domains, then please @@ -186,7 +183,7 @@ test_that("Test that read_out() errors when elements in the date_cut_data list a date_cut_data = list("ae", "lb"), dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = temp_dir + out_path = tempdir() )) }) @@ -199,7 +196,7 @@ test_that("Test that read_out() errors when data frames in date_cut_data are unn date_cut_data = list(ae, lb), dm_cut = dm_cut, no_cut_list = no_cut_ls, - out_path = temp_dir + out_path = tempdir() ), regexp = "All elements in date_cut_data must be named with corresponding domain" ) @@ -214,7 +211,7 @@ test_that("Test that read_out() errors when dm_cut data frame does not contain t date_cut_data = dt_cut_data, dm_cut = sc, no_cut_list = no_cut_ls, - out_path = temp_dir + out_path = tempdir() )) }) @@ -229,7 +226,7 @@ test_that("Test that read_out() errors when no_cut_list is not a list", { date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = ds, - out_path = temp_dir + out_path = tempdir() ), regexp = "no_cut_list must be a list. \n Note: If you have not used or do not with to view the SDTMv domains where no cut has been @@ -246,7 +243,7 @@ test_that("Test that read_out() errors when elements in the no_cut_list list are date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = ls("ts"), - out_path = temp_dir + out_path = tempdir() )) }) @@ -259,7 +256,7 @@ test_that("Test that read_out() errors when elements in the no_cut_list list are date_cut_data = dt_cut_data, dm_cut = dm_cut, no_cut_list = list(ts, ae), - out_path = temp_dir + out_path = tempdir() ), regexp = "All elements in no_cut_list must be named with corresponding domain" )