Merge pull request #224 from pharmaverse/devel

Devel to Main

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.
 #'
@@ -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)

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)
 })

tests/testthat/test-read_out.R

@@ -82,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 = "."
+    out_path = tempdir()
   )
   # Assert that the output file is generated successfully
   expect_true(file.exists(result))
@@ -92,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()
+  result <- read_out(out_path = tempdir())
   # Assert that the output file is generated successfully
   expect_true(file.exists(result))
   unlink(result, recursive = TRUE)
@@ -108,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 = "."
+    out_path = tempdir()
   ))
 })
 
@@ -122,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 = "."
+      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
@@ -138,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 = "."
+    out_path = tempdir()
   ))
 })
 
@@ -151,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 = "."
+      out_path = tempdir()
     ),
     regexp = "All elements patient_cut_data must be named with corresponding domain"
   )
@@ -167,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 = "."
+      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
@@ -183,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 = "."
+    out_path = tempdir()
   ))
 })
 
@@ -196,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 = "."
+      out_path = tempdir()
     ),
     regexp = "All elements in date_cut_data must be named with corresponding domain"
   )
@@ -211,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 = "."
+    out_path = tempdir()
   ))
 })
 
@@ -226,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 = "."
+      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
@@ -243,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 = "."
+    out_path = tempdir()
   ))
 })
 
@@ -256,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 = "."
+      out_path = tempdir()
     ),
     regexp = "All elements in no_cut_list must be named with corresponding domain"
   )