Fix #425 (#426)

* Fix #425

no tests yet

* Add tests and Bürokratie

* Ik ben echt heel dom

* Windows bug?

Check on winbuilder

* How about this?

* How about this this

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rio
 Type: Package
 Title: A Swiss-Army Knife for Data I/O
-Version: 1.1.0
+Version: 1.1.1
 Authors@R: c(person("Jason", "Becker", role = "aut", email = "[email protected]"),
              person("Chung-hong", "Chan", role = c("aut", "cre"), email = "[email protected]",
 	     	     comment = c(ORCID = "0000-0002-6232-7530")),

NEWS.md

@@ -1,3 +1,9 @@
+# rio 1.1.1
+
+Bus fixes
+
+* Fix #425 for archive formats, the file extension of the input file is determined by the compressed file (like prior rio 1.1.0)
+
 # rio 1.1.0
 
 * CRAN release

R/compression.R

@@ -135,3 +135,11 @@ parse_archive <- function(file, which, file_type, ...) {
     }
     NULL
 }
+
+.get_compressed_format <- function(cfile, file, file_type, format) {
+    if (file_type %in% c("gzip", "bzip2")) {
+        return(ifelse(isFALSE(missing(format)), tolower(format), get_info(find_compress(cfile)$file)$input))
+    }
+    ## zip or tar formats, use the decompressed file path
+    return(ifelse(isFALSE(missing(format)), tolower(format), get_info(file)$input))
+}

R/import.R

@@ -135,8 +135,8 @@ import <- function(file, format, setclass = getOption("rio.import.class", "data.
         cfile <- file
         file <- f$file
         which <- ifelse(missing(which), 1, which)
-        format <- ifelse(isFALSE(missing(format)), tolower(format), get_info(file)$input)
         file <- parse_archive(cfile, which = which, file_type = f$compress)
+        format <- .get_compressed_format(cfile, file, f$compress, format)
         ## reset which if `file` is zip or tar. #412
         which <- .reset_which(file_type = f$compress, which = which)
     }

tests/testthat/test_compress.R

@@ -103,3 +103,24 @@ test_that("tar export error for R < 4.0.3", {
         expect_error(export(iris, iris_path), "^Exporting")
     })
 })
+
+test_that("Wild zip and tar ref $425", {
+    skip_if(getRversion() <= "4.0")
+    ##skip_on_os("windows")
+    withr::with_tempfile("test_files", fileext = c(".csv", ".zip"), code = {
+        filename <- test_files[1]
+        zip_file <- test_files[2]
+        write.csv(1, filename)
+        zip(zip_file, filename)
+        expect_error(rio::import(zip_file), NA)
+    })
+    for (tar_format in c("tar", "tar.gz", "tar.bz2")) {
+        withr::with_tempfile("test_files", fileext = c(".csv", paste0(".", tar_format)), code = {
+            filename <- test_files[1]
+            tar_file <- test_files[2]
+            write.csv(1, filename)
+            compress_out(tar_file, filename, type = tar_format)
+            expect_error(rio::import(tar_file), NA)
+        })
+    }
+})