Fix #301 [no ci] (#333)

* Fix #301 * Correct test cases * Rename
gesistsa · Sep 3, 2023 · 067a0ae · 067a0ae
1 parent 41ef65e
commit 067a0ae
Show file tree

Hide file tree

Showing 8 changed files with 90 additions and 19 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -7,6 +7,7 @@
      Windows R < 4.2. This won't affect any modern R installation where UTF-8 is the default. #318
    - POTENTIALLY BREAKING: YAML are exported using yaml::write_yaml(). But it can't pass the UTF-8 check on older systems.
      Disclaimer added. #318
+   - More check for the `file` argument #301
 * Declutter
    - remove the obsolete data.table option #323
    - write all documentation blocks in markdown #311

diff --git a/R/export.R b/R/export.R
@@ -77,15 +77,16 @@
 #' @importFrom haven labelled
 #' @export
 export <- function(x, file, format, ...) {
-    if (missing(file) & missing(format)) {
+    .check_file(file, single_only = TRUE)
+    if (missing(file) && missing(format)) {
         stop("Must specify 'file' and/or 'format'")
-    } else if (!missing(file) & !missing(format)) {
+    } else if (!missing(file) && !missing(format)) {
         fmt <- tolower(format)
         cfile <- file
         f <- find_compress(file)
         file <- f$file
         compress <- f$compress
-    } else if (!missing(file) & missing(format)) {
+    } else if (!missing(file) && missing(format)) {
         cfile <- file
         f <- find_compress(file)
         file <- f$file

diff --git a/R/export_list.R b/R/export_list.R
@@ -44,7 +44,8 @@ function(
     x,
     file,
     ...
-) {
+    ) {
+    .check_file(file, single_only = FALSE)
     if (inherits(x, "data.frame")) {
         stop("'x' must be a list. Perhaps you want export()?")
     }

diff --git a/R/import.R b/R/import.R
@@ -93,9 +93,7 @@
 #' @importFrom tibble as_tibble is_tibble
 #' @export
 import <- function(file, format, setclass, which, ...) {
-    if (isFALSE(inherits(file, "character")) || isFALSE(length(file) == 1)) {
-        stop("Invalid `file` argument.", call. = FALSE)
-    }
+    .check_file(file, single_only = TRUE)
     if (grepl("^http.*://", file)) {
         file <- remote_to_local(file, format = format)
     }

diff --git a/R/import_list.R b/R/import_list.R
@@ -34,6 +34,7 @@ function(file,
          rbind_label = "_file",
          rbind_fill = TRUE,
          ...) {
+    .check_file(file, single_only = FALSE)
     if (missing(setclass)) {
         setclass <- NULL
     }

diff --git a/R/utils.R b/R/utils.R
@@ -129,3 +129,17 @@ twrap <- function(value, tag) {
 .write_as_utf8 <- function(text, file, sep = "") {
     writeLines(enc2utf8(text), con = file, sep = sep, useBytes = TRUE)
 }
+
+.check_file <- function(file, single_only = TRUE) {
+    ## check the `file` argument
+    if (isTRUE(missing(file))) { ## for the case of export(iris, format = "csv")
+        return(invisible(NULL))
+    }
+    if (isFALSE(inherits(file, "character"))) {
+        stop("Invalid `file` argument: must be character", call. = FALSE)
+    }
+    if (isFALSE(length(file) == 1) && single_only) {
+        stop("Invalid `file` argument: `file` must be single", call. = FALSE)
+    }
+    invisible(NULL)
+}
diff --git a/tests/testthat/test_check_file.R b/tests/testthat/test_check_file.R
@@ -0,0 +1,67 @@
+test_that(".check_file", {
+    data <- data.frame(
+        x = sample(1:10, 10000, replace = TRUE),
+        y = sample(1:10, 10000, replace = TRUE)
+    )
+    expect_error(.check_file(1))
+    expect_error(.check_file(TRUE))
+    expect_error(.check_file(data))
+    expect_error(.check_file(iris))
+    expect_error(.check_file(c("a.csv", "b.csv")))
+    expect_error(.check_file("a.csv"), NA)
+    expect_error(.check_file(), NA)
+    ## single_only FALSE
+    expect_error(.check_file(1, single_only = FALSE))
+    expect_error(.check_file(TRUE, single_only = FALSE))
+    expect_error(.check_file(data, single_only = FALSE))
+    expect_error(.check_file(iris, single_only = FALSE))
+    expect_error(.check_file(c("a.csv", "b.csv"), single_only = FALSE), NA)
+    expect_error(.check_file("a.csv"), NA)
+    expect_error(.check_file(single_only = FALSE), NA)
+})
+
+test_that("Invalid file argument - import(), #301", {
+    data <- data.frame(
+        x = sample(1:10, 10000, replace = TRUE),
+        y = sample(1:10, 10000, replace = TRUE)
+    )
+    expect_error(import(data), "Invalid")
+    expect_error(import(iris), "Invalid")
+    expect_error(import(1), "Invalid")
+    expect_error(import(TRUE), "Invalid")
+    expect_error(import(c("a.csv", "b.csv")), "Invalid")
+})
+
+test_that("Invalid file argument - import_list(), #301", {
+    data <- data.frame(
+        x = sample(1:10, 10000, replace = TRUE),
+        y = sample(1:10, 10000, replace = TRUE)
+    )
+    expect_error(import_list(data), "Invalid")
+    expect_error(import_list(iris), "Invalid")
+    expect_error(import_list(1), "Invalid")
+    expect_error(import_list(TRUE), "Invalid")
+})
+
+test_that("Invalid file argument - export(), #301", {
+    data <- data.frame(
+        x = sample(1:10, 10000, replace = TRUE),
+        y = sample(1:10, 10000, replace = TRUE)
+    )
+    expect_error(export(iris, data), "Invalid")
+    expect_error(export(iris, iris), "Invalid")
+    expect_error(export(iris, 1), "Invalid")
+    expect_error(export(iris, TRUE), "Invalid")
+    expect_error(export(iris, c("abc.csv", "123.csv")), "Invalid")
+})
+
+test_that("Invalid file argument - export_list(), #301", {
+    data <- data.frame(
+        x = sample(1:10, 10000, replace = TRUE),
+        y = sample(1:10, 10000, replace = TRUE)
+    )
+    expect_error(export_list(iris, data), "Invalid")
+    expect_error(export_list(iris, iris), "Invalid")
+    expect_error(export_list(iris, 1), "Invalid")
+    expect_error(export_list(iris, TRUE), "Invalid")
+})
diff --git a/tests/testthat/test_import.r b/tests/testthat/test_import.r