test-zip.R
In zip: Cross-Platform 'zip' Compression

test_that("can compress single directory", {
  on.exit(try(unlink(c(zipfile, tmp), recursive = TRUE)))

  dir.create(tmp <- tempfile())
  cat("first file", file = file.path(tmp, "file1"))
  cat("second file", file = file.path(tmp, "file2"))

  zipfile <- tempfile(fileext = ".zip")

  withr::with_dir(
    dirname(tmp),
    zip(zipfile, basename(tmp))
  )

  expect_true(file.exists(zipfile))

  list <- zip_list(zipfile)
  expect_equal(
    list$filename,
    c(bns(tmp), file.path(basename(tmp), c("file1", "file2")))
  )
})

test_that("can compress single file", {
  on.exit(try(unlink(c(zipfile, tmp), recursive = TRUE)))

  tmp <- tempfile()
  cat("compress this if you can!", file = tmp)

  zipfile <- tempfile(fileext = ".zip")

  withr::with_dir(
    dirname(tmp),
    zip(zipfile, basename(tmp))
  )

  expect_true(file.exists(zipfile))

  list <- zip_list(zipfile)
  expect_equal(list$filename, basename(tmp))
})

test_that("can compress multiple files", {
  on.exit(try(unlink(c(zipfile, tmp1, tmp2), recursive = TRUE)))

  cat("compress this if you can!", file = tmp1 <- tempfile())
  cat("or even this one", file = tmp2 <- tempfile())

  zipfile <- tempfile(fileext = ".zip")

  withr::with_dir(
    dirname(tmp1),
    zip(zipfile, basename(c(tmp1, tmp2)))
  )

  expect_true(file.exists(zipfile))

  list <- zip_list(zipfile)
  expect_equal(list$filename, basename(c(tmp1, tmp2)))
})

test_that("can compress multiple directories", {
  on.exit(try(unlink(c(zipfile, tmp1, tmp2), recursive = TRUE)), add = TRUE)

  dir.create(tmp1 <- tempfile())
  dir.create(tmp2 <- tempfile())
  cat("first file\n", file = file.path(tmp1, "file1"))
  cat("second file\n", file = file.path(tmp1, "file2"))
  cat("third file\n", file = file.path(tmp2, "file3"))
  cat("fourth file\n", file = file.path(tmp2, "file4"))

  zipfile <- tempfile(fileext = ".zip")

  withr::with_dir(
    dirname(tmp1),
    zip(zipfile, basename(c(tmp1, tmp2)))
  )

  expect_true(file.exists(zipfile))

  list <- zip_list(zipfile)
  expect_equal(
    list$filename,
    c(
      bns(tmp1),
      file.path(basename(tmp1), c("file1", "file2")),
      bns(tmp2),
      file.path(basename(tmp2), c("file3", "file4"))
    )
  )

  on.exit(try(unlink(c(tmp3), recursive = TRUE)), add = TRUE)
  dir.create(tmp3 <- tempfile())
  utils::unzip(zipfile, exdir = tmp3)
  expect_true(file.info(file.path(tmp3, basename(tmp1)))$isdir)
  expect_true(file.info(file.path(tmp3, basename(tmp2)))$isdir)
  expect_equal(
    readLines(file.path(tmp1, "file1")),
    readLines(file.path(tmp3, basename(tmp1), "file1"))
  )
  expect_equal(
    readLines(file.path(tmp1, "file2")),
    readLines(file.path(tmp3, basename(tmp1), "file2"))
  )
  expect_equal(
    readLines(file.path(tmp2, "file3")),
    readLines(file.path(tmp3, basename(tmp2), "file3"))
  )
  expect_equal(
    readLines(file.path(tmp2, "file4")),
    readLines(file.path(tmp3, basename(tmp2), "file4"))
  )
})

test_that("can compress files and directories", {
  on.exit(try(unlink(c(zipfile, tmp, file1, file2), recursive = TRUE)))

  dir.create(tmp <- tempfile())
  cat("first file", file = file.path(tmp, "file1"))
  cat("second file", file = file.path(tmp, "file2"))
  cat("third file", file = file1 <- tempfile())
  cat("fourth file", file = file2 <- tempfile())

  zipfile <- tempfile(fileext = ".zip")

  withr::with_dir(
    dirname(tmp),
    zip(zipfile, basename(c(file1, tmp, file2)))
  )

  expect_true(file.exists(zipfile))

  list <- zip_list(zipfile)
  expect_equal(
    list$filename,
    c(
      basename(file1),
      bns(tmp),
      file.path(basename(tmp), c("file1", "file2")),
      basename(file2)
    )
  )
})

test_that("warning for directories in non-recursive mode", {
  on.exit(try(unlink(c(zipfile, tmp, file1, file2), recursive = TRUE)))

  dir.create(tmp <- tempfile())
  cat("first file", file = file.path(tmp, "file1"))
  cat("second file", file = file.path(tmp, "file2"))
  cat("third file", file = file1 <- tempfile())
  cat("fourth file", file = file2 <- tempfile())

  zipfile <- tempfile(fileext = ".zip")

  expect_warning(
    withr::with_dir(
      dirname(tmp),
      zip(zipfile, basename(c(file1, tmp, file2)), recurse = FALSE)
    ),
    "directories ignored"
  )

  expect_true(file.exists(zipfile))

  list <- zip_list(zipfile)
  expect_equal(
    list$filename,
    c(basename(file1), basename(file2))
  )
})

test_that("compression level is used", {
  on.exit(try(unlink(c(zipfile1, zipfile2, file), recursive = TRUE)))

  tmp <- tempfile()
  write(1:10000, file = file <- tempfile())

  zipfile1 <- tempfile(fileext = ".zip")
  zipfile2 <- tempfile(fileext = ".zip")

  withr::with_dir(
    dirname(file),
    zip(zipfile1, basename(file), compression_level = 1)
  )

  withr::with_dir(
    dirname(file),
    zip(zipfile2, basename(file), compression_level = 9)
  )

  expect_true(file.exists(zipfile1))
  expect_true(file.exists(zipfile2))

  list <- zip_list(zipfile1)
  expect_equal(list$filename, basename(file))

  list <- zip_list(zipfile2)
  expect_equal(list$filename, basename(file))

  expect_true(file.info(zipfile1)$size <= file.info(zipfile2)$size)
})

test_that("can append a directory to an archive", {
  on.exit(try(unlink(c(zipfile, tmp, tmp2), recursive = TRUE)))

  dir.create(tmp <- tempfile())
  cat("first file", file = file.path(tmp, "file1"))
  cat("second file", file = file.path(tmp, "file2"))

  zipfile <- tempfile(fileext = ".zip")

  withr::with_dir(
    dirname(tmp),
    zip(zipfile, basename(tmp))
  )

  expect_true(file.exists(zipfile))

  list <- zip_list(zipfile)
  expect_equal(
    list$filename,
    c(bns(tmp), file.path(basename(tmp), c("file1", "file2")))
  )

  dir.create(tmp2 <- tempfile())
  cat("first file2", file = file.path(tmp2, "file3"))
  cat("second file2", file = file.path(tmp2, "file4"))

  withr::with_dir(
    dirname(tmp),
    zip_append(zipfile, basename(tmp2))
  )

  list <- zip_list(zipfile)
  expect_equal(
    list$filename,
    c(
      bns(tmp),
      file.path(basename(tmp), c("file1", "file2")),
      bns(tmp2),
      file.path(basename(tmp2), c("file3", "file4"))
    )
  )
})

test_that("can append a file to an archive", {
  on.exit(try(unlink(c(zipfile, tmp, file1), recursive = TRUE)))

  dir.create(tmp <- tempfile())
  cat("first file", file = file.path(tmp, "file1"))
  cat("second file", file = file.path(tmp, "file2"))

  zipfile <- tempfile(fileext = ".zip")

  withr::with_dir(
    dirname(tmp),
    zip(zipfile, basename(tmp))
  )

  expect_true(file.exists(zipfile))

  list <- zip_list(zipfile)
  expect_equal(
    list$filename,
    c(bns(tmp), file.path(basename(tmp), c("file1", "file2")))
  )

  cat("first file2", file = file1 <- tempfile())

  withr::with_dir(
    dirname(tmp),
    zip_append(zipfile, basename(file1))
  )

  list <- zip_list(zipfile)
  expect_equal(
    list$filename,
    c(bns(tmp), file.path(basename(tmp), c("file1", "file2")), basename(file1))
  )
})

test_that("can append files and directories to an archive", {
  on.exit(try(unlink(c(zipfile, tmp, tmp2, file1), recursive = TRUE)))

  dir.create(tmp <- tempfile())
  cat("first file", file = file.path(tmp, "file1"))
  cat("second file", file = file.path(tmp, "file2"))

  zipfile <- tempfile(fileext = ".zip")

  withr::with_dir(
    dirname(tmp),
    zip(zipfile, basename(tmp))
  )

  expect_true(file.exists(zipfile))

  list <- zip_list(zipfile)
  expect_equal(
    list$filename,
    c(bns(tmp), file.path(basename(tmp), c("file1", "file2")))
  )

  cat("first file2", file = file1 <- tempfile())
  dir.create(tmp2 <- tempfile())
  cat("another", file = file.path(tmp2, "file3"))
  cat("and another", file = file.path(tmp2, "file4"))

  withr::with_dir(
    dirname(tmp),
    zip_append(zipfile, basename(c(file1, tmp2)))
  )

  list <- zip_list(zipfile)
  expect_equal(
    list$filename,
    c(
      bns(tmp),
      file.path(basename(tmp), c("file1", "file2")),
      basename(file1),
      bns(tmp2),
      file.path(basename(tmp2), c("file3", "file4"))
    )
  )
})

test_that("empty directories are archived as directories", {
  on.exit(try(unlink(c(zipfile, tmp), recursive = TRUE)), add = TRUE)
  dir.create(tmp <- tempfile())
  zipfile <- tempfile(fileext = ".zip")

  dir.create(file.path(tmp, "foo", "bar"), recursive = TRUE)
  dir.create(file.path(tmp, "foo", "bar2"))
  cat("contents\n", file = file.path(tmp, "foo", "file1"))

  withr::with_dir(
    dirname(tmp),
    zip(zipfile, basename(tmp))
  )

  bt <- basename(tmp)
  list <- zip_list(zipfile)
  expect_equal(
    list$filename,
    c(
      paste0(bt, "/"),
      paste0(bt, "/foo/"),
      paste0(bt, "/foo/bar/"),
      paste0(bt, "/foo/bar2/"),
      paste0(bt, "/foo/file1")
    )
  )

  on.exit(unlink(tmp2, recursive = TRUE), add = TRUE)
  dir.create(tmp2 <- tempfile())
  utils::unzip(zipfile, exdir = tmp2)
  files <- sort(dir(tmp2, recursive = TRUE, include.dirs = TRUE))
  expect_equal(
    files,
    c(
      bt,
      file.path(bt, "foo"),
      file.path(bt, "foo", "bar"),
      file.path(bt, "foo", "bar2"),
      file.path(bt, "foo", "file1")
    )
  )

  expect_equal(
    file.info(file.path(tmp2, files))$isdir,
    c(TRUE, TRUE, TRUE, TRUE, FALSE)
  )

  expect_equal(readLines(file.path(tmp2, bt, "foo", "file1")), "contents")
})

test_that("warn for relative paths", {
  on.exit(try(unlink(tmp, recursive = TRUE)), add = TRUE)
  dir.create(tmp <- tempfile())

  dir.create(file.path(tmp, "foo"))
  dir.create(file.path(tmp, "foo", "bar"))

  on.exit(unlink(zipfile), add = TRUE)
  zipfile <- tempfile(fileext = ".zip")

  withr::with_dir(
    file.path(tmp, "foo"),
    expect_warning(zip(zipfile, file.path("..", "foo")))
  )

  withr::with_dir(
    file.path(tmp, "foo"),
    expect_warning(zip(zipfile, file.path("..", "foo", "bar")))
  )

  withr::with_dir(
    file.path(tmp, "foo"),
    expect_warning(zip(zipfile, "."))
  )
})

test_that("example", {
  on.exit(unlink(tmp, recursive = TRUE), add = TRUE)
  dir.create(tmp <- tempfile())

  withr::with_dir(
    tmp,
    {
      dir.create("foo")
      dir.create(file.path("foo", "bar"))
      dir.create(file.path("foo", "bar2"))
      dir.create("foo2")

      cat("contents\n", file = file.path("foo", "bar", "file1"))
      cat("contents\n", file = file.path("foo", "bar2", "file2"))
      cat("contents\n", file = file.path("foo2", "file3"))

      setwd("foo")
      tz <- c(file.path("bar", "file1"), "bar2", file.path("..", "foo2"))
      expect_warning(zip("x.zip", tz))
      expect_equal(
        zip_list("x.zip")$filename,
        c(
          file.path("bar", "file1"),
          "bar2/",
          file.path("bar2", "file2"),
          paste0("../foo2/"),
          file.path("..", "foo2", "file3")
        )
      )

      zipr("xr.zip", tz)
      expect_equal(
        zip_list("xr.zip")$filename,
        c(
          "file1",
          "bar2/",
          file.path("bar2", "file2"),
          "foo2/",
          file.path("foo2", "file3")
        )
      )
    }
  )
})

test_that("zip_append replaces existing file with same key", {
  on.exit(try(unlink(c(zipfile, tmp), recursive = TRUE)))

  dir.create(tmp <- tempfile())
  cat("original content", file = file.path(tmp, "file1"))
  cat("other file", file = file.path(tmp, "file2"))

  zipfile <- tempfile(fileext = ".zip")
  withr::with_dir(dirname(tmp), zip(zipfile, basename(tmp)))

  cat("updated content", file = file.path(tmp, "file1"))
  withr::with_dir(
    dirname(tmp),
    zip_append(zipfile, file.path(basename(tmp), "file1"))
  )

  lst <- zip_list(zipfile)
  # Replaced entry moves to the end; non-replaced entries retain their order
  expect_equal(
    lst$filename,
    c(bns(tmp), file.path(basename(tmp), c("file2", "file1")))
  )

  exdir <- tempfile()
  on.exit(try(unlink(exdir, recursive = TRUE)), add = TRUE)
  unzip(zipfile, exdir = exdir)
  expect_equal(
    readLines(file.path(exdir, basename(tmp), "file1"), warn = FALSE),
    "updated content"
  )
})

test_that("zip_append replaces multiple existing entries", {
  on.exit(try(unlink(c(zipfile, tmp), recursive = TRUE)))

  dir.create(tmp <- tempfile())
  cat("a1", file = file.path(tmp, "a"))
  cat("b1", file = file.path(tmp, "b"))
  cat("c1", file = file.path(tmp, "c"))

  zipfile <- tempfile(fileext = ".zip")
  withr::with_dir(
    dirname(tmp),
    zip(
      zipfile,
      file.path(basename(tmp), c("a", "b", "c")),
      include_directories = FALSE
    )
  )
  expect_equal(nrow(zip_list(zipfile)), 3L)

  cat("a2", file = file.path(tmp, "a"))
  cat("c2", file = file.path(tmp, "c"))
  withr::with_dir(
    dirname(tmp),
    zip_append(
      zipfile,
      file.path(basename(tmp), c("a", "c")),
      include_directories = FALSE
    )
  )

  lst <- zip_list(zipfile)
  expect_equal(nrow(lst), 3L)
  expect_equal(lst$filename, file.path(basename(tmp), c("b", "a", "c")))

  exdir <- tempfile()
  on.exit(try(unlink(exdir, recursive = TRUE)), add = TRUE)
  unzip(zipfile, exdir = exdir)
  expect_equal(
    readLines(file.path(exdir, basename(tmp), "a"), warn = FALSE),
    "a2"
  )
  expect_equal(
    readLines(file.path(exdir, basename(tmp), "b"), warn = FALSE),
    "b1"
  )
  expect_equal(
    readLines(file.path(exdir, basename(tmp), "c"), warn = FALSE),
    "c2"
  )
})

test_that("zip_append without conflicts still works", {
  on.exit(try(unlink(c(zipfile, tmp), recursive = TRUE)))

  dir.create(tmp <- tempfile())
  cat("file1", file = file.path(tmp, "file1"))

  zipfile <- tempfile(fileext = ".zip")
  withr::with_dir(
    dirname(tmp),
    zip(zipfile, file.path(basename(tmp), "file1"), include_directories = FALSE)
  )

  cat("file2", file = file.path(tmp, "file2"))
  withr::with_dir(
    dirname(tmp),
    zip_append(
      zipfile,
      file.path(basename(tmp), "file2"),
      include_directories = FALSE
    )
  )

  lst <- zip_list(zipfile)
  expect_equal(nrow(lst), 2L)
  expect_equal(lst$filename, file.path(basename(tmp), c("file1", "file2")))
})

test_that("can omit directories", {
  on.exit(try(unlink(c(zipfile, tmp), recursive = TRUE)))

  dir.create(tmp <- tempfile())
  cat("first file", file = file.path(tmp, "file1"))
  cat("second file", file = file.path(tmp, "file2"))

  zipfile <- tempfile(fileext = ".zip")

  withr::with_dir(
    dirname(tmp),
    zip(zipfile, basename(tmp), include_directories = FALSE)
  )

  expect_true(file.exists(zipfile))

  list <- zip_list(zipfile)
  expect_equal(
    list$filename,
    file.path(basename(tmp), c("file1", "file2"))
  )
})

test_that("unzip() returns a data frame with file info", {
  on.exit(try(unlink(c(zipfile, tmp, exdir), recursive = TRUE)))

  dir.create(tmp <- tempfile())
  cat("first file", file = file.path(tmp, "file1"))
  cat("second file", file = file.path(tmp, "file2"))

  zipfile <- tempfile(fileext = ".zip")
  withr::with_dir(dirname(tmp), zip(zipfile, basename(tmp)))

  exdir <- tempfile()
  result <- unzip(zipfile, exdir = exdir)

  expect_s3_class(result, "data.frame")
  expect_equal(
    result$filename,
    c(bns(tmp), file.path(basename(tmp), c("file1", "file2")))
  )
  expect_true(all(file.exists(result$path)))
  expect_s3_class(result$timestamp, "POSIXct")
  expect_s3_class(result$permissions, "octmode")
  expect_s3_class(result$crc32, "hexmode")
})

test_that("unzip() path column matches zip_list() metadata", {
  on.exit(try(unlink(c(zipfile, tmp, exdir), recursive = TRUE)))

  dir.create(tmp <- tempfile())
  cat("hello", file = file.path(tmp, "a.txt"))

  zipfile <- tempfile(fileext = ".zip")
  withr::with_dir(dirname(tmp), zip(zipfile, basename(tmp)))

  exdir <- tempfile()
  result <- unzip(zipfile, exdir = exdir)
  listing <- zip_list(zipfile)

  expect_equal(result$filename, listing$filename)
  expect_equal(result$compressed_size, listing$compressed_size)
  expect_equal(result$uncompressed_size, listing$uncompressed_size)
  expect_equal(result$crc32, listing$crc32)
  expect_equal(result$type, listing$type)
})

test_that("unzip() with junkpaths returns correct paths", {
  on.exit(try(unlink(c(zipfile, tmp, exdir), recursive = TRUE)))

  dir.create(tmp <- tempfile())
  cat("hi", file = file.path(tmp, "file1"))

  zipfile <- tempfile(fileext = ".zip")
  withr::with_dir(
    dirname(tmp),
    zip(zipfile, basename(tmp), include_directories = FALSE)
  )

  exdir <- tempfile()
  result <- unzip(zipfile, exdir = exdir, junkpaths = TRUE)

  expect_equal(basename(result$path), basename(result$filename))
  expect_true(all(file.exists(result$path)))
})

test_that("zip() shows progress bar when zip_progress = TRUE", {
  skip_if_not_installed("cli")

  tmp <- test_temp_dir()
  cat("file content", file = file.path(tmp, "file1"))
  cat("more content", file = file.path(tmp, "file2"))
  zipfile <- test_temp_file(".zip", create = FALSE)

  withr::local_options(zip_progress = TRUE, cli.progress_show_after = -1)
  withr::local_dir(dirname(tmp))
  output <- capture.output(
    asNamespace("cli")$cli_with_ticks(
      zip(zipfile, basename(tmp))
    ),
    type = "message"
  )

  expect_true(file.exists(zipfile))
  expect_match(output, "Zipping", all = FALSE)
})

test_that("is_progress_enabled() falls back to the old zip.progress option", {
  skip_if_not_installed("cli")

  withr::local_envvar(ZIP_PROGRESS = NA)
  withr::local_options(zip_progress = NULL, zip.progress = NULL)
  expect_false(is_progress_enabled())

  withr::local_options(zip.progress = TRUE)
  expect_true(is_progress_enabled())

  # new option takes precedence
  withr::local_options(zip_progress = FALSE)
  expect_false(is_progress_enabled())
})