diff --git a/NEWS.md b/NEWS.md index aba8160..0d0b4a2 100644 --- 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 index cdb47e8..428e255 100644 --- 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 index 28f0dda..aa6d0bc 100644 --- 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 index 77cfd48..12242f1 100644 --- 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 index 71fe6c2..f091d97 100644 --- 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 index 2d130e9..e261684 100644 --- 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 new file mode 100644 index 0000000..0093717 --- /dev/null +++ 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 deleted file mode 100644 index 6cb4eb6..0000000 --- a/tests/testthat/test_import.r +++ /dev/null @@ -1,12 +0,0 @@ - -test_that("Invalid file argument, #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") -})