From 33283f4335b6206d1f05d83883922117d35192f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Wed, 7 May 2025 16:38:55 +0200 Subject: [PATCH 1/9] Upkeep 2025 --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 2efa783..4ae3672 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,3 +25,4 @@ Config/testthat/edition: 3 Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 +Config/usethis/last-upkeep: 2025-05-07 From 959116d9035ea16690059065c2141c25a6f2580f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Wed, 7 May 2025 16:40:02 +0200 Subject: [PATCH 2/9] usethis::use_air() --- .Rbuildignore | 2 + .vscode/extensions.json | 5 + .vscode/settings.json | 6 + R/assertions.R | 4 +- R/compat-vctrs.R | 987 ++++++++++++------------ R/inflate.R | 1 - R/process.R | 78 +- R/utils.R | 46 +- R/zip.R | 139 +++- air.toml | 0 src/install.libs.R | 1 - tests/testthat/helper.R | 38 +- tests/testthat/test-errors.R | 6 - tests/testthat/test-get-zip-data-path.R | 62 +- tests/testthat/test-get-zip-data.R | 60 +- tests/testthat/test-inflate.R | 220 +++++- tests/testthat/test-large-files.R | 18 +- tests/testthat/test-paths.R | 1 - tests/testthat/test-special-dot.R | 3 +- tests/testthat/test-unzip-process.R | 5 +- tests/testthat/test-unzip.R | 27 +- tests/testthat/test-weird-paths.R | 1 - tests/testthat/test-zip-list.R | 13 +- tests/testthat/test-zip-process.R | 1 - tests/testthat/test-zip.R | 112 ++- tests/testthat/test-zipr.R | 74 +- tools/getzipexe.R | 3 +- 27 files changed, 1150 insertions(+), 763 deletions(-) create mode 100644 .vscode/extensions.json create mode 100644 .vscode/settings.json create mode 100644 air.toml diff --git a/.Rbuildignore b/.Rbuildignore index e1dd87d..5281e86 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -24,3 +24,5 @@ ^_pkgdown\.yml$ ^docs$ ^pkgdown$ +^[\.]?air\.toml$ +^\.vscode$ diff --git a/.vscode/extensions.json b/.vscode/extensions.json new file mode 100644 index 0000000..344f76e --- /dev/null +++ b/.vscode/extensions.json @@ -0,0 +1,5 @@ +{ + "recommendations": [ + "Posit.air-vscode" + ] +} diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000..f2d0b79 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,6 @@ +{ + "[r]": { + "editor.formatOnSave": true, + "editor.defaultFormatter": "Posit.air-vscode" + } +} diff --git a/R/assertions.R b/R/assertions.R index e4d9658..210136f 100644 --- a/R/assertions.R +++ b/R/assertions.R @@ -1,4 +1,3 @@ - is_string <- function(x) { is.character(x) && length(x) == 1 && !is.na(x) } @@ -16,6 +15,5 @@ is_flag <- function(x) { } is_count <- function(x) { - is.numeric(x) && length(x) == 1 && !is.na(x) && - as.integer(x) == x + is.numeric(x) && length(x) == 1 && !is.na(x) && as.integer(x) == x } diff --git a/R/compat-vctrs.R b/R/compat-vctrs.R index 34860cf..4bb7bba 100644 --- a/R/compat-vctrs.R +++ b/R/compat-vctrs.R @@ -1,627 +1,630 @@ - compat_vctrs <- local({ + # Modified from https://github.com/r-lib/rlang/blob/master/R/compat-vctrs.R -# Modified from https://github.com/r-lib/rlang/blob/master/R/compat-vctrs.R - -# Construction ------------------------------------------------------------ - -# Constructs data frames inheriting from `"tbl"`. This allows the -# pillar package to take over printing as soon as it is loaded. -# The data frame otherwise behaves like a base data frame. -data_frame <- function(...) { - new_data_frame(df_list(...), .class = "tbl") -} + # Construction ------------------------------------------------------------ -new_data_frame <- function(.x = list(), - ..., - .size = NULL, - .class = NULL) { - n_cols <- length(.x) - if (n_cols != 0 && is.null(names(.x))) { - stop("Columns must be named.", call. = FALSE) + # Constructs data frames inheriting from `"tbl"`. This allows the + # pillar package to take over printing as soon as it is loaded. + # The data frame otherwise behaves like a base data frame. + data_frame <- function(...) { + new_data_frame(df_list(...), .class = "tbl") } - if (is.null(.size)) { - if (n_cols == 0) { - .size <- 0 - } else { - .size <- vec_size(.x[[1]]) + new_data_frame <- function(.x = list(), ..., .size = NULL, .class = NULL) { + n_cols <- length(.x) + if (n_cols != 0 && is.null(names(.x))) { + stop("Columns must be named.", call. = FALSE) } - } - - structure( - .x, - class = c(.class, "data.frame"), - row.names = .set_row_names(.size), - ... - ) -} -df_list <- function(..., .size = NULL) { - vec_recycle_common(list(...), size = .size) -} - - -# Binding ----------------------------------------------------------------- + if (is.null(.size)) { + if (n_cols == 0) { + .size <- 0 + } else { + .size <- vec_size(.x[[1]]) + } + } -vec_rbind <- function(...) { - xs <- vec_cast_common(list(...)) - do.call(base::rbind, xs) -} + structure( + .x, + class = c(.class, "data.frame"), + row.names = .set_row_names(.size), + ... + ) + } -vec_cbind <- function(...) { - xs <- list(...) + df_list <- function(..., .size = NULL) { + vec_recycle_common(list(...), size = .size) + } - ptype <- vec_ptype_common(lapply(xs, `[`, 0)) - class <- setdiff(class(ptype), "data.frame") + # Binding ----------------------------------------------------------------- - xs <- vec_recycle_common(xs) - out <- do.call(base::cbind, xs) - new_data_frame(out, .class = class) -} + vec_rbind <- function(...) { + xs <- vec_cast_common(list(...)) + do.call(base::rbind, xs) + } + vec_cbind <- function(...) { + xs <- list(...) -# Slicing ----------------------------------------------------------------- + ptype <- vec_ptype_common(lapply(xs, `[`, 0)) + class <- setdiff(class(ptype), "data.frame") -vec_size <- function(x) { - if (is.data.frame(x)) { - nrow(x) - } else { - length(x) + xs <- vec_recycle_common(xs) + out <- do.call(base::cbind, xs) + new_data_frame(out, .class = class) } -} -vec_rep <- function(x, times) { - i <- rep.int(seq_len(vec_size(x)), times) - vec_slice(x, i) -} - -vec_recycle_common <- function(xs, size = NULL) { - sizes <- vapply(xs, vec_size, integer(1)) + # Slicing ----------------------------------------------------------------- - n <- unique(sizes) + vec_size <- function(x) { + if (is.data.frame(x)) { + nrow(x) + } else { + length(x) + } + } - if (length(n) == 1 && is.null(size)) { - return(xs) + vec_rep <- function(x, times) { + i <- rep.int(seq_len(vec_size(x)), times) + vec_slice(x, i) } - n <- setdiff(n, 1L) - ns <- length(n) + vec_recycle_common <- function(xs, size = NULL) { + sizes <- vapply(xs, vec_size, integer(1)) + + n <- unique(sizes) - if (ns == 0) { - if (is.null(size)) { + if (length(n) == 1 && is.null(size)) { return(xs) } - } else if (ns == 1) { - if (is.null(size)) { - size <- n - } else if (ns != size) { - stop("Inputs can't be recycled to `size`.", call. = FALSE) + n <- setdiff(n, 1L) + + ns <- length(n) + + if (ns == 0) { + if (is.null(size)) { + return(xs) + } + } else if (ns == 1) { + if (is.null(size)) { + size <- n + } else if (ns != size) { + stop("Inputs can't be recycled to `size`.", call. = FALSE) + } + } else { + stop("Inputs can't be recycled to a common size.", call. = FALSE) } - } else { - stop("Inputs can't be recycled to a common size.", call. = FALSE) + + to_recycle <- sizes == 1L + xs[to_recycle] <- lapply(xs[to_recycle], vec_rep, size) + + xs } - to_recycle <- sizes == 1L - xs[to_recycle] <- lapply(xs[to_recycle], vec_rep, size) + vec_slice <- function(x, i) { + if (is.logical(i)) { + i <- which(i) + } + stopifnot(is.numeric(i) || is.character(i)) - xs -} + if (is.null(x)) { + return(NULL) + } -vec_slice <- function(x, i) { - if (is.logical(i)) { - i <- which(i) - } - stopifnot(is.numeric(i) || is.character(i)) + if (is.data.frame(x)) { + # We need to be a bit careful to be generic. First empty all + # columns and expand the df to final size. + out <- x[i, 0, drop = FALSE] - if (is.null(x)) { - return(NULL) - } + # Then fill in with sliced columns + out[seq_along(x)] <- lapply(x, vec_slice, i) - if (is.data.frame(x)) { - # We need to be a bit careful to be generic. First empty all - # columns and expand the df to final size. - out <- x[i, 0, drop = FALSE] + # Reset automatic row names to work around `[` weirdness + if (is.numeric(attr(x, "row.names"))) { + row_names <- .set_row_names(nrow(out)) + } else { + row_names <- attr(out, "row.names") + } - # Then fill in with sliced columns - out[seq_along(x)] <- lapply(x, vec_slice, i) + return(out) + } - # Reset automatic row names to work around `[` weirdness - if (is.numeric(attr(x, "row.names"))) { - row_names <- .set_row_names(nrow(out)) + d <- vec_dims(x) + if (d == 1) { + if (is.object(x)) { + out <- x[i] + } else { + out <- x[i, drop = FALSE] + } + } else if (d == 2) { + out <- x[i, , drop = FALSE] } else { - row_names <- attr(out, "row.names") + j <- rep(list(quote(expr = )), d - 1) + out <- eval(as.call(list( + quote(`[`), + quote(x), + quote(i), + j, + drop = FALSE + ))) } - return(out) + out } - - d <- vec_dims(x) - if (d == 1) { - if (is.object(x)) { - out <- x[i] + vec_dims <- function(x) { + d <- dim(x) + if (is.null(d)) { + 1L } else { - out <- x[i, drop = FALSE] + length(d) } - } else if (d == 2) { - out <- x[i, , drop = FALSE] - } else { - j <- rep(list(quote(expr = )), d - 1) - out <- eval(as.call(list(quote(`[`), quote(x), quote(i), j, drop = FALSE))) } - out -} -vec_dims <- function(x) { - d <- dim(x) - if (is.null(d)) { - 1L - } else { - length(d) - } -} + vec_as_location <- function(i, n, names = NULL) { + out <- seq_len(n) + names(out) <- names -vec_as_location <- function(i, n, names = NULL) { - out <- seq_len(n) - names(out) <- names + # Special-case recycling to size 0 + if (is_logical(i, n = 1) && !length(out)) { + return(out) + } - # Special-case recycling to size 0 - if (is_logical(i, n = 1) && !length(out)) { - return(out) + unname(out[i]) } - unname(out[i]) -} + vec_init <- function(x, n = 1L) { + vec_slice(x, rep_len(NA_integer_, n)) + } -vec_init <- function(x, n = 1L) { - vec_slice(x, rep_len(NA_integer_, n)) -} + vec_assign <- function(x, i, value) { + if (is.null(x)) { + return(NULL) + } -vec_assign <- function(x, i, value) { - if (is.null(x)) { - return(NULL) - } + if (is.logical(i)) { + i <- which(i) + } + stopifnot( + is.numeric(i) || is.character(i) + ) - if (is.logical(i)) { - i <- which(i) - } - stopifnot( - is.numeric(i) || is.character(i) - ) + value <- vec_recycle(value, vec_size(i)) + value <- vec_cast(value, to = x) - value <- vec_recycle(value, vec_size(i)) - value <- vec_cast(value, to = x) + d <- vec_dims(x) - d <- vec_dims(x) + if (d == 1) { + x[i] <- value + } else if (d == 2) { + x[i, ] <- value + } else { + stop("Can't slice-assign arrays.", call. = FALSE) + } - if (d == 1) { - x[i] <- value - } else if (d == 2) { - x[i, ] <- value - } else { - stop("Can't slice-assign arrays.", call. = FALSE) + x } - x -} + vec_recycle <- function(x, size) { + if (is.null(x) || is.null(size)) { + return(NULL) + } + + n_x <- vec_size(x) -vec_recycle <- function(x, size) { - if (is.null(x) || is.null(size)) { - return(NULL) + if (n_x == size) { + x + } else if (size == 0L) { + vec_slice(x, 0L) + } else if (n_x == 1L) { + vec_slice(x, rep(1L, size)) + } else { + stop("Incompatible lengths: ", n_x, ", ", size, call. = FALSE) + } } - n_x <- vec_size(x) + # Coercion ---------------------------------------------------------------- - if (n_x == size) { - x - } else if (size == 0L) { - vec_slice(x, 0L) - } else if (n_x == 1L) { - vec_slice(x, rep(1L, size)) - } else { - stop("Incompatible lengths: ", n_x, ", ", size, call. = FALSE) + vec_cast_common <- function(xs, to = NULL) { + ptype <- vec_ptype_common(xs, ptype = to) + lapply(xs, vec_cast, to = ptype) } -} + vec_cast <- function(x, to) { + if (is.null(x)) { + return(NULL) + } + if (is.null(to)) { + return(x) + } -# Coercion ---------------------------------------------------------------- + if (vec_is_unspecified(x)) { + return(vec_init(to, vec_size(x))) + } -vec_cast_common <- function(xs, to = NULL) { - ptype <- vec_ptype_common(xs, ptype = to) - lapply(xs, vec_cast, to = ptype) -} + stop_incompatible_cast <- function(x, to) { + stop( + sprintf( + "Can't convert <%s> to <%s>.", + .rlang_vctrs_typeof(x), + .rlang_vctrs_typeof(to) + ), + call. = FALSE + ) + } -vec_cast <- function(x, to) { - if (is.null(x)) { - return(NULL) - } - if (is.null(to)) { - return(x) - } + lgl_cast <- function(x, to) { + lgl_cast_from_num <- function(x) { + if (any(!x %in% c(0L, 1L))) { + stop_incompatible_cast(x, to) + } + as.logical(x) + } - if (vec_is_unspecified(x)) { - return(vec_init(to, vec_size(x))) - } + switch( + .rlang_vctrs_typeof(x), + logical = x, + integer = , + double = lgl_cast_from_num(x), + stop_incompatible_cast(x, to) + ) + } + + int_cast <- function(x, to) { + int_cast_from_dbl <- function(x) { + out <- suppressWarnings(as.integer(x)) + if (any((out != x) | xor(is.na(x), is.na(out)))) { + stop_incompatible_cast(x, to) + } else { + out + } + } - stop_incompatible_cast <- function(x, to) { - stop( - sprintf("Can't convert <%s> to <%s>.", + switch( .rlang_vctrs_typeof(x), - .rlang_vctrs_typeof(to) - ), - call. = FALSE - ) - } + logical = as.integer(x), + integer = x, + double = int_cast_from_dbl(x), + stop_incompatible_cast(x, to) + ) + } - lgl_cast <- function(x, to) { - lgl_cast_from_num <- function(x) { - if (any(!x %in% c(0L, 1L))) { + dbl_cast <- function(x, to) { + switch( + .rlang_vctrs_typeof(x), + logical = , + integer = as.double(x), + double = x, stop_incompatible_cast(x, to) - } - as.logical(x) + ) } - switch( - .rlang_vctrs_typeof(x), - logical = x, - integer = , - double = lgl_cast_from_num(x), - stop_incompatible_cast(x, to) - ) - } + chr_cast <- function(x, to) { + switch( + .rlang_vctrs_typeof(x), + character = x, + stop_incompatible_cast(x, to) + ) + } - int_cast <- function(x, to) { - int_cast_from_dbl <- function(x) { - out <- suppressWarnings(as.integer(x)) - if (any((out != x) | xor(is.na(x), is.na(out)))) { + list_cast <- function(x, to) { + switch( + .rlang_vctrs_typeof(x), + list = x, stop_incompatible_cast(x, to) - } else { - out - } + ) } - switch( - .rlang_vctrs_typeof(x), - logical = as.integer(x), - integer = x, - double = int_cast_from_dbl(x), - stop_incompatible_cast(x, to) - ) - } + df_cast <- function(x, to) { + # Check for extra columns + if (length(setdiff(names(x), names(to))) > 0) { + stop( + "Can't convert data frame because of missing columns.", + call. = FALSE + ) + } - dbl_cast <- function(x, to) { - switch( - .rlang_vctrs_typeof(x), - logical = , - integer = as.double(x), - double = x, - stop_incompatible_cast(x, to) - ) - } + # Avoid expensive [.data.frame method + out <- as.list(x) - chr_cast <- function(x, to) { - switch( - .rlang_vctrs_typeof(x), - character = x, - stop_incompatible_cast(x, to) - ) - } + # Coerce common columns + common <- intersect(names(x), names(to)) + out[common] <- Map(vec_cast, out[common], to[common]) - list_cast <- function(x, to) { - switch( - .rlang_vctrs_typeof(x), - list = x, - stop_incompatible_cast(x, to) - ) - } + # Add new columns + from_type <- setdiff(names(to), names(x)) + out[from_type] <- lapply(to[from_type], vec_init, n = vec_size(x)) - df_cast <- function(x, to) { - # Check for extra columns - if (length(setdiff(names(x), names(to))) > 0 ) { - stop("Can't convert data frame because of missing columns.", call. = FALSE) - } + # Ensure columns are ordered according to `to` + out <- out[names(to)] - # Avoid expensive [.data.frame method - out <- as.list(x) + new_data_frame(out) + } - # Coerce common columns - common <- intersect(names(x), names(to)) - out[common] <- Map(vec_cast, out[common], to[common]) + rlib_df_cast <- function(x, to) { + new_data_frame(df_cast(x, to), .class = "tbl") + } + tib_cast <- function(x, to) { + new_data_frame(df_cast(x, to), .class = c("tbl_df", "tbl")) + } - # Add new columns - from_type <- setdiff(names(to), names(x)) - out[from_type] <- lapply(to[from_type], vec_init, n = vec_size(x)) + switch( + .rlang_vctrs_typeof(to), + logical = lgl_cast(x, to), + integer = int_cast(x, to), + double = dbl_cast(x, to), + character = chr_cast(x, to), + list = list_cast(x, to), - # Ensure columns are ordered according to `to` - out <- out[names(to)] + base_data_frame = df_cast(x, to), + rlib_data_frame = rlib_df_cast(x, to), + tibble = tib_cast(x, to), - new_data_frame(out) + stop_incompatible_cast(x, to) + ) } - rlib_df_cast <- function(x, to) { - new_data_frame(df_cast(x, to), .class = "tbl") - } - tib_cast <- function(x, to) { - new_data_frame(df_cast(x, to), .class = c("tbl_df", "tbl")) - } + vec_ptype_common <- function(xs, ptype = NULL) { + if (!is.null(ptype)) { + return(vec_ptype(ptype)) + } - switch( - .rlang_vctrs_typeof(to), - logical = lgl_cast(x, to), - integer = int_cast(x, to), - double = dbl_cast(x, to), - character = chr_cast(x, to), - list = list_cast(x, to), + xs <- Filter(function(x) !is.null(x), xs) - base_data_frame = df_cast(x, to), - rlib_data_frame = rlib_df_cast(x, to), - tibble = tib_cast(x, to), + if (length(xs) == 0) { + return(NULL) + } - stop_incompatible_cast(x, to) - ) -} + if (length(xs) == 1) { + out <- vec_ptype(xs[[1]]) + } else { + xs <- map(xs, vec_ptype) + out <- Reduce(vec_ptype2, xs) + } -vec_ptype_common <- function(xs, ptype = NULL) { - if (!is.null(ptype)) { - return(vec_ptype(ptype)) + vec_ptype_finalise(out) } - xs <- Filter(function(x) !is.null(x), xs) + vec_ptype_finalise <- function(x) { + if (is.data.frame(x)) { + x[] <- lapply(x, vec_ptype_finalise) + return(x) + } - if (length(xs) == 0) { - return(NULL) + if (inherits(x, "rlang_unspecified")) { + logical() + } else { + x + } } - if (length(xs) == 1) { - out <- vec_ptype(xs[[1]]) - } else { - xs <- map(xs, vec_ptype) - out <- Reduce(vec_ptype2, xs) - } + vec_ptype <- function(x) { + if (vec_is_unspecified(x)) { + return(.rlang_vctrs_unspecified()) + } - vec_ptype_finalise(out) -} + if (is.data.frame(x)) { + out <- new_data_frame(lapply(x, vec_ptype)) -vec_ptype_finalise <- function(x) { - if (is.data.frame(x)) { - x[] <- lapply(x, vec_ptype_finalise) - return(x) - } + attrib <- attributes(x) + attrib$row.names <- attr(out, "row.names") + attributes(out) <- attrib - if (inherits(x, "rlang_unspecified")) { - logical() - } else { - x - } -} + return(out) + } -vec_ptype <- function(x) { - if (vec_is_unspecified(x)) { - return(.rlang_vctrs_unspecified()) + vec_slice(x, 0) } - if (is.data.frame(x)) { - out <- new_data_frame(lapply(x, vec_ptype)) + vec_ptype2 <- function(x, y) { + stop_incompatible_type <- function(x, y) { + stop( + sprintf( + "Can't combine types <%s> and <%s>.", + .rlang_vctrs_typeof(x), + .rlang_vctrs_typeof(y) + ), + call. = FALSE + ) + } - attrib <- attributes(x) - attrib$row.names <- attr(out, "row.names") - attributes(out) <- attrib + x_type <- .rlang_vctrs_typeof(x) + y_type <- .rlang_vctrs_typeof(y) - return(out) - } + if (x_type == "unspecified" && y_type == "unspecified") { + return(.rlang_vctrs_unspecified()) + } + if (x_type == "unspecified") { + return(y) + } + if (y_type == "unspecified") { + return(x) + } - vec_slice(x, 0) -} + df_ptype2 <- function(x, y) { + set_partition <- function(x, y) { + list( + both = intersect(x, y), + only_x = setdiff(x, y), + only_y = setdiff(y, x) + ) + } -vec_ptype2 <- function(x, y) { - stop_incompatible_type <- function(x, y) { - stop( - sprintf("Can't combine types <%s> and <%s>.", - .rlang_vctrs_typeof(x), - .rlang_vctrs_typeof(y)), - call. = FALSE - ) - } + # Avoid expensive [.data.frame + x <- as.list(vec_slice(x, 0)) + y <- as.list(vec_slice(y, 0)) - x_type <- .rlang_vctrs_typeof(x) - y_type <- .rlang_vctrs_typeof(y) + # Find column types + names <- set_partition(names(x), names(y)) + if (length(names$both) > 0) { + common_types <- Map(vec_ptype2, x[names$both], y[names$both]) + } else { + common_types <- list() + } + only_x_types <- x[names$only_x] + only_y_types <- y[names$only_y] - if (x_type == "unspecified" && y_type == "unspecified") { - return(.rlang_vctrs_unspecified()) - } - if (x_type == "unspecified") { - return(y) - } - if (y_type == "unspecified") { - return(x) - } + # Combine and construct + out <- c(common_types, only_x_types, only_y_types) + out <- out[c(names(x), names$only_y)] + new_data_frame(out) + } - df_ptype2 <- function(x, y) { - set_partition <- function(x, y) { - list( - both = intersect(x, y), - only_x = setdiff(x, y), - only_y = setdiff(y, x) - ) + rlib_df_ptype2 <- function(x, y) { + new_data_frame(df_ptype2(x, y), .class = "tbl") + } + tib_ptype2 <- function(x, y) { + new_data_frame(df_ptype2(x, y), .class = c("tbl_df", "tbl")) } - # Avoid expensive [.data.frame - x <- as.list(vec_slice(x, 0)) - y <- as.list(vec_slice(y, 0)) + ptype <- switch( + x_type, - # Find column types - names <- set_partition(names(x), names(y)) - if (length(names$both) > 0) { - common_types <- Map(vec_ptype2, x[names$both], y[names$both]) - } else { - common_types <- list() - } - only_x_types <- x[names$only_x] - only_y_types <- y[names$only_y] + logical = switch( + y_type, + logical = x, + integer = y, + double = y, + stop_incompatible_type(x, y) + ), - # Combine and construct - out <- c(common_types, only_x_types, only_y_types) - out <- out[c(names(x), names$only_y)] - new_data_frame(out) - } + integer = switch( + .rlang_vctrs_typeof(y), + logical = x, + integer = x, + double = y, + stop_incompatible_type(x, y) + ), - rlib_df_ptype2 <- function(x, y) { - new_data_frame(df_ptype2(x, y), .class = "tbl") - } - tib_ptype2 <- function(x, y) { - new_data_frame(df_ptype2(x, y), .class = c("tbl_df", "tbl")) - } + double = switch( + .rlang_vctrs_typeof(y), + logical = x, + integer = x, + double = x, + stop_incompatible_type(x, y) + ), - ptype <- switch( - x_type, + character = switch( + .rlang_vctrs_typeof(y), + character = x, + stop_incompatible_type(x, y) + ), - logical = switch( - y_type, - logical = x, - integer = y, - double = y, - stop_incompatible_type(x, y) - ), + list = switch( + .rlang_vctrs_typeof(y), + list = x, + stop_incompatible_type(x, y) + ), - integer = switch( - .rlang_vctrs_typeof(y), - logical = x, - integer = x, - double = y, - stop_incompatible_type(x, y) - ), + base_data_frame = switch( + .rlang_vctrs_typeof(y), + base_data_frame = , + s3_data_frame = df_ptype2(x, y), + rlib_data_frame = rlib_df_ptype2(x, y), + tibble = tib_ptype2(x, y), + stop_incompatible_type(x, y) + ), - double = switch( - .rlang_vctrs_typeof(y), - logical = x, - integer = x, - double = x, - stop_incompatible_type(x, y) - ), + rlib_data_frame = switch( + .rlang_vctrs_typeof(y), + base_data_frame = , + rlib_data_frame = , + s3_data_frame = rlib_df_ptype2(x, y), + tibble = tib_ptype2(x, y), + stop_incompatible_type(x, y) + ), - character = switch( - .rlang_vctrs_typeof(y), - character = x, - stop_incompatible_type(x, y) - ), + tibble = switch( + .rlang_vctrs_typeof(y), + base_data_frame = , + rlib_data_frame = , + tibble = , + s3_data_frame = tib_ptype2(x, y), + stop_incompatible_type(x, y) + ), - list = switch( - .rlang_vctrs_typeof(y), - list = x, - stop_incompatible_type(x, y) - ), - - base_data_frame = switch( - .rlang_vctrs_typeof(y), - base_data_frame = , - s3_data_frame = df_ptype2(x, y), - rlib_data_frame = rlib_df_ptype2(x, y), - tibble = tib_ptype2(x, y), stop_incompatible_type(x, y) - ), - - rlib_data_frame = switch( - .rlang_vctrs_typeof(y), - base_data_frame = , - rlib_data_frame = , - s3_data_frame = rlib_df_ptype2(x, y), - tibble = tib_ptype2(x, y), - stop_incompatible_type(x, y) - ), - - tibble = switch( - .rlang_vctrs_typeof(y), - base_data_frame = , - rlib_data_frame = , - tibble = , - s3_data_frame = tib_ptype2(x, y), - stop_incompatible_type(x, y) - ), + ) - stop_incompatible_type(x, y) - ) + vec_slice(ptype, 0) + } - vec_slice(ptype, 0) -} + .rlang_vctrs_typeof <- function(x) { + if (is.object(x)) { + class <- class(x) -.rlang_vctrs_typeof <- function(x) { - if (is.object(x)) { - class <- class(x) + if (identical(class, "rlang_unspecified")) { + return("unspecified") + } + if (identical(class, "data.frame")) { + return("base_data_frame") + } + if (identical(class, c("tbl", "data.frame"))) { + return("rlib_data_frame") + } + if (identical(class, c("tbl_df", "tbl", "data.frame"))) { + return("tibble") + } + if (inherits(x, "data.frame")) { + return("s3_data_frame") + } - if (identical(class, "rlang_unspecified")) { - return("unspecified") - } - if (identical(class, "data.frame")) { - return("base_data_frame") - } - if (identical(class, c("tbl", "data.frame"))) { - return("rlib_data_frame") - } - if (identical(class, c("tbl_df", "tbl", "data.frame"))) { - return("tibble") - } - if (inherits(x, "data.frame")) { - return("s3_data_frame") + class <- paste0(class, collapse = "/") + stop(sprintf("Unimplemented class <%s>.", class), call. = FALSE) } - class <- paste0(class, collapse = "/") - stop(sprintf("Unimplemented class <%s>.", class), call. = FALSE) - } + type <- typeof(x) + switch( + type, + NULL = return("null"), + logical = if (vec_is_unspecified(x)) { + return("unspecified") + } else { + return(type) + }, + integer = , + double = , + character = , + raw = , + list = return(type) + ) - type <- typeof(x) - switch( - type, - NULL = return("null"), - logical = if (vec_is_unspecified(x)) { - return("unspecified") - } else { - return(type) - }, - integer = , - double = , - character = , - raw = , - list = return(type) - ) - - stop(sprintf("Unimplemented type <%s>.", type), call. = FALSE) -} + stop(sprintf("Unimplemented type <%s>.", type), call. = FALSE) + } -vec_is_unspecified <- function(x) { - !is.object(x) && - typeof(x) == "logical" && - length(x) && - all(vapply(x, identical, logical(1), NA)) -} + vec_is_unspecified <- function(x) { + !is.object(x) && + typeof(x) == "logical" && + length(x) && + all(vapply(x, identical, logical(1), NA)) + } -.rlang_vctrs_unspecified <- function(x = NULL) { - structure( - rep(NA, length(x)), - class = "rlang_unspecified" - ) -} + .rlang_vctrs_unspecified <- function(x = NULL) { + structure( + rep(NA, length(x)), + class = "rlang_unspecified" + ) + } -.rlang_vctrs_s3_method <- function(generic, class, env = parent.frame()) { - fn <- get(generic, envir = env) + .rlang_vctrs_s3_method <- function(generic, class, env = parent.frame()) { + fn <- get(generic, envir = env) - ns <- asNamespace(topenv(fn)) - tbl <- ns$.__S3MethodsTable__. + ns <- asNamespace(topenv(fn)) + tbl <- ns$.__S3MethodsTable__. - for (c in class) { - name <- paste0(generic, ".", c) - if (exists(name, envir = tbl, inherits = FALSE)) { - return(get(name, envir = tbl)) - } - if (exists(name, envir = globalenv(), inherits = FALSE)) { - return(get(name, envir = globalenv())) + for (c in class) { + name <- paste0(generic, ".", c) + if (exists(name, envir = tbl, inherits = FALSE)) { + return(get(name, envir = tbl)) + } + if (exists(name, envir = globalenv(), inherits = FALSE)) { + return(get(name, envir = globalenv())) + } } - } - NULL -} - -environment() + NULL + } + environment() }) data_frame <- compat_vctrs$data_frame diff --git a/R/inflate.R b/R/inflate.R index e99532a..5abc04d 100644 --- a/R/inflate.R +++ b/R/inflate.R @@ -1,4 +1,3 @@ - #' Uncompress a raw GZIP stream #' #' @param buffer Raw vector, containing the data to uncompress. diff --git a/R/process.R b/R/process.R index 17448d5..d8031da 100644 --- a/R/process.R +++ b/R/process.R @@ -1,18 +1,17 @@ - os_type <- function() { .Platform$OS.type } -get_tool <- function (prog) { +get_tool <- function(prog) { if (os_type() == "windows") prog <- paste0(prog, ".exe") exe <- system.file(package = "zip", "bin", .Platform$r_arch, prog) - if (exe == "") { - pkgpath <- system.file(package = "zip") - if (basename(pkgpath) == "inst") pkgpath <- dirname(pkgpath) - exe <- file.path(pkgpath, "src", "tools", prog) - if (!file.exists(exe)) return("") - } + if (exe == "") { + pkgpath <- system.file(package = "zip") + if (basename(pkgpath) == "inst") pkgpath <- dirname(pkgpath) + exe <- file.path(pkgpath, "src", "tools", prog) + if (!file.exists(exe)) return("") + } exe } @@ -74,15 +73,25 @@ unzip_process <- function() { "unzip_process", inherit = processx::process, public = list( - initialize = function(zipfile, exdir = ".", poll_connection = TRUE, - stderr = tempfile(), ...) { + initialize = function( + zipfile, + exdir = ".", + poll_connection = TRUE, + stderr = tempfile(), + ... + ) { stopifnot( is_string(zipfile), - is_string(exdir)) + is_string(exdir) + ) exdir <- normalizePath(exdir, winslash = "\\", mustWork = FALSE) - super$initialize(unzip_exe(), enc2c(c(zipfile, exdir)), - poll_connection = poll_connection, - stderr = stderr, ...) + super$initialize( + unzip_exe(), + enc2c(c(zipfile, exdir)), + poll_connection = poll_connection, + stderr = stderr, + ... + ) } ), private = list() @@ -142,20 +151,33 @@ zip_process <- function() { "zip_process", inherit = processx::process, public = list( - initialize = function(zipfile, files, recurse = TRUE, - include_directories = TRUE, - poll_connection = TRUE, stderr = tempfile(), - ...) { + initialize = function( + zipfile, + files, + recurse = TRUE, + include_directories = TRUE, + poll_connection = TRUE, + stderr = tempfile(), + ... + ) { private$zipfile <- zipfile private$files <- files private$recurse <- recurse private$include_directories <- include_directories private$params_file <- tempfile() - write_zip_params(files, recurse, include_directories, - private$params_file) - super$initialize(zip_exe(), enc2c(c(zipfile, private$params_file)), - poll_connection = poll_connection, - stderr = stderr, ...) + write_zip_params( + files, + recurse, + include_directories, + private$params_file + ) + super$initialize( + zip_exe(), + enc2c(c(zipfile, private$params_file)), + poll_connection = poll_connection, + stderr = stderr, + ... + ) } ), private = list( @@ -171,8 +193,12 @@ zip_process <- function() { } write_zip_params <- function(files, recurse, include_directories, outfile) { - data <- get_zip_data(files, recurse, keep_path = FALSE, - include_directories = include_directories) + data <- get_zip_data( + files, + recurse, + keep_path = FALSE, + include_directories = include_directories + ) mtime <- as.double(file.info(data$file)$mtime) con <- file(outfile, open = "wb") @@ -182,7 +208,7 @@ write_zip_params <- function(files, recurse, include_directories, outfile) { writeBin(con = con, as.integer(nrow(data))) ## Key, first total length - data$key <- data$key <- fix_absolute_paths(data$key) + data$key <- data$key <- fix_absolute_paths(data$key) warn_for_colon(data$key) warn_for_dotdot(data$key) writeBin(con = con, as.integer(sum(nchar(data$key, type = "bytes") + 1L))) diff --git a/R/utils.R b/R/utils.R index 8a10d2a..304126c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,4 +1,3 @@ - `%||%` <- function(l, r) if (is.null(l)) r else l get_zip_data <- function(files, recurse, keep_path, include_directories) { @@ -9,19 +8,18 @@ get_zip_data <- function(files, recurse, keep_path, include_directories) { } if (!include_directories) { - list <- list[! list$dir, ] + list <- list[!list$dir, ] } list } get_zip_data_path <- function(files, recurse) { - if (recurse && length(files)) { + if (recurse && length(files)) { data <- do.call(rbind, lapply(files, get_zip_data_path_recursive)) dup <- duplicated(data$files) - if (any(dup)) data <- data <- data[ !dup, drop = FALSE ] + if (any(dup)) data <- data <- data[!dup, drop = FALSE] data - } else { files <- ignore_dirs_with_warning(files) data_frame( @@ -37,23 +35,29 @@ warn_for_dotdot <- function(files) { warning("Some paths start with `./`, creating non-portable zip file") } if (any(grepl("^[.][.][/\\\\]", files))) { - warning("Some paths reference parent directory, ", - "creating non-portable zip file") + warning( + "Some paths reference parent directory, ", + "creating non-portable zip file" + ) } files } warn_for_colon <- function(files) { if (any(grepl(":", files, fixed = TRUE))) { - warning("Some paths include a `:` character, this might cause issues ", - "when uncompressing the zip file on Windows.") + warning( + "Some paths include a `:` character, this might cause issues ", + "when uncompressing the zip file on Windows." + ) } } fix_absolute_paths <- function(files) { if (any(startsWith(files, "/"))) { - warning("Dropping leading `/` from paths, all paths in a zip file ", - "must be relative paths.") + warning( + "Dropping leading `/` from paths, all paths in a zip file ", + "must be relative paths." + ) files <- sub("^/", "", files) } files @@ -61,14 +65,13 @@ fix_absolute_paths <- function(files) { get_zip_data_nopath <- function(files, recurse) { if ("." %in% files) { - files <- c(setdiff(files, "."), dir(all.files=TRUE, no.. = TRUE)) + files <- c(setdiff(files, "."), dir(all.files = TRUE, no.. = TRUE)) } if (recurse && length(files)) { data <- do.call(rbind, lapply(files, get_zip_data_nopath_recursive)) dup <- duplicated(data$files) - if (any(dup)) data <- data[ !dup, drop = FALSE ] + if (any(dup)) data <- data[!dup, drop = FALSE] data - } else { files <- ignore_dirs_with_warning(files) data_frame( @@ -90,8 +93,17 @@ ignore_dirs_with_warning <- function(files) { get_zip_data_path_recursive <- function(x) { if (file.info(x)$isdir) { - files <- c(x, dir(x, recursive = TRUE, full.names = TRUE, - all.files = TRUE, include.dirs = TRUE, no.. = TRUE)) + files <- c( + x, + dir( + x, + recursive = TRUE, + full.names = TRUE, + all.files = TRUE, + include.dirs = TRUE, + no.. = TRUE + ) + ) dir <- file.info(files)$isdir data_frame( key = ifelse(dir, paste0(files, "/"), files), @@ -109,7 +121,7 @@ get_zip_data_path_recursive <- function(x) { get_zip_data_nopath_recursive <- function(x) { if ("." %in% x) { - x <- c(setdiff(x, "."), dir(all.files=TRUE, no.. = TRUE)) + x <- c(setdiff(x, "."), dir(all.files = TRUE, no.. = TRUE)) } x <- normalizePath(x) wd <- getwd() diff --git a/R/zip.R b/R/zip.R index cf3fc6a..e6ed062 100644 --- a/R/zip.R +++ b/R/zip.R @@ -1,4 +1,3 @@ - #' @useDynLib zip, .registration = TRUE, .fixes = "c_" NULL @@ -134,53 +133,113 @@ NULL #' zip_append(zipfile, file.path("mydir", "file3"), root = tmp) #' zip_list(zipfile) -zip <- function(zipfile, files, recurse = TRUE, compression_level = 9, - include_directories = TRUE, root = ".", - mode = c("mirror", "cherry-pick")) { +zip <- function( + zipfile, + files, + recurse = TRUE, + compression_level = 9, + include_directories = TRUE, + root = ".", + mode = c("mirror", "cherry-pick") +) { mode <- match.arg(mode) - zip_internal(zipfile, files, recurse, compression_level, append = FALSE, - root = root, keep_path = (mode == "mirror"), - include_directories = include_directories) + zip_internal( + zipfile, + files, + recurse, + compression_level, + append = FALSE, + root = root, + keep_path = (mode == "mirror"), + include_directories = include_directories + ) } #' @rdname zip #' @export -zipr <- function(zipfile, files, recurse = TRUE, compression_level = 9, - include_directories = TRUE, root = ".", - mode = c("cherry-pick", "mirror")) { +zipr <- function( + zipfile, + files, + recurse = TRUE, + compression_level = 9, + include_directories = TRUE, + root = ".", + mode = c("cherry-pick", "mirror") +) { mode <- match.arg(mode) - zip_internal(zipfile, files, recurse, compression_level, append = FALSE, - root = root, keep_path = (mode == "mirror"), - include_directories = include_directories) + zip_internal( + zipfile, + files, + recurse, + compression_level, + append = FALSE, + root = root, + keep_path = (mode == "mirror"), + include_directories = include_directories + ) } #' @rdname zip #' @export -zip_append <- function(zipfile, files, recurse = TRUE, - compression_level = 9, include_directories = TRUE, - root = ".", mode = c("mirror", "cherry-pick")) { +zip_append <- function( + zipfile, + files, + recurse = TRUE, + compression_level = 9, + include_directories = TRUE, + root = ".", + mode = c("mirror", "cherry-pick") +) { mode <- match.arg(mode) - zip_internal(zipfile, files, recurse, compression_level, append = TRUE, - root = root, keep_path = (mode == "mirror"), - include_directories = include_directories) + zip_internal( + zipfile, + files, + recurse, + compression_level, + append = TRUE, + root = root, + keep_path = (mode == "mirror"), + include_directories = include_directories + ) } #' @rdname zip #' @export -zipr_append <- function(zipfile, files, recurse = TRUE, - compression_level = 9, include_directories = TRUE, - root = ".", mode = c("cherry-pick", "mirror")) { +zipr_append <- function( + zipfile, + files, + recurse = TRUE, + compression_level = 9, + include_directories = TRUE, + root = ".", + mode = c("cherry-pick", "mirror") +) { mode <- match.arg(mode) - zip_internal(zipfile, files, recurse, compression_level, append = TRUE, - root = root, keep_path = (mode == "mirror"), - include_directories = include_directories) + zip_internal( + zipfile, + files, + recurse, + compression_level, + append = TRUE, + root = root, + keep_path = (mode == "mirror"), + include_directories = include_directories + ) } -zip_internal <- function(zipfile, files, recurse, compression_level, - append, root, keep_path, include_directories) { +zip_internal <- function( + zipfile, + files, + recurse, + compression_level, + append, + root, + keep_path, + include_directories +) { zipfile <- path.expand(zipfile) if (dir.exists(zipfile)) { stop("zip file at `", zipfile, "` already exists and it is a directory") @@ -195,9 +254,16 @@ zip_internal <- function(zipfile, files, recurse, compression_level, warn_for_colon(data$key) warn_for_dotdot(data$key) - .Call(c_R_zip_zip, enc2c(zipfile), enc2c(data$key), - enc2c(data$file), data$dir, file.info(data$file)$mtime, - as.integer(compression_level), append) + .Call( + c_R_zip_zip, + enc2c(zipfile), + enc2c(data$key), + enc2c(data$file), + data$dir, + file.info(data$file)$mtime, + as.integer(compression_level), + append + ) invisible(zipfile) } @@ -275,15 +341,20 @@ zip_list <- function(zipfile) { #' unzip(zipfile, exdir = tmp2) #' dir(tmp2, recursive = TRUE) -unzip <- function(zipfile, files = NULL, overwrite = TRUE, - junkpaths = FALSE, exdir = ".") { - +unzip <- function( + zipfile, + files = NULL, + overwrite = TRUE, + junkpaths = FALSE, + exdir = "." +) { stopifnot( is_string(zipfile), is_character_or_null(files), is_flag(overwrite), is_flag(junkpaths), - is_string(exdir)) + is_string(exdir) + ) zipfile <- enc2c(normalizePath(zipfile)) if (!is.null(files)) files <- enc2c(files) diff --git a/air.toml b/air.toml new file mode 100644 index 0000000..e69de29 diff --git a/src/install.libs.R b/src/install.libs.R index 97e652f..feb9373 100644 --- a/src/install.libs.R +++ b/src/install.libs.R @@ -1,4 +1,3 @@ - progs <- if (WINDOWS) { file.path("tools", c("cmdzip.exe", "cmdunzip.exe", "zip.exe")) } else { diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index edeb5c0..35d53e1 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -1,4 +1,3 @@ - df <- function(key, file, dir = FALSE) { data_frame( key = key, @@ -20,18 +19,14 @@ make_big_file <- function(file, mb) { make_big_file1 <- function(file, mb) { if (.Platform$OS.type == "windows") { .Call(c_R_make_big_file, file, as.integer(mb)) - } else if (Sys.info()["sysname"] == "Darwin") { .Call(c_R_make_big_file, file, as.integer(mb)) - } else if (nzchar(Sys.which("fallocate"))) { status <- system2("fallocate", c("-l", paste0(mb, "m"), shQuote(file))) if (status != 0) stop("Cannot create big files") - } else if (nzchar(Sys.which("mkfile"))) { status <- system2("mkfile", c(paste0(mb, "m"), shQuote(file))) if (status != 0) stop("Cannot create big files") - } else { stop("Cannot create big files") } @@ -43,15 +38,20 @@ bns <- function(x) { paste0(basename(x), "/") } -test_temp_file <- function(fileext = "", pattern = "test-file-", - envir = parent.frame(), create = TRUE) { +test_temp_file <- function( + fileext = "", + pattern = "test-file-", + envir = parent.frame(), + create = TRUE +) { tmp <- tempfile(pattern = pattern, fileext = fileext) if (identical(envir, .GlobalEnv)) { message("Temporary files will _not_ be cleaned up") } else { withr::defer( try(unlink(tmp, recursive = TRUE, force = TRUE), silent = TRUE), - envir = envir) + envir = envir + ) } if (create) { cat("", file = tmp) @@ -61,8 +61,11 @@ test_temp_file <- function(fileext = "", pattern = "test-file-", } } -test_temp_dir <- function(pattern = "test-dir-", envir = parent.frame(), - create = TRUE) { +test_temp_dir <- function( + pattern = "test-dir-", + envir = parent.frame(), + create = TRUE +) { tmp <- test_temp_file(pattern = pattern, envir = envir, create = FALSE) if (create) { dir.create(tmp, recursive = TRUE, showWarnings = FALSE) @@ -72,8 +75,11 @@ test_temp_dir <- function(pattern = "test-dir-", envir = parent.frame(), } } -make_a_zip <- function(mtime = Sys.time(), envir = parent.frame(), - include_directories = TRUE) { +make_a_zip <- function( + mtime = Sys.time(), + envir = parent.frame(), + include_directories = TRUE +) { tmp <- test_temp_dir(envir = envir) cat("file1\n", file = file.path(tmp, "file1")) cat("file11\n", file = file.path(tmp, "file11")) @@ -93,8 +99,12 @@ make_a_zip <- function(mtime = Sys.time(), envir = parent.frame(), list(zip = zip, ex = tmp) } -local_temp_dir <- function(pattern = "file", tmpdir = tempdir(), - fileext = "", envir = parent.frame()) { +local_temp_dir <- function( + pattern = "file", + tmpdir = tempdir(), + fileext = "", + envir = parent.frame() +) { path <- tempfile(pattern = pattern, tmpdir = tmpdir, fileext = fileext) dir.create(path) setwd(path) diff --git a/tests/testthat/test-errors.R b/tests/testthat/test-errors.R index 17e4ba9..364970d 100644 --- a/tests/testthat/test-errors.R +++ b/tests/testthat/test-errors.R @@ -1,6 +1,4 @@ - test_that("non-existant file", { - on.exit(try(unlink(c(zipfile, tmp), recursive = TRUE))) tmp <- tempfile() @@ -16,7 +14,6 @@ test_that("non-existant file", { }) test_that("appending non-existant file", { - on.exit(try(unlink(c(zipfile, tmp, tmp2), recursive = TRUE))) cat("compress this if you can!", file = tmp <- tempfile()) @@ -45,7 +42,6 @@ test_that("appending non-existant file", { }) test_that("non readable file", { - skip_on_os("windows") skip_on_os("linux") @@ -125,7 +121,6 @@ test_that("single empty directory, non-recursive", { }) test_that("appending single empty directory", { - on.exit(try(unlink(c(zipfile, tmp, tmp2), recursive = TRUE))) dir.create(tmp <- tempfile()) @@ -168,7 +163,6 @@ test_that("appending single empty directory", { }) test_that("appending single empty directory, non-recursive", { - on.exit(try(unlink(c(zipfile, tmp, tmp2), recursive = TRUE))) dir.create(tmp <- tempfile()) diff --git a/tests/testthat/test-get-zip-data-path.R b/tests/testthat/test-get-zip-data-path.R index ea57da3..80ff5e5 100644 --- a/tests/testthat/test-get-zip-data-path.R +++ b/tests/testthat/test-get-zip-data-path.R @@ -1,4 +1,3 @@ - test_that("get_zip_data", { on.exit(try(unlink(tmp, recursive = TRUE)), add = TRUE) dir.create(tmp <- tempfile()) @@ -16,25 +15,27 @@ test_that("get_zip_data", { get_zip_data_path_recursive(foobar), df(foobar, normalizePath(foobar), FALSE) ) - expect_equal(get_zip_data_path_recursive(foobar), get_zip_data_path(foobar, TRUE)) + expect_equal( + get_zip_data_path_recursive(foobar), + get_zip_data_path(foobar, TRUE) + ) expect_equal( get_zip_data_path_recursive(tmp), - df(c(paste0(tmp, "/"), file.path(tmp, "foobar")), - normalizePath(c(tmp, foobar)), - c(TRUE, FALSE) - ) + df( + c(paste0(tmp, "/"), file.path(tmp, "foobar")), + normalizePath(c(tmp, foobar)), + c(TRUE, FALSE) + ) ) expect_equal(get_zip_data_path_recursive(tmp), get_zip_data_path(tmp, TRUE)) expect_equal( withr::with_dir(tmp, get_zip_data_path_recursive(".")), - df(c("./", "./foobar"), - normalizePath(c(tmp, foobar)), - c(TRUE, FALSE) - ) + df(c("./", "./foobar"), normalizePath(c(tmp, foobar)), c(TRUE, FALSE)) ) - withr::with_dir(tmp, + withr::with_dir( + tmp, expect_equal(get_zip_data_path_recursive("."), get_zip_data_path(".", TRUE)) ) @@ -44,21 +45,27 @@ test_that("get_zip_data", { cat("bar\n", file = bar) data <- df( - c(paste0(tmp, "/"), + c( + paste0(tmp, "/"), paste0(file.path(tmp, "empty"), "/"), paste0(file.path(tmp, "foo"), "/"), file.path(tmp, "foo", "bar"), - file.path(tmp, "foobar")), + file.path(tmp, "foobar") + ), normalizePath(c( - tmp, file.path(tmp, "empty"), file.path(tmp, "foo"), - bar, file.path(tmp, "foobar"))), + tmp, + file.path(tmp, "empty"), + file.path(tmp, "foo"), + bar, + file.path(tmp, "foobar") + )), c(TRUE, TRUE, TRUE, FALSE, FALSE) ) data <- data[order(data$file), ] rownames(data) <- NULL data2 <- get_zip_data_path_recursive(tmp) - data2 <- data2[order(data2$file), ] + data2 <- data2[order(data2$file), ] rownames(data2) <- NULL expect_equal(data2, data) @@ -66,22 +73,20 @@ test_that("get_zip_data", { expect_equal( get_zip_data_path(c(foobar, bar), TRUE), - df(c(foobar, bar), - normalizePath(c(foobar, bar)), - c(FALSE, FALSE)) + df(c(foobar, bar), normalizePath(c(foobar, bar)), c(FALSE, FALSE)) ) expect_equal( get_zip_data_path(file.path(tmp, "foo"), TRUE), - df(c(paste0(file.path(tmp, "foo"), "/"), file.path(tmp, "foo", "bar")), - normalizePath(c(file.path(tmp, "foo"), file.path(tmp, "foo", "bar"))), - c(TRUE, FALSE) - ) + df( + c(paste0(file.path(tmp, "foo"), "/"), file.path(tmp, "foo", "bar")), + normalizePath(c(file.path(tmp, "foo"), file.path(tmp, "foo", "bar"))), + c(TRUE, FALSE) + ) ) }) test_that("get_zip_data relative paths", { - on.exit(try(unlink(tmp, recursive = TRUE)), add = TRUE) dir.create(tmp <- tempfile()) @@ -92,10 +97,11 @@ test_that("get_zip_data relative paths", { file.path(tmp, "foo"), expect_equal( get_zip_data_path(file.path("..", "foo"), TRUE), - df(paste0(c(file.path("..", "foo"), file.path("..", "foo", "bar")), "/"), - normalizePath(c(file.path(tmp, "foo"), file.path(tmp, "foo", "bar"))), - c(TRUE, TRUE) - ) + df( + paste0(c(file.path("..", "foo"), file.path("..", "foo", "bar")), "/"), + normalizePath(c(file.path(tmp, "foo"), file.path(tmp, "foo", "bar"))), + c(TRUE, TRUE) + ) ) ) }) diff --git a/tests/testthat/test-get-zip-data.R b/tests/testthat/test-get-zip-data.R index 411a50a..3dabfb6 100644 --- a/tests/testthat/test-get-zip-data.R +++ b/tests/testthat/test-get-zip-data.R @@ -1,4 +1,3 @@ - test_that("get_zip_data", { on.exit(try(unlink(tmp, recursive = TRUE)), add = TRUE) dir.create(tmp <- tempfile()) @@ -7,7 +6,10 @@ test_that("get_zip_data", { get_zip_data_nopath_recursive(tmp), df(paste0(basename(tmp), "/"), normalizePath(tmp), TRUE) ) - expect_equal(get_zip_data_nopath_recursive(tmp), get_zip_data_nopath(tmp, TRUE)) + expect_equal( + get_zip_data_nopath_recursive(tmp), + get_zip_data_nopath(tmp, TRUE) + ) foobar <- file.path(tmp, "foobar") cat("foobar", file = foobar) @@ -16,23 +18,34 @@ test_that("get_zip_data", { get_zip_data_nopath_recursive(foobar), df(basename(foobar), normalizePath(foobar), FALSE) ) - expect_equal(get_zip_data_nopath_recursive(foobar), get_zip_data_nopath(foobar, TRUE)) + expect_equal( + get_zip_data_nopath_recursive(foobar), + get_zip_data_nopath(foobar, TRUE) + ) expect_equal( get_zip_data_nopath_recursive(tmp), - df(c(paste0(basename(tmp), "/"), file.path(basename(tmp), "foobar")), - normalizePath(c(tmp, foobar)), - c(TRUE, FALSE) - ) + df( + c(paste0(basename(tmp), "/"), file.path(basename(tmp), "foobar")), + normalizePath(c(tmp, foobar)), + c(TRUE, FALSE) + ) + ) + expect_equal( + get_zip_data_nopath_recursive(tmp), + get_zip_data_nopath(tmp, TRUE) ) - expect_equal(get_zip_data_nopath_recursive(tmp), get_zip_data_nopath(tmp, TRUE)) expect_equal( withr::with_dir(tmp, get_zip_data_nopath_recursive(".")), df("foobar", normalizePath(foobar), FALSE) ) - withr::with_dir(tmp, - expect_equal(get_zip_data_nopath_recursive("."), get_zip_data_nopath(".", TRUE)) + withr::with_dir( + tmp, + expect_equal( + get_zip_data_nopath_recursive("."), + get_zip_data_nopath(".", TRUE) + ) ) dir.create(file.path(tmp, "empty")) @@ -41,14 +54,20 @@ test_that("get_zip_data", { cat("bar\n", file = bar) data <- df( - c(paste0(basename(tmp), "/"), + c( + paste0(basename(tmp), "/"), paste0(file.path(basename(tmp), "empty"), "/"), paste0(file.path(basename(tmp), "foo"), "/"), file.path(basename(tmp), "foo", "bar"), - file.path(basename(tmp), "foobar")), + file.path(basename(tmp), "foobar") + ), normalizePath(c( - tmp, file.path(tmp, "empty"), file.path(tmp, "foo"), - bar, file.path(tmp, "foobar"))), + tmp, + file.path(tmp, "empty"), + file.path(tmp, "foo"), + bar, + file.path(tmp, "foobar") + )), c(TRUE, TRUE, TRUE, FALSE, FALSE) ) data <- data[order(data$file), ] @@ -63,16 +82,15 @@ test_that("get_zip_data", { expect_equal( get_zip_data_nopath(c(foobar, bar), TRUE), - df(c("foobar", "bar"), - normalizePath(c(foobar, bar)), - c(FALSE, FALSE)) + df(c("foobar", "bar"), normalizePath(c(foobar, bar)), c(FALSE, FALSE)) ) expect_equal( get_zip_data_nopath(file.path(tmp, "foo"), TRUE), - df(c("foo/", "foo/bar"), - normalizePath(c(file.path(tmp, "foo"), file.path(tmp, "foo", "bar"))), - c(TRUE, FALSE) - ) + df( + c("foo/", "foo/bar"), + normalizePath(c(file.path(tmp, "foo"), file.path(tmp, "foo", "bar"))), + c(TRUE, FALSE) + ) ) }) diff --git a/tests/testthat/test-inflate.R b/tests/testthat/test-inflate.R index ae26770..514a69a 100644 --- a/tests/testthat/test-inflate.R +++ b/tests/testthat/test-inflate.R @@ -1,25 +1,205 @@ - test_that("inflate", { data_gz <- as.raw(c( - 0x78, 0x9c, 0xa5, 0xcc, 0x4d, 0x0a, 0x83, 0x30, 0x10, - 0x40, 0xe1, 0x7d, 0x4e, 0x31, 0xfb, 0x82, 0x4c, 0xfe, 0x34, 0x42, - 0x29, 0xa5, 0x2e, 0xba, 0xef, 0x0d, 0xc6, 0x64, 0x62, 0x85, 0x46, - 0x25, 0xc6, 0xde, 0xc7, 0xb3, 0x78, 0xb1, 0x7a, 0x87, 0xae, 0x1e, - 0x7c, 0x8b, 0x57, 0x32, 0x33, 0x38, 0x6e, 0x94, 0x37, 0x9e, 0x6a, - 0xe7, 0xb1, 0xb5, 0x68, 0x75, 0xaf, 0xbc, 0x0a, 0x3d, 0xa3, 0x8b, - 0x8d, 0x6a, 0x49, 0x6b, 0xa4, 0x28, 0x23, 0x93, 0x58, 0x28, 0xf3, - 0x54, 0x20, 0x44, 0x43, 0xca, 0xd5, 0xc6, 0xb4, 0x88, 0x36, 0x78, - 0xe4, 0x68, 0x0d, 0x73, 0x4d, 0xec, 0x90, 0x42, 0xb4, 0x51, 0x9a, - 0x80, 0xec, 0x83, 0x16, 0xb4, 0x95, 0xf7, 0x9c, 0xe1, 0x79, 0xec, - 0xfd, 0x99, 0x6e, 0x3d, 0xf6, 0x1c, 0x46, 0xb8, 0xfa, 0x95, 0xce, - 0x56, 0x03, 0x9d, 0x7a, 0x1f, 0x12, 0x8d, 0x9f, 0xca, 0xcf, 0xe9, - 0x06, 0xb2, 0x6e, 0xa4, 0x6a, 0x14, 0x6a, 0x84, 0x0b, 0x4a, 0x44, - 0x71, 0x6a, 0x1a, 0x4b, 0xe1, 0x3f, 0x16, 0xe2, 0xb1, 0xa5, 0x05, - 0xca, 0x0c, 0xaf, 0x0e, 0xbe, 0x9c, 0xd7, 0x71, 0x9e, 0xc4, 0x0f, - 0x2b, 0x30, 0x4d, 0xe3, 0xa0, 0x31, 0x78, 0x9c, 0x33, 0x34, 0x30, - 0x30, 0x33, 0x31, 0x51, 0xd0, 0x0b, 0x4a, 0x2a, 0xcd, 0xcc, 0x49, - 0xc9, 0x4c, 0xcf, 0xcb, 0x2f, 0x4a, 0x65, 0xa8, 0x48, 0xae, 0x29, - 0x77, 0xfc, 0x78, 0x21 + 0x78, + 0x9c, + 0xa5, + 0xcc, + 0x4d, + 0x0a, + 0x83, + 0x30, + 0x10, + 0x40, + 0xe1, + 0x7d, + 0x4e, + 0x31, + 0xfb, + 0x82, + 0x4c, + 0xfe, + 0x34, + 0x42, + 0x29, + 0xa5, + 0x2e, + 0xba, + 0xef, + 0x0d, + 0xc6, + 0x64, + 0x62, + 0x85, + 0x46, + 0x25, + 0xc6, + 0xde, + 0xc7, + 0xb3, + 0x78, + 0xb1, + 0x7a, + 0x87, + 0xae, + 0x1e, + 0x7c, + 0x8b, + 0x57, + 0x32, + 0x33, + 0x38, + 0x6e, + 0x94, + 0x37, + 0x9e, + 0x6a, + 0xe7, + 0xb1, + 0xb5, + 0x68, + 0x75, + 0xaf, + 0xbc, + 0x0a, + 0x3d, + 0xa3, + 0x8b, + 0x8d, + 0x6a, + 0x49, + 0x6b, + 0xa4, + 0x28, + 0x23, + 0x93, + 0x58, + 0x28, + 0xf3, + 0x54, + 0x20, + 0x44, + 0x43, + 0xca, + 0xd5, + 0xc6, + 0xb4, + 0x88, + 0x36, + 0x78, + 0xe4, + 0x68, + 0x0d, + 0x73, + 0x4d, + 0xec, + 0x90, + 0x42, + 0xb4, + 0x51, + 0x9a, + 0x80, + 0xec, + 0x83, + 0x16, + 0xb4, + 0x95, + 0xf7, + 0x9c, + 0xe1, + 0x79, + 0xec, + 0xfd, + 0x99, + 0x6e, + 0x3d, + 0xf6, + 0x1c, + 0x46, + 0xb8, + 0xfa, + 0x95, + 0xce, + 0x56, + 0x03, + 0x9d, + 0x7a, + 0x1f, + 0x12, + 0x8d, + 0x9f, + 0xca, + 0xcf, + 0xe9, + 0x06, + 0xb2, + 0x6e, + 0xa4, + 0x6a, + 0x14, + 0x6a, + 0x84, + 0x0b, + 0x4a, + 0x44, + 0x71, + 0x6a, + 0x1a, + 0x4b, + 0xe1, + 0x3f, + 0x16, + 0xe2, + 0xb1, + 0xa5, + 0x05, + 0xca, + 0x0c, + 0xaf, + 0x0e, + 0xbe, + 0x9c, + 0xd7, + 0x71, + 0x9e, + 0xc4, + 0x0f, + 0x2b, + 0x30, + 0x4d, + 0xe3, + 0xa0, + 0x31, + 0x78, + 0x9c, + 0x33, + 0x34, + 0x30, + 0x30, + 0x33, + 0x31, + 0x51, + 0xd0, + 0x0b, + 0x4a, + 0x2a, + 0xcd, + 0xcc, + 0x49, + 0xc9, + 0x4c, + 0xcf, + 0xcb, + 0x2f, + 0x4a, + 0x65, + 0xa8, + 0x48, + 0xae, + 0x29, + 0x77, + 0xfc, + 0x78, + 0x21 )) data <- inflate(data_gz, 1L, 245L) diff --git a/tests/testthat/test-large-files.R b/tests/testthat/test-large-files.R index 00362c6..928ac9f 100644 --- a/tests/testthat/test-large-files.R +++ b/tests/testthat/test-large-files.R @@ -1,4 +1,3 @@ - test_that("large zip files", { skip_on_cran() @@ -29,10 +28,11 @@ test_that("large zip files", { }) test_that("can compress / uncompress large files", { - skip_on_cran() - if (! nzchar(Sys.getenv("ZIP_LONG_TESTS")) && - ! nzchar(Sys.getenv("CI"))) { + if ( + !nzchar(Sys.getenv("ZIP_LONG_TESTS")) && + !nzchar(Sys.getenv("CI")) + ) { skip("takes long") } @@ -63,10 +63,11 @@ test_that("can compress / uncompress large files", { }) test_that("can compress / uncompress many files", { - skip_on_cran() - if (! nzchar(Sys.getenv("ZIP_LONG_TESTS")) && - ! nzchar(Sys.getenv("CI"))) { + if ( + !nzchar(Sys.getenv("ZIP_LONG_TESTS")) && + !nzchar(Sys.getenv("CI")) + ) { skip("takes long") } @@ -83,5 +84,6 @@ test_that("can compress / uncompress many files", { zip::unzip(zip, exdir = tmp2) expect_equal( length(dir(file.path(tmp2, basename(tmp)))), - 70000) + 70000 + ) }) diff --git a/tests/testthat/test-paths.R b/tests/testthat/test-paths.R index e3e3321..28a84c0 100644 --- a/tests/testthat/test-paths.R +++ b/tests/testthat/test-paths.R @@ -1,4 +1,3 @@ - test_that("base path with spaces", { local_temp_dir() dir.create("space 1 2") diff --git a/tests/testthat/test-special-dot.R b/tests/testthat/test-special-dot.R index ea71a53..f9c4ee4 100644 --- a/tests/testthat/test-special-dot.R +++ b/tests/testthat/test-special-dot.R @@ -1,4 +1,3 @@ - test_that("`.` is special in cherry picking mode", { dir.create(tmp <- tempfile("zip-test-dot-")) on.exit(unlink(tmp, recursive = TRUE), add = TRUE) @@ -12,7 +11,7 @@ test_that("`.` is special in cherry picking mode", { writeLines("foo", file.path("xxx", "foo")) setwd("xxx") - zip::zip("../out.zip", ".", mode="cherry-pick", include_directories = FALSE) + zip::zip("../out.zip", ".", mode = "cherry-pick", include_directories = FALSE) expect_equal(sort(zip_list("../out.zip")$file), sort(c("bar", "foo"))) }) diff --git a/tests/testthat/test-unzip-process.R b/tests/testthat/test-unzip-process.R index 93956a8..c46c146 100644 --- a/tests/testthat/test-unzip-process.R +++ b/tests/testthat/test-unzip-process.R @@ -1,4 +1,3 @@ - test_that("unzip_process", { z <- make_a_zip() tmp2 <- test_temp_dir() @@ -14,5 +13,7 @@ test_that("unzip_process", { expect_equal(readLines(file.path(tmp2, basename(z$ex), "file1")), "file1") expect_equal( - readLines(file.path(tmp2, basename(z$ex), "dir", "file2")), "file2") + readLines(file.path(tmp2, basename(z$ex), "dir", "file2")), + "file2" + ) }) diff --git a/tests/testthat/test-unzip.R b/tests/testthat/test-unzip.R index 5ed2b1c..9d15c2d 100644 --- a/tests/testthat/test-unzip.R +++ b/tests/testthat/test-unzip.R @@ -1,4 +1,3 @@ - test_that("can unzip all", { z <- make_a_zip() @@ -11,7 +10,9 @@ test_that("can unzip all", { expect_equal(readLines(file.path(tmp2, basename(z$ex), "file1")), "file1") expect_equal( - readLines(file.path(tmp2, basename(z$ex), "dir", "file2")), "file2") + readLines(file.path(tmp2, basename(z$ex), "dir", "file2")), + "file2" + ) }) test_that("unzip creates exdir if needed", { @@ -29,7 +30,9 @@ test_that("unzip creates exdir if needed", { expect_equal(readLines(file.path(tmp2, basename(z$ex), "file1")), "file1") expect_equal( - readLines(file.path(tmp2, basename(z$ex), "dir", "file2")), "file2") + readLines(file.path(tmp2, basename(z$ex), "dir", "file2")), + "file2" + ) }) test_that("unzip certain files only", { @@ -69,8 +72,11 @@ test_that("unzip certain files only", { ## Files and dirs tmp6 <- test_temp_dir() - zip::unzip(z$zip, paste0(basename(z$ex), c("/dir/file2", "/file1")), - exdir = tmp6) + zip::unzip( + z$zip, + paste0(basename(z$ex), c("/dir/file2", "/file1")), + exdir = tmp6 + ) expect_true(file.exists(file.path(tmp6, basename(z$ex), "file1"))) expect_true(file.exists(file.path(tmp6, basename(z$ex), "dir"))) @@ -78,7 +84,9 @@ test_that("unzip certain files only", { expect_equal(readLines(file.path(tmp6, basename(z$ex), "file1")), "file1") expect_equal( - readLines(file.path(tmp6, basename(z$ex), "dir", "file2")), "file2") + readLines(file.path(tmp6, basename(z$ex), "dir", "file2")), + "file2" + ) }) test_that("unzip sets mtime correctly", { @@ -112,7 +120,8 @@ test_that("overwrite is FALSE", { zip::unzip(z$zip, exdir = tmp) expect_error( zip::unzip(z$zip, overwrite = FALSE, exdir = tmp), - "Not overwriting") + "Not overwriting" + ) }) test_that("junkpaths is TRUE", { @@ -144,10 +153,10 @@ test_that("permissions as kept on Unix", { Sys.chmod(f, "0700", FALSE) cat("foobar2\n", file = f <- file.path(tmp, "dir", "file2")) - Sys.chmod(f, "0755", FALSE) + Sys.chmod(f, "0755", FALSE) cat("foobar3\n", file = f <- file.path(tmp, "dir", "file3")) - Sys.chmod(f, "0777", FALSE) + Sys.chmod(f, "0777", FALSE) zip <- test_temp_file(".zip", create = FALSE) zipr(zip, tmp) diff --git a/tests/testthat/test-weird-paths.R b/tests/testthat/test-weird-paths.R index a18c0e1..d22ae0f 100644 --- a/tests/testthat/test-weird-paths.R +++ b/tests/testthat/test-weird-paths.R @@ -1,4 +1,3 @@ - test_that("warning for colon", { skip_on_os("windows") diff --git a/tests/testthat/test-zip-list.R b/tests/testthat/test-zip-list.R index fe5d6e3..86a53e0 100644 --- a/tests/testthat/test-zip-list.R +++ b/tests/testthat/test-zip-list.R @@ -1,6 +1,4 @@ - test_that("can list a zip file", { - dir.create(tmp <- tempfile()) cat("first file", file = file.path(tmp, "file1")) cat("second file", file = file.path(tmp, "file2")) @@ -24,8 +22,15 @@ test_that("can list a zip file", { expect_equal( colnames(list), - c("filename", "compressed_size", "uncompressed_size", "timestamp", - "permissions", "crc32", "offset") + c( + "filename", + "compressed_size", + "uncompressed_size", + "timestamp", + "permissions", + "crc32", + "offset" + ) ) expect_true(is.numeric(list$offset)) expect_true(inherits(list$crc32, 'hexmode')) diff --git a/tests/testthat/test-zip-process.R b/tests/testthat/test-zip-process.R index ecea270..c324477 100644 --- a/tests/testthat/test-zip-process.R +++ b/tests/testthat/test-zip-process.R @@ -1,4 +1,3 @@ - test_that("zip_process", { z <- make_a_zip() diff --git a/tests/testthat/test-zip.R b/tests/testthat/test-zip.R index d07e080..c5aa711 100644 --- a/tests/testthat/test-zip.R +++ b/tests/testthat/test-zip.R @@ -1,6 +1,4 @@ - test_that("can compress single directory", { - on.exit(try(unlink(c(zipfile, tmp), recursive = TRUE))) dir.create(tmp <- tempfile()) @@ -24,7 +22,6 @@ test_that("can compress single directory", { }) test_that("can compress single file", { - on.exit(try(unlink(c(zipfile, tmp), recursive = TRUE))) tmp <- tempfile() @@ -44,7 +41,6 @@ test_that("can compress single file", { }) 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()) @@ -64,7 +60,6 @@ test_that("can compress multiple files", { }) test_that("can compress multiple directories", { - on.exit(try(unlink(c(zipfile, tmp1, tmp2), recursive = TRUE)), add = TRUE) dir.create(tmp1 <- tempfile()) @@ -86,8 +81,12 @@ test_that("can compress multiple directories", { 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"))) + 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) @@ -95,18 +94,25 @@ test_that("can compress multiple directories", { 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"))) + 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()) @@ -127,14 +133,16 @@ test_that("can compress files and directories", { list <- zip_list(zipfile) expect_equal( list$filename, - c(basename(file1), bns(tmp), + c( + basename(file1), + bns(tmp), file.path(basename(tmp), c("file1", "file2")), - basename(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()) @@ -163,7 +171,6 @@ test_that("warning for directories in non-recursive mode", { }) test_that("compression level is used", { - on.exit(try(unlink(c(zipfile1, zipfile2, file), recursive = TRUE))) tmp <- tempfile() @@ -195,7 +202,6 @@ test_that("compression level is used", { }) test_that("can append a directory to an archive", { - on.exit(try(unlink(c(zipfile, tmp, tmp2), recursive = TRUE))) dir.create(tmp <- tempfile()) @@ -229,13 +235,16 @@ test_that("can append a directory to an archive", { 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"))) + 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()) @@ -267,13 +276,11 @@ test_that("can append a file to an archive", { list <- zip_list(zipfile) expect_equal( list$filename, - c(bns(tmp), file.path(basename(tmp), c("file1", "file2")), - basename(file1)) + 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()) @@ -308,14 +315,17 @@ test_that("can append files and directories to an archive", { list <- zip_list(zipfile) expect_equal( list$filename, - c(bns(tmp), file.path(basename(tmp), c("file1", "file2")), + c( + bns(tmp), + file.path(basename(tmp), c("file1", "file2")), basename(file1), - bns(tmp2), file.path(basename(tmp2), c("file3", "file4"))) + 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") @@ -333,8 +343,13 @@ test_that("empty directories are archived as directories", { 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")) + 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) @@ -343,12 +358,19 @@ test_that("empty directories are archived as directories", { 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")) + 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( + file.info(file.path(tmp2, files))$isdir, + c(TRUE, TRUE, TRUE, TRUE, FALSE) + ) expect_equal(readLines(file.path(tmp2, bt, "foo", "file1")), "contents") }) @@ -400,15 +422,25 @@ test_that("example", { 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")) + 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")) + c( + "file1", + "bar2/", + file.path("bar2", "file2"), + "foo2/", + file.path("foo2", "file3") + ) ) } ) diff --git a/tests/testthat/test-zipr.R b/tests/testthat/test-zipr.R index 53d15b8..921af2e 100644 --- a/tests/testthat/test-zipr.R +++ b/tests/testthat/test-zipr.R @@ -1,6 +1,4 @@ - test_that("can compress single directory", { - on.exit(try(unlink(c(zipfile, tmp), recursive = TRUE))) dir.create(tmp <- tempfile()) @@ -26,7 +24,6 @@ test_that("can compress single directory", { }) test_that("can compress single file", { - on.exit(try(unlink(c(zipfile, tmp), recursive = TRUE))) tmp <- tempfile() @@ -48,7 +45,6 @@ test_that("can compress single file", { }) 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()) @@ -70,7 +66,6 @@ test_that("can compress multiple files", { }) test_that("can compress multiple directories", { - on.exit(try(unlink(c(zipfile, tmp1, tmp2), recursive = TRUE))) dir.create(tmp1 <- tempfile()) @@ -94,13 +89,16 @@ test_that("can compress multiple directories", { 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"))) + c( + bns(tmp1), + file.path(basename(tmp1), c("file1", "file2")), + bns(tmp2), + file.path(basename(tmp2), c("file3", "file4")) + ) ) }) test_that("can compress files and directories", { - on.exit(try(unlink(c(zipfile, tmp, file1, file2), recursive = TRUE))) dir.create(tmp <- tempfile()) @@ -123,14 +121,16 @@ test_that("can compress files and directories", { list <- zip_list(zipfile) expect_equal( list$filename, - c(basename(file1), bns(tmp), + c( + basename(file1), + bns(tmp), file.path(basename(tmp), c("file1", "file2")), - basename(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()) @@ -159,7 +159,6 @@ test_that("warning for directories in non-recursive mode", { }) test_that("compression level is used", { - on.exit(try(unlink(c(zipfile1, zipfile2, file), recursive = TRUE))) tmp <- tempfile() @@ -195,7 +194,6 @@ test_that("compression level is used", { }) test_that("can append a directory to an archive", { - on.exit(try(unlink(c(zipfile, tmp, tmp2), recursive = TRUE))) dir.create(tmp <- tempfile()) @@ -233,13 +231,16 @@ test_that("can append a directory to an archive", { 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"))) + 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()) @@ -275,13 +276,11 @@ test_that("can append a file to an archive", { list <- zip_list(zipfile) expect_equal( list$filename, - c(bns(tmp), file.path(basename(tmp), c("file1", "file2")), - basename(file1)) + 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()) @@ -320,14 +319,17 @@ test_that("can append files and directories to an archive", { list <- zip_list(zipfile) expect_equal( list$filename, - c(bns(tmp), file.path(basename(tmp), c("file1", "file2")), + c( + bns(tmp), + file.path(basename(tmp), c("file1", "file2")), basename(file1), - bns(tmp2), file.path(basename(tmp2), c("file3", "file4"))) + 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") @@ -347,8 +349,13 @@ test_that("empty directories are archived as directories", { 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")) + 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) @@ -357,12 +364,19 @@ test_that("empty directories are archived as directories", { 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")) + 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( + file.info(file.path(tmp2, files))$isdir, + c(TRUE, TRUE, TRUE, TRUE, FALSE) + ) expect_equal(readLines(file.path(tmp2, bt, "foo", "file1")), "contents") }) @@ -380,10 +394,10 @@ test_that("Permissions are kept on Unix", { Sys.chmod(f, "0700", FALSE) cat("foobar2\n", file = f <- file.path(tmp, "dir", "file2")) - Sys.chmod(f, "0755", FALSE) + Sys.chmod(f, "0755", FALSE) cat("foobar3\n", file = f <- file.path(tmp, "dir", "file3")) - Sys.chmod(f, "0777", FALSE) + Sys.chmod(f, "0777", FALSE) zip <- test_temp_file(".zip", create = FALSE) zipr(zip, tmp) diff --git a/tools/getzipexe.R b/tools/getzipexe.R index bdd691f..f396e37 100644 --- a/tools/getzipexe.R +++ b/tools/getzipexe.R @@ -1,5 +1,4 @@ - -if(getRversion() < "3.3.0") setInternet2() +if (getRversion() < "3.3.0") setInternet2() if (!file.exists("../tools/zip.exe")) { download.file( From 0eb5a197b0cfaa61a98b78574c09c105778fc9f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Wed, 7 May 2025 17:40:46 +0200 Subject: [PATCH 3/9] Add ROR for Posit in DESCRIPTION --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4ae3672..b03f82b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -5,7 +5,7 @@ Authors@R: c( person("Gábor", "Csárdi", , "csardi.gabor@gmail.com", role = c("aut", "cre")), person("Kuba", "Podgórski", role = "ctb"), person("Rich", "Geldreich", role = "ctb"), - person("Posit Software, PBC", role = c("cph", "fnd")) + person("Posit Software, PBC", role = c("cph", "fnd"), comment = c(ROR = "03wc8by49")) ) Description: Cross-Platform 'zip' Compression Library. A replacement for the 'zip' function, that does not require any additional external From 5cf1cf91b4cea9df70f25438bb976f77d5bbf0b6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Wed, 7 May 2025 17:41:49 +0200 Subject: [PATCH 4/9] knitr::convert_chunk_header(type = "yaml") --- README.Rmd | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/README.Rmd b/README.Rmd index 4ae1451..9a3dcc7 100644 --- a/README.Rmd +++ b/README.Rmd @@ -4,7 +4,8 @@ output: github_document -```{r, include = FALSE} +```{r} +#| include: false knitr::opts_chunk$set( collapse = TRUE, comment = "#>", @@ -28,19 +29,24 @@ knitr::opts_chunk$set( Stable version: -```{r eval = FALSE} +```{r} +#| eval: false install.packages("zip") ``` Development version: -```{r eval = FALSE} +```{r} +#| eval: false pak::pak("r-lib/zip") ``` ## Usage -```{r, include = FALSE, echo = FALSE, results = "hide"} +```{r} +#| include: false +#| echo: false +#| results: hide library(zip) ``` From 4faa387e19af927c2b162f1368831e7e27ae1a9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Wed, 7 May 2025 17:54:44 +0200 Subject: [PATCH 5/9] Switch to expect_snapshot(error = TRUE) --- tests/testthat/_snaps/errors.md | 16 ++++++++++++++++ tests/testthat/_snaps/inflate.md | 8 ++++++++ tests/testthat/_snaps/unzip.md | 8 ++++++++ tests/testthat/_snaps/weird-paths.md | 8 ++++++++ tests/testthat/helper.R | 16 ++++++++++++++++ tests/testthat/test-errors.R | 15 ++++++++++----- tests/testthat/test-inflate.R | 2 +- tests/testthat/test-unzip.R | 10 ++++++++-- tests/testthat/test-weird-paths.R | 9 ++++++++- 9 files changed, 83 insertions(+), 9 deletions(-) create mode 100644 tests/testthat/_snaps/errors.md create mode 100644 tests/testthat/_snaps/unzip.md create mode 100644 tests/testthat/_snaps/weird-paths.md diff --git a/tests/testthat/_snaps/errors.md b/tests/testthat/_snaps/errors.md new file mode 100644 index 0000000..97f78e0 --- /dev/null +++ b/tests/testthat/_snaps/errors.md @@ -0,0 +1,16 @@ +# non-existant file + + Code + withr::with_dir(dirname(tmp), zipr(zipfile, basename(tmp))) + Condition + Error in `zip_internal()`: + ! Some files do not exist + +# non readable file + + Code + withr::with_dir(dirname(tmp), zipr(zipfile, basename(tmp))) + Condition + Error in `zip_internal()`: + ! zip error: Cannot add file `` to archive `/.zip` in file zip.c:339 + diff --git a/tests/testthat/_snaps/inflate.md b/tests/testthat/_snaps/inflate.md index 3307d6d..f023193 100644 --- a/tests/testthat/_snaps/inflate.md +++ b/tests/testthat/_snaps/inflate.md @@ -1,3 +1,11 @@ +# inflate + + Code + inflate(data_gz, 10L, 300L) + Condition + Error in `inflate()`: + ! Input data is invalid + # deflate Code diff --git a/tests/testthat/_snaps/unzip.md b/tests/testthat/_snaps/unzip.md new file mode 100644 index 0000000..03bc501 --- /dev/null +++ b/tests/testthat/_snaps/unzip.md @@ -0,0 +1,8 @@ +# overwrite is FALSE + + Code + zip::unzip(z$zip, overwrite = FALSE, exdir = tmp) + Condition + Error in `zip::unzip()`: + ! zip error: Not overwriting `test-dir-/dir/` when extracting `/test-file-.zip` in file zip.c:192 + diff --git a/tests/testthat/_snaps/weird-paths.md b/tests/testthat/_snaps/weird-paths.md new file mode 100644 index 0000000..f217381 --- /dev/null +++ b/tests/testthat/_snaps/weird-paths.md @@ -0,0 +1,8 @@ +# backslash is an error + + Code + zip(tmpzip, tmp, mode = "cherry-pick") + Condition + Error in `zip_internal()`: + ! zip error: Cannot add file `zip-test-bs-/real\bad` to archive `/zip-test-bs-.zip` in file zip.c:360 + diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 35d53e1..b9c9fbb 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -117,3 +117,19 @@ local_temp_dir <- function( ) invisible(path) } + +transform_tempdir <- function(x) { + x <- sub(tempdir(), "", x, fixed = TRUE) + x <- sub(normalizePath(tempdir()), "", x, fixed = TRUE) + x <- sub( + normalizePath(tempdir(), winslash = "/"), + "", + x, + fixed = TRUE + ) + x <- sub("\\R\\", "/R/", x, fixed = TRUE) + x <- sub("[\\\\/]file[a-zA-Z0-9]+", "/", x) + x <- sub("[A-Z]:.*Rtmp[a-zA-Z0-9]+[\\\\/]", "/", x) + x +} + diff --git a/tests/testthat/test-errors.R b/tests/testthat/test-errors.R index 364970d..5f57402 100644 --- a/tests/testthat/test-errors.R +++ b/tests/testthat/test-errors.R @@ -4,12 +4,12 @@ test_that("non-existant file", { zipfile <- tempfile(fileext = ".zip") - expect_error( + expect_snapshot( + error = TRUE, withr::with_dir( dirname(tmp), zipr(zipfile, basename(tmp)) - ), - "Some files do not exist" + ) ) }) @@ -51,12 +51,17 @@ test_that("non readable file", { zipfile <- tempfile(fileext = ".zip") - expect_error( + expect_snapshot( + error = TRUE, withr::with_dir( dirname(tmp), zipr(zipfile, basename(tmp)) ), - "Cannot add file" + transform = function(x) { + x <- transform_tempdir(x) + x <- sub("`file[^`]+`", "``", x) + x + } ) }) diff --git a/tests/testthat/test-inflate.R b/tests/testthat/test-inflate.R index 514a69a..c72f972 100644 --- a/tests/testthat/test-inflate.R +++ b/tests/testthat/test-inflate.R @@ -220,7 +220,7 @@ test_that("inflate", { expect_silent(inflate(data_gz, 1L, 200L)) # bad format - expect_error(inflate(data_gz, 10L, 300L)) + expect_snapshot(error = TRUE, inflate(data_gz, 10L, 300L)) }) test_that("deflate", { diff --git a/tests/testthat/test-unzip.R b/tests/testthat/test-unzip.R index 9d15c2d..9bf9623 100644 --- a/tests/testthat/test-unzip.R +++ b/tests/testthat/test-unzip.R @@ -118,9 +118,15 @@ test_that("overwrite is FALSE", { tmp <- test_temp_dir() zip::unzip(z$zip, exdir = tmp) zip::unzip(z$zip, exdir = tmp) - expect_error( + expect_snapshot( + error = TRUE, zip::unzip(z$zip, overwrite = FALSE, exdir = tmp), - "Not overwriting" + transform = function(x) { + x <- transform_tempdir(x) + x <- sub("test-dir-[^/]+/", "test-dir-/", x) + x <- sub("test-file-[^.]+[.]", "test-file-.", x) + x + } ) }) diff --git a/tests/testthat/test-weird-paths.R b/tests/testthat/test-weird-paths.R index d22ae0f..b5247b5 100644 --- a/tests/testthat/test-weird-paths.R +++ b/tests/testthat/test-weird-paths.R @@ -46,7 +46,14 @@ test_that("backslash is an error", { on.exit(unlink(c(tmp, tmpzip), recursive = TRUE), add = TRUE) writeLines("boo", file.path(tmp, "real\\bad")) - expect_error(zip(tmpzip, tmp, mode = "cherry-pick")) + expect_snapshot( + error = TRUE, + zip(tmpzip, tmp, mode = "cherry-pick"), + transform = function(x) { + x <- transform_tempdir(x) + gsub("zip-test-bs-[^./]+\\b", "zip-test-bs-", x) + } + ) }) test_that("extracting absolute path", { From 040da457e31f3d9b2b52dc38211d2c8e0cb68c63 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Wed, 7 May 2025 17:55:39 +0200 Subject: [PATCH 6/9] usethis::use_mit_license() --- LICENSE | 2 +- LICENSE.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/LICENSE b/LICENSE index 1aafd6c..1e8ad79 100644 --- a/LICENSE +++ b/LICENSE @@ -1,2 +1,2 @@ -YEAR: 2023 +YEAR: 2025 COPYRIGHT HOLDER: zip authors diff --git a/LICENSE.md b/LICENSE.md index 2d0c788..680fe99 100644 --- a/LICENSE.md +++ b/LICENSE.md @@ -1,6 +1,6 @@ # MIT License -Copyright (c) 2023 zip authors +Copyright (c) 2025 zip authors Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal From a2afa7afa925f1251321db50f37e5f0cdcb5c0ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Wed, 7 May 2025 17:55:55 +0200 Subject: [PATCH 7/9] usethis::use_tidy_description() --- DESCRIPTION | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b03f82b..52dc3dc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -5,7 +5,8 @@ Authors@R: c( person("Gábor", "Csárdi", , "csardi.gabor@gmail.com", role = c("aut", "cre")), person("Kuba", "Podgórski", role = "ctb"), person("Rich", "Geldreich", role = "ctb"), - person("Posit Software, PBC", role = c("cph", "fnd"), comment = c(ROR = "03wc8by49")) + person("Posit Software, PBC", role = c("cph", "fnd"), + comment = c(ROR = "03wc8by49")) ) Description: Cross-Platform 'zip' Compression Library. A replacement for the 'zip' function, that does not require any additional external @@ -22,7 +23,7 @@ Suggests: withr Config/Needs/website: tidyverse/tidytemplate Config/testthat/edition: 3 +Config/usethis/last-upkeep: 2025-05-07 Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 -Config/usethis/last-upkeep: 2025-05-07 From e30e191d4602beb46ba8c2f2586b38976232017d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Wed, 7 May 2025 17:56:24 +0200 Subject: [PATCH 8/9] usethis::use_tidy_github_actions() --- .github/workflows/test-coverage.yaml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index e050312..0ab748d 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -34,15 +34,16 @@ jobs: clean = FALSE, install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") ) + print(cov) covr::to_cobertura(cov) shell: Rscript {0} - - uses: codecov/codecov-action@v4 + - uses: codecov/codecov-action@v5 with: # Fail if error if not on PR, or if on PR and token is given fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} - file: ./cobertura.xml - plugin: noop + files: ./cobertura.xml + plugins: noop disable_search: true token: ${{ secrets.CODECOV_TOKEN }} From 081ddc628682549070638c0a774f89fcdad97f4d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Wed, 7 May 2025 18:52:47 +0200 Subject: [PATCH 9/9] Fix test snapshot on Windows --- tests/testthat/test-unzip.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-unzip.R b/tests/testthat/test-unzip.R index 9bf9623..7d89420 100644 --- a/tests/testthat/test-unzip.R +++ b/tests/testthat/test-unzip.R @@ -125,6 +125,7 @@ test_that("overwrite is FALSE", { x <- transform_tempdir(x) x <- sub("test-dir-[^/]+/", "test-dir-/", x) x <- sub("test-file-[^.]+[.]", "test-file-.", x) + x <- sub("\\", "/", x, fixed = TRUE) x } )