diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 4f12df5c..1918f3f6 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -54,10 +54,18 @@ jobs: use-public-rspm: true - uses: r-lib/actions/setup-r-dependencies@v2 + if: runner.os != 'Windows' with: extra-packages: any::rcmdcheck needs: check + - uses: r-lib/actions/setup-r-dependencies@v2 + if: runner.os == 'Windows' + with: + extra-packages: any::rcmdcheck, asciicast=?ignore-before-r=4.0.0 + needs: check + + - name: "Set environmental variables" run: | cat(paste0("R_USER_CACHE_DIR=", Sys.getenv("GITHUB_WORKSPACE"), "/.github/cache\n"), file = Sys.getenv("GITHUB_ENV"), append = TRUE) diff --git a/DESCRIPTION b/DESCRIPTION index cfcc10a8..5873833e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: pkgdepends Title: Package Dependency Resolution and Downloads -Version: 0.7.1.9000 +Version: 0.7.2.9000 Authors@R: c( person("Gábor", "Csárdi", , "csardi.gabor@gmail.com", role = c("aut", "cre")), person("Posit Software, PBC", role = c("cph", "fnd")) @@ -72,4 +72,4 @@ Config/Needs/website: tidyverse/tidytemplate Config/testthat/edition: 3 Encoding: UTF-8 -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1.9000 diff --git a/NEWS.md b/NEWS.md index 6868031a..0a231f33 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,26 @@ # pkgdepends (development version) +* pkgdepends now supports `gitlab::` package sources better, by adding + explicit syntax to specify subdirectories (#353, @dgkf). + +* `gitlab::` and `git::` package sources now support git submodules if + the `git-submodules` configuration option is set to `TRUE`. See + `?"pkgdepends-config"` (#354). + +* The new `?ignore-unavailable` parameter makes it easy to ignore soft + dependencies that are unavailable + (https://github.com/r-lib/pak/issues/606). + +* pkgdepends now automatically ignores soft dependencies that have an + incompatible OS type (`OS_type` entry in `DESCRIPTION`) when installing + packages. + +# pkgdepends 0.7.2 + +* pkgdepends now supports the `*` wildcard for parameter specifications, + for parameters applied to all packages. E.g. `*=?source` means + compiling all packages from source. + # pkgdepends 0.7.1 * pkgdepends now does not import the glue, rprojroot and prettyunits diff --git a/R/git-app.R b/R/git-app.R index 7db82943..3ee74114 100644 --- a/R/git-app.R +++ b/R/git-app.R @@ -192,8 +192,9 @@ parse_url <- function(url) { re_url <- paste0( "^(?[a-zA-Z0-9]+)://", "(?:(?[^@/:]+)(?::(?[^@/]+))?@)?", - "(?[^/]+)", - "(?.*)$" # don't worry about query params here... + "(?(?[^:/]+)", + "(?::(?[0-9]+))?", + "(?/.*))$" # don't worry about query params here... ) - re_match(url, re_url)$groups + re_match(url, re_url) } diff --git a/R/git-auth.R b/R/git-auth.R index ab49842e..4f968a86 100644 --- a/R/git-auth.R +++ b/R/git-auth.R @@ -1,4 +1,3 @@ - # nocov start gitcreds_get <- NULL @@ -379,15 +378,23 @@ gitcreds_run <- function(command, input, args = character()) { git_run <- function(args, input = NULL) { stderr_file <- tempfile("gitcreds-stderr-") on.exit(unlink(stderr_file, recursive = TRUE), add = TRUE) + if (!is.null(input)) { + stdin_file <- tempfile("gitcreds-stdin-") + on.exit(unlink(stdin_file, recursive = TRUE), add = TRUE) + writeBin(charToRaw(input), stdin_file) + stdin <- stdin_file + } else { + stdin <- "" + } out <- tryCatch( suppressWarnings(system2( - "git", args, input = input, stdout = TRUE, stderr = stderr_file + "git", args, stdin = stdin, stdout = TRUE, stderr = stderr_file )), error = function(e) NULL ) if (!is.null(attr(out, "status")) && attr(out, "status") != 0) { - throw(new_error( + throw(new_git_error( "git_error", args = args, stdout = out, @@ -416,7 +423,7 @@ ack <- function(url, current, what = "Replace") { msg(paste0(format(current, header = FALSE), collapse = "\n"), "\n") choices <- c( - "Keep these credentials", + "Abort update with error, and keep the existing credentials", paste(what, "these credentials"), if (has_password(current)) "See the password / token" ) @@ -578,6 +585,12 @@ new_error <- function(class, ..., message = "", call. = TRUE, domain = NULL) { cond } +new_git_error <- function(class, ..., stderr) { + cond <- new_error(class, ..., stderr = stderr) + cond$message <- paste0(cond$message, ": ", stderr) + cond +} + new_warning <- function(class, ..., message = "", call. = TRUE, domain = NULL) { if (message == "") message <- gitcred_errors()[[class]] message <- .makeMessage(message, domain = domain) diff --git a/R/git-protocol.R b/R/git-protocol.R index 0f41cb7a..159a70a4 100644 --- a/R/git-protocol.R +++ b/R/git-protocol.R @@ -1,4 +1,3 @@ - #' git protocol notes, for developers #' #' Assumptions, they might be relaxed or checked for later: @@ -39,6 +38,30 @@ NULL # ------------------------------------------------------------------------- +git_creds_for_url <- function(url) { + creds <- tryCatch( + gitcreds_get(url)[c("username", "password")], + error = function(e) NULL + ) + if (is.null(creds)) { + do.call( + Sys.setenv, + structure(list("FAIL"), names = gitcreds_cache_envvar(url)) + ) + } + creds +} + +git_http_get <- function(url, options = list(), ...) { + options <- c(options, git_creds_for_url(url)) + http_get(url, options = options, ...) +} + +git_http_post <- function(url, options = list(), ...) { + options <- c(options, git_creds_for_url(url)) + http_post(url, options = options, ...) +} + #' List references in a remote git repository #' #' @details @@ -133,6 +156,7 @@ async_git_resolve_ref <- function(url, ref) { paste0(c("", "refs/heads/", "refs/tags/"), ref) } async_git_list_refs(url, filt)$ + catch(error = function(e) async_git_list_refs_v1(url))$ then(function(refs) { result <- if (ref %in% refs$refs$ref) { refs$refs$hash[refs$refs$ref == ref] @@ -163,6 +187,7 @@ async_git_resolve_ref <- function(url, ref) { } attr(result, "protocol") <- if ("version 2" %in% refs$caps) 2 else 1 + attr(result, "filter") <- any(grepl("\\bfilter\\b", refs$caps)) result }) @@ -360,6 +385,10 @@ async_git_fetch_v1 <- function(url, sha, blobs) { } async_git_fetch_v2 <- function(url, sha, blobs) { + # If 'filter' is not supported, then we need to get the blobs + if (!is.null(attr(sha, "filter")) && !attr(sha, "filter")) { + blobs <- TRUE + } async_git_send_message_v2( url, "fetch", @@ -501,20 +530,30 @@ git_fetch_process <- function(reply, url, sha) { # ------------------------------------------------------------------------- -git_download_repo <- function(url, ref = "HEAD", output = ref) { - synchronize(async_git_download_repo(url, ref, output)) +git_download_repo <- function(url, ref = "HEAD", output = ref, + submodules = FALSE) { + synchronize(async_git_download_repo(url, ref, output, submodules)) } -async_git_download_repo <- function(url, ref = "HEAD", output = ref) { +async_git_download_repo <- function(url, ref = "HEAD", output = ref, + submodules = FALSE) { url; ref async_git_resolve_ref(url, ref)$ - then(function(sha) async_git_download_repo_sha(url, sha, output)) + then(function(sha) { + async_git_download_repo_sha(url, sha, output, submodules) + }) } -async_git_download_repo_sha <- function(url, sha, output) { +async_git_download_repo_sha <- function(url, sha, output, + submodules = FALSE) { url; sha; output - async_git_fetch(url, sha, blobs = TRUE)$ + p <- async_git_fetch(url, sha, blobs = TRUE)$ then(function(packfile) unpack_packfile_repo(packfile, output, url)) + if (!submodules) { + p + } else { + p$then(function() async_update_git_submodules(output)) + } } unpack_packfile_repo <- function(parsed, output, url) { @@ -546,7 +585,10 @@ unpack_packfile_repo <- function(parsed, output, url) { process_tree(tidx) wd <<- utils::head(wd, -1) } else if (tr$type[l] == "blob") { - writeBin(parsed[[tr$hash[l]]]$raw, opath) + # for submodules this is NULL + if (!is.null(parsed[[tr$hash[l]]])) { + writeBin(parsed[[tr$hash[l]]]$raw, opath) + } } } } @@ -788,7 +830,8 @@ async_git_send_message_v2 <- function( "git-protocol" = "version=2", "content-length" = as.character(length(msg)) ) - http_post( + + git_http_post( url2, data = msg, headers = headers @@ -807,7 +850,7 @@ async_git_send_message_v1 <- function(url, args, caps) { "accept" = "application/x-git-upload-pack-result", "content-length" = as.character(length(msg)) ) - http_post( + git_http_post( url2, data = msg, headers = headers @@ -880,7 +923,7 @@ git_list_refs_v1 <- function(url) { async_git_list_refs_v1 <- function(url) { url url1 <- paste0(url, "/info/refs?service=git-upload-pack") - http_get(url1, headers = c("User-Agent" = git_ua()))$ + git_http_get(url1, headers = c("User-Agent" = git_ua()))$ then(http_stop_for_status)$ then(function(response) git_list_refs_v1_process(response, url)) } @@ -1006,11 +1049,13 @@ async_git_list_refs_v2 <- function(url, prefixes = character()) { url; prefixes url1 <- paste0(url, "/info/refs?service=git-upload-pack") + headers <- c( "User-Agent" = git_ua(), "git-protocol" = "version=2" ) - http_get(url1, headers = headers)$ + + git_http_get(url1, headers = headers)$ then(http_stop_for_status)$ then(function(res) async_git_list_refs_v2_process_1(res, url, prefixes)) } @@ -1656,9 +1701,9 @@ async_git_dumb_list_refs <- function(url) { "User-Agent" = git_ua() ) when_all( - http_get(url1, headers = headers)$ + git_http_get(url1, headers = headers)$ then(http_stop_for_status), - http_get(url2, headers = headers)$ + git_http_get(url2, headers = headers)$ then(http_stop_for_status) )$ then(function(res) async_git_dumb_list_refs_process(res, url)) @@ -1738,7 +1783,7 @@ async_git_dumb_get_commit <- function(url, sha) { "User-Agent" = git_ua(), "accept-encoding" = "deflate, gzip" ) - http_get(url = url1, headers = headers)$ + git_http_get(url = url1, headers = headers)$ then(http_stop_for_status)$ then(function(res) { cmt <- zip::inflate(res$content)$output @@ -1767,7 +1812,7 @@ async_git_dumb_get_tree <- function(url, sha) { "User-Agent" = git_ua(), "accept-encoding" = "deflate, gzip" ) - http_get(url = url1, headers = headers)$ + git_http_get(url = url1, headers = headers)$ then(http_stop_for_status)$ then(function(res) { cmt <- zip::inflate(res$content)$output @@ -1796,7 +1841,7 @@ async_git_dumb_get_blob <- function(url, sha) { "User-Agent" = git_ua(), "accept-encoding" = "deflate, gzip" ) - http_get(url = url1, headers = headers)$ + git_http_get(url = url1, headers = headers)$ then(http_stop_for_status)$ then(function(res) { cmt <- zip::inflate(res$content)$output diff --git a/R/git-submodules.R b/R/git-submodules.R new file mode 100644 index 00000000..217955f0 --- /dev/null +++ b/R/git-submodules.R @@ -0,0 +1,233 @@ +# From remotes +parse_submodules <- function(file) { + if (grepl("\n", file)) { + # fix windows line endings + file <- gsub("\r\n", "\n", file, fixed = TRUE) + x <- strsplit(file, "\n")[[1]] + } else { + x <- readLines(file) + } + + # https://git-scm.com/docs/git-config#_syntax + # Subsection names are case sensitive and can contain any characters except + # newline and the null byte. Doublequote " and backslash can be included by + # escaping them as \" and \\ + double_quoted_string_with_escapes <- '(?:\\\\.|[^"])*' + + # Otherwise extract section names + section_names <- re_match( + x, + sprintf( + '^[[:space:]]*\\[submodule "(?%s)"\\][[:space:]]*$', + double_quoted_string_with_escapes + ) + )$submodule + + # If no sections found return the empty list + if (all(is.na(section_names))) { + return(list()) + } + + # Extract name = value + # The variable names are case-insensitive, allow only alphanumeric characters + # and -, and must start with an alphabetic character. + variable_name <- "[[:alpha:]][[:alnum:]\\-]*" + mapping_values <- re_match( + x, + sprintf( + '^[[:space:]]*(?%s)[[:space:]]*=[[:space:]]*(?.*)[[:space:]]*$', + variable_name + ) + ) + + values <- cbind( + submodule = fill(section_names), mapping_values[c("name", "value")], + stringsAsFactors = FALSE + ) + values <- values[!is.na(mapping_values$.match), ] + + # path and valid url are required + if (!all(c("path", "url") %in% values$name)) { + warning( + "Invalid submodule definition, skipping submodule installation", + immediate. = TRUE, + call. = FALSE + ) + return(list()) + } + + # Roughly equivalent to tidyr::spread(values, name, value) + res <- stats::reshape( + values, + idvar = "submodule", + timevar = "name", + v.name = "value", + direction = "wide" + ) + + # Set the column names, reshape prepends `value.` to path, url and branch + colnames(res) <- gsub("value[.]", "", colnames(res)) + + # path and valid url are required + if (any(is.na(res$url), is.na(res$path))) { + warning( + "Invalid submodule definition, skipping submodule installation", + immediate. = TRUE, + call. = FALSE + ) + return(list()) + } + + # branch is optional + if (!exists("branch", res)) { + res$branch <- NA_character_ + } + + # Remove unneeded attribute + attr(res, "reshapeWide") <- NULL + + # Remove rownames + rownames(res) <- NULL + + res +} + +# Adapted from https://stackoverflow.com/a/9517731/2055486 +fill <- function(x) { + not_missing <- !is.na(x) + + res <- x[not_missing] + res[cumsum(not_missing)] +} + +update_submodule <- function(url, path, branch) { + synchronize(async_update_submodule(url, path, branch)) # nocov +} + +async_update_submodule <- function(url, path, branch) { + url; path; branch + # if the directory already exists and not empty, we assume that + # it was already downloaded. We still to update the submodules + # recursively. This is problematic if a git download is interrupted + # and then stated again with the same output, but that does not happen + # during normal operation of pkgdepends, I think. A better solution + # would be to download the submodule to a temporary directory, and if + # successful, then move the temporary directory to the correct place. + if (file.exists(path) && + length(dir(path, all.files = TRUE, no.. = TRUE)) > 0) { + # message(path, " exists") + async_update_git_submodules(path) + + } else { + if (is.null(branch) || is.na(branch)) branch <- "HEAD" + # message("getting ", path) + async_git_download_repo( + url, + ref = branch, + output = path, + submodules = TRUE + ) + } +} + +update_git_submodules_r <- function(path, subdir) { + synchronize(async_update_git_submodules_r(path, subdir)) # nocov +} + +async_update_git_submodules_r <- function(path, subdir) { + subdir <- subdir %||% "." + smfile <- file.path(path, ".gitmodules") + if (!file.exists(smfile)) return() + + info <- parse_submodules(smfile) + if (length(info) == 0) return() + + to_ignore <- in_r_build_ignore(info$path, file.path(path, subdir, ".Rbuildignore")) + info <- info[!to_ignore, ] + if (nrow(info) == 0) return() + + async_map(seq_len(nrow(info)), function(i) { + async_update_submodule( + info$url[i], + file.path(path, + info$path[i]), + info$branch[i] + ) + })$ + then(function() invisible()) +} + +update_git_submodules <- function(path) { + synchronize(async_update_git_submodules(path)) +} + +async_update_git_submodules <- function(path) { + smfile <- file.path(path, ".gitmodules") + if (!file.exists(smfile)) return() + + info <- parse_submodules(smfile) + if (nrow(info) == 0) return() + + async_map(seq_len(nrow(info)), function(i) { + async_update_submodule( + info$url[i], + file.path(path, + info$path[i]), + info$branch[i] + ) + })$ + then(function() invisible()) +} + +r_build_ignore_patterns <- c( + "^\\.Rbuildignore$", + "(^|/)\\.DS_Store$", + "^\\.(RData|Rhistory)$", + "~$", + "\\.bak$", + "\\.swp$", + "(^|/)\\.#[^/]*$", + "(^|/)#[^/]*#$", + "^TITLE$", + "^data/00Index$", + "^inst/doc/00Index\\.dcf$", + "^config\\.(cache|log|status)$", + "(^|/)autom4te\\.cache$", + "^src/.*\\.d$", + "^src/Makedeps$", + "^src/so_locations$", + "^inst/doc/Rplots\\.(ps|pdf)$" +) + +in_r_build_ignore <- function(paths, ignore_file) { + ignore <- tryCatch( + asNamespace("tools")$get_exclude_patterns(), + error = function(e) r_build_ignore_patterns + ) + + if (file.exists(ignore_file)) { + ignore <- c(ignore, readLines(ignore_file, warn = FALSE)) + } + + matches_ignores <- function(x) { + any(vlapply(ignore, grepl, x, perl = TRUE, ignore.case = TRUE)) + } + + # We need to search for the paths as well as directories in the path, so + # `^foo$` matches `foo/bar` + should_ignore <- function(path) { + any(vlapply(c(path, directories(path)), matches_ignores)) + } + + vlapply(paths, should_ignore) +} + +directories <- function (paths) { + dirs <- unique(dirname(paths)) + out <- dirs[dirs != "."] + while (length(dirs) > 0 && any(dirs != ".")) { + out <- unique(c(out, dirs[dirs != "."])) + dirs <- unique(dirname(dirs)) + } + sort(out) +} diff --git a/R/install-plan.R b/R/install-plan.R index cc6ceacc..71c29d73 100644 --- a/R/install-plan.R +++ b/R/install-plan.R @@ -358,14 +358,7 @@ make_build_process <- function(path, pkg, tmp_dir, lib, vignettes, if (is_windows()) { zip_tool_path <- asNamespace("zip")$get_tool("zip") rtools <- get_rtools_path() - withr_local_path( - paste0( - dirname(zip_tool_path), - .Platform$path.sep, - if (!is.null(rtools)) paste0(rtools, .Platform$path.sep), - Sys.getenv("PATH") - ) - ) + withr_local_path(c(dirname(zip_tool_path), rtools)) } # nocov end @@ -667,7 +660,7 @@ stop_task_package_build <- function(state, worker) { state$cache$add(state$plan$file[pkgidx], state$plan$target[pkgidx], package = pkg, version = version, built = TRUE, sha256 = state$plan$extra[[pkgidx]]$remotesha, - vignettes = state$plan$vignette[pkgidx], + vignettes = state$plan$vignettes[pkgidx], platform = "source"), error = function(err) { alert("warning", "Failed to add {.pkg {pkg}} \\ @@ -748,7 +741,7 @@ stop_task_build <- function(state, worker) { state$cache$add(state$plan$file[pkgidx], target, package = pkg, version = version, built = TRUE, sha256 = state$plan$extra[[pkgidx]]$remotesha, - vignettes = state$plan$vignette[pkgidx], + vignettes = state$plan$vignettes[pkgidx], platform = ptfm, rversion = rv), error = function(err) { alert("warning", "Failed to add {.pkg {pkg}} \\ diff --git a/R/parse-remotes.R b/R/parse-remotes.R index 2e3142ee..e661f564 100644 --- a/R/parse-remotes.R +++ b/R/parse-remotes.R @@ -210,7 +210,7 @@ parse_pkg_refs <- function(refs, remote_types = NULL, ...) { if (length(bad <- setdiff(unique_types, names(remote_types)))) { throw(pkg_error( - "Unknown package source{?}: {.val {bad}}.", + "Unknown package source{?s}: {.val {bad}}.", i = msg_package_sources() )) } @@ -272,8 +272,15 @@ add_ref_params <- function(res, params) { res } -known_query_params <- c("ignore", "ignore-before-r", "ignore-build-errors", - "nocache", "reinstall", "source") +known_query_params <- c( + "ignore", + "ignore-before-r", + "ignore-build-errors", + "ignore-unavailable", + "nocache", + "reinstall", + "source" +) parse_query <- function(ref) { query <- sub("^[^?]*(\\?|$)", "", ref) diff --git a/R/resolution-df.R b/R/resolution-df.R index 212e8485..33cffabf 100644 --- a/R/resolution-df.R +++ b/R/resolution-df.R @@ -33,7 +33,8 @@ res_make_empty_df <- local({ extra = list(), # any extra data (e.g. GitHub sha) dep_types= list(), params = list(), - sysreqs = character() + sysreqs = character(), + os_type = character() ) } data @@ -70,7 +71,8 @@ res_df_defaults <- local({ extra = list(list()), dep_types= list("default"), params = list(character()), - sysreqs = NA_character_ + sysreqs = NA_character_, + os_type = NA_character_ ) } data diff --git a/R/resolution.R b/R/resolution.R index f18d86ba..18b099fd 100644 --- a/R/resolution.R +++ b/R/resolution.R @@ -667,7 +667,7 @@ resolve_from_metadata <- function(remotes, direct, config, cache, "ref", "type", "status", "package", "version", "license", "needscompilation", "priority", "md5sum", "platform", "rversion", "repodir", "target", "deps", "sources", "mirror", - "filesize", "sha256", "sysreqs") + "filesize", "sha256", "sysreqs", "os_type") cols <- intersect(names(data), cols) diff --git a/R/solve.R b/R/solve.R index 72b74f9f..9df68309 100644 --- a/R/solve.R +++ b/R/solve.R @@ -211,6 +211,7 @@ pkgplan_i_create_lp_problem <- function(pkgs, config, policy) { lp <- pkgplan_i_lp_init(pkgs, config, policy) lp <- pkgplan_i_lp_objectives(lp) + lp <- pkgplan_i_lp_os_type(config, lp) lp <- pkgplan_i_lp_force_source(lp) lp <- pkgplan_i_lp_failures(lp) lp <- pkgplan_i_lp_ignore(lp) @@ -301,6 +302,20 @@ pkgplan_i_lp_objectives <- function(lp) { lp } +pkgplan_i_lp_os_type <- function(config, lp) { + if (config$get("goal") != "install") return(lp) + if (! "os_type" %in% names(lp$pkgs)) return(lp) + os <- os_type() + bad <- which(!is.na(lp$pkgs$os_type) & lp$pkgs$os_type != os) + for (wh in bad) { + lp <- pkgplan_i_lp_add_cond(lp, wh, op = "==", rhs = 0, + type = "matching-platform") + } + lp$ruled_out <- c(lp$ruled_out, bad) + + lp +} + pkgplan_i_lp_force_source <- function(lp) { # if source package is forced, then rule out binaries src_req <- vlapply(lp$pkgs$params, is_true_param, "source") @@ -606,6 +621,7 @@ pkgplan_i_lp_dependencies <- function(lp, config) { num_candidates <- lp$num_candidates ruled_out <- lp$ruled_out base <- base_packages() + ignored <- vlapply(pkgs$params, is_true_param, "ignore") ignore_rver <- vcapply(pkgs$params, get_param_value, "ignore-before-r") if (any(!is.na(ignore_rver))) { @@ -614,6 +630,21 @@ pkgplan_i_lp_dependencies <- function(lp, config) { ignored2 <- package_version(ignore_rver) > current ignored <- ignored | ignored2 } + ignore_unavail <- vlapply( + pkgs$params, + is_true_param, + "ignore-unavailable" + ) + failed <- pkgs$status == "FAILED" + ignored <- ignored | (ignore_unavail & failed) + + # ignore packages with the wrong OS type + if (config$get("goal") == "install") { + os <- os_type() + bad <- which(!is.na(pkgs$os_type) & pkgs$os_type != os) + if (length(bad) > 0) ignored[bad] <- TRUE + } + soft_deps <- tolower(pkg_dep_types_soft()) ## 4. Package dependencies must be satisfied diff --git a/R/type-git.R b/R/type-git.R index f15276c1..1ddb6aa6 100644 --- a/R/type-git.R +++ b/R/type-git.R @@ -77,8 +77,8 @@ download_remote_git <- function(resolution, target, target_tree, ## 3. Check if we have a repo snapshot in the cache. rel_target <- resolution$target + subdir <- resolution$remote[[1]]$subdir if (!nocache) { - subdir <- resolution$remote[[1]]$subdir hit <- cache$package$copy_to( target_tree, package = package, sha256 = sha, built = FALSE) if (nrow(hit)) { @@ -88,14 +88,21 @@ download_remote_git <- function(resolution, target, target_tree, ## 4. Need to download the repo - url <- git_auth_url(resolution$remote[[1]]) + url <- resolution$remote[[1]]$url sha <- resolution$metadata[[1]][["RemoteSha"]] pkgdir <- file.path(target_tree, resolution$package) mkdirp(pkgdir) - async_git_download_repo(url, ref = sha, output = pkgdir)$ - then(function() { - "Got" - }) + p <- async_git_download_repo(url, ref = sha, output = pkgdir) + + # submodules? + submodules <- config$get("git-submodules") + if (submodules) { + p <- p$then(function(x) async_update_git_submodules_r(pkgdir, subdir)) + } + + p$then(function() { + "Got" + }) } satisfy_remote_git <- function(resolution, candidate, @@ -161,36 +168,18 @@ git_rx <- function() { ) } -git_auth_url <- function(remote) { - url <- remote$url - auth <- tryCatch(gitcreds_get(url), error = function(err) NULL) - if (is.null(auth)) { - url - } else { - paste0( - remote$protocol, - "://", - auth$username, - ":", - auth$password, - "@", - sub(paste0("^", remote$protocol, "://"), "", remote$url) - ) - } -} - type_git_get_data <- function(remote) { remote + url <- remote$url sha <- NULL dsc <- NULL - auth_url <- git_auth_url(remote) desc_path <- if (is.null(remote$subdir) || remote$subdir == "") { "DESCRIPTION" } else { paste0(remote$subdir, "/", "DESCRIPTION") } - async_git_list_files(auth_url, remote$commitish)$ + async_git_list_files(url, remote$commitish)$ catch(error = function(err) { throw(pkg_error( "Failed to download {.path {desc_path}} from git repo at {.url {remote$url}}." @@ -212,7 +201,7 @@ type_git_get_data <- function(remote) { files$files$hash[desc_idx] })$ then(function(desc_hash) { - async_git_download_file(auth_url, desc_hash, output = NULL)$ + async_git_download_file(url, desc_hash, output = NULL)$ catch(error = function(err) { throw(pkg_error( "Failed to download {.path {desc_path}} from git repo at {.url {remote$url}}." diff --git a/R/type-gitlab.R b/R/type-gitlab.R index 52bd7f56..bf0346e5 100644 --- a/R/type-gitlab.R +++ b/R/type-gitlab.R @@ -1,18 +1,17 @@ parse_remote_gitlab <- function(specs, config, ...) { - pds <- re_match(specs, gitlab_rx()) pds$ref <- pds$.text pds$protocol[pds$protocol == ""] <- "https" pds$host[pds$host == ""] <- "gitlab.com" - pds$path <- paste0("/", pds$username, "/") + pds$path <- paste0("/", pds$projectpath, "/", pds$project) pds$dotgit <- "" pds$commitish[pds$commitish == ""] <- "HEAD" - pds$url <- paste0(pds$protocol, "://", pds$host, pds$path, pds$repo, ".git") + pds$url <- paste0(pds$protocol, "://", pds$host, pds$path, ".git") cn <- setdiff(colnames(pds), c(".match", ".text")) pds <- pds[, cn] pds$type <- "gitlab" - pds$package <- ifelse(nzchar(pds$package), pds$package, pds$repo) + pds$package <- ifelse(nzchar(pds$package), pds$package, pds$project) lapply( seq_len(nrow(pds)), function(i) as.list(pds[i,]) @@ -24,8 +23,8 @@ resolve_remote_gitlab <- function(remote, direct, config, cache, resolve_remote_git(remote, direct, config, cache, dependencies, ...)$ then(function(res) { res$metadata["RemoteHost"] <- remote$host - res$metadata["RemoteRepo"] <- remote$repo - res$metadata["RemoteUsername"] <- remote$username + res$metadata["RemoteRepo"] <- remote$project + res$metadata["RemoteUsername"] <- remote$projectpath res$metadata["RemoteType"] <- "gitlab" if (!is.null(remote$subdir) && remote$subdir != "") { res$metadata["RemoteSubdir"] <- remote$subdir @@ -55,16 +54,31 @@ installedok_remote_gitlab <- function(installed, solution, config, ...) { installedok_remote_git(installed, solution, config, ...) } +# source: https://docs.gitlab.com/ee/user/reserved_names.html#limitations-on-usernames-project-and-group-names +gitlab_slug_rx <- function() { + "[a-zA-Z0-9][-._a-zA-Z0-9]*[a-zA-Z0-9]" +} + +gitlab_project_rx <- function() { + paste0("(?", gitlab_slug_rx(), ")") +} + +gitlab_project_path_rx <- function() { + paste0("(?", gitlab_slug_rx(), "(?:/", gitlab_slug_rx(), ")*)") +} + gitlab_rx <- function() { paste0( "^", ## Optional package name "(?:(?", package_name_rx(), ")=)?", "gitlab::", - "(?:(?[^/]*)://(?[^/]+))?", - github_username_rx(), "/", - github_repo_rx(), - github_subdir_rx(), "?", + ## Optional protocol::host + "(?:(?[^/]*)://(?[^/]+)/)?", + gitlab_project_path_rx(), "/", + gitlab_project_rx(), + ## Optional subdirectory, prefixed with /-, ie project/-/sub/dir + "(?:/-", github_subdir_rx(), ")?", "(?:", github_commitish_rx(), ")?", "$" ) diff --git a/R/utils.R b/R/utils.R index c93f8f74..0aa93755 100644 --- a/R/utils.R +++ b/R/utils.R @@ -319,6 +319,10 @@ new_async_timer <- function(...) { asNamespace("pkgcache")$async_timer$new(...) } +async_delay <- function(...) { + asNamespace("pkgcache")$delay(...) +} + external_process <- function(...) { asNamespace("pkgcache")$external_process(...) } @@ -494,4 +498,8 @@ backtick <- function(x) { collapse <- function(x, ...) { cli::ansi_collapse(x, ...) -} \ No newline at end of file +} + +na_omit <- function(x) { + x[!is.na(x)] +} diff --git a/R/zzz-pkgdepends-config.R b/R/zzz-pkgdepends-config.R index 02275262..dab0c439 100644 --- a/R/zzz-pkgdepends-config.R +++ b/R/zzz-pkgdepends-config.R @@ -123,6 +123,18 @@ pkgdepends_config <- sort_by_name(list( details." ), + # ----------------------------------------------------------------------- + git_submodules = list( + type = "flag", + default = FALSE, + docs = + "Whether or not to update submodules in git repositories. This + affects `git::` and `gitlab::` package sources only. + If the R package is in a subdirectory then only the submodules + within that directory are updated. If a submodule appears in + `.Rbuildignore`, then it is skipped." + ), + # ----------------------------------------------------------------------- include_linkingto = list( type = "flag", diff --git a/inst/WORDLIST b/inst/WORDLIST index 7a471a15..5def40bd 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -38,5 +38,7 @@ prerelease prettyunits rprojroot shorthands +submodule +submodules tibbles uncompress diff --git a/inst/docs/pak-config-docs.rds b/inst/docs/pak-config-docs.rds index fa21c7bb..eff5493c 100644 Binary files a/inst/docs/pak-config-docs.rds and b/inst/docs/pak-config-docs.rds differ diff --git a/inst/docs/pkg-refs.rds b/inst/docs/pkg-refs.rds index b774acf7..7aa6f292 100644 Binary files a/inst/docs/pkg-refs.rds and b/inst/docs/pkg-refs.rds differ diff --git a/man/pkg_config.Rd b/man/pkg_config.Rd index 3ddcd2e1..a81ab8ed 100644 --- a/man/pkg_config.Rd +++ b/man/pkg_config.Rd @@ -54,6 +54,11 @@ supported in the \code{PKG_DEPENDENCIES} environment variable: \code{"TRUE"}, \code{"FALSE"}, \code{"NA"}, or a semicolon separated list of dependency types. See \code{\link[=as_pkg_dependencies]{as_pkg_dependencies()}} for details. +\item \code{git_submodules}: Whether or not to update submodules in git repositories. This +affects \verb{git::} and \verb{gitlab::} package sources only. +If the R package is in a subdirectory then only the submodules +within that directory are updated. If a submodule appears in +\code{.Rbuildignore}, then it is skipped. \item \code{include_linkingto}: Whether to always include \code{LinkingTo} dependencies in the solution of and installation, even if they are needed because the packages are installed from binaries. This is sometimes useful, see e.g. diff --git a/man/pkg_refs.Rd b/man/pkg_refs.Rd index 9a2d65d7..4dffcaf9 100644 --- a/man/pkg_refs.Rd +++ b/man/pkg_refs.Rd @@ -145,6 +145,10 @@ ignored on R versions that are older than the specified one. E.g. \verb{Matrix=?ignore-before-r=4.1.2} will ignore the Matrix package on R versions that are older than 4.1.2. This parameter really only makes sense in the \code{packgename=?ignore} form. +\item \code{ignore-unavailable} is a flag. It can only be specified for soft +dependencies. If specified and the package is not available, it will be +ignored. This parameter really only makes sense in the +\code{packagename=?ignore-unavailable} form. \item \code{source} is a flag parameter. If specified, then a source R package is requested from a CRAN-like repository. For package installations \code{source} always triggers a re-install. In other words, \code{source} implies the @@ -266,25 +270,32 @@ A GitHub remote string can also be used instead of an URL, for example: Packages from a GitLab repository. Full syntax: -\if{html}{\out{
}}\preformatted{[=][github::]/[/][] +\if{html}{\out{
}}\preformatted{[=][github::]/[/-/][] }\if{html}{\out{
}} \itemize{ \item \verb{} is the name of the package. If this is missing, then the name of the repository is used. -\item \verb{} is a GitLab username or group name. -\item \verb{} is the name of the repository. +\item \verb{} is a typically the GitLab username or group name, but +it may contain subgroups. +\item \verb{} is the name of the repository, or the project in GitLab +terminology. \item \verb{} optional subdirectory, if the package is within a -subdirectory in the repository. +subdirectory in the repository. Note that for GitLab, this must come +after a \verb{/-} prefix, to be able to distinguish it from subgroups. \item \verb{} may specify a git branch, tag or (prefix of) a commit hash. } If \verb{} is missing, then the latest commit of the \emph{default} branch is used. +\verb{gitlab::} supports git submodules, see the \code{git-submodules} configuration +entry. + Examples: \if{html}{\out{
}}\preformatted{gitlab::gaborcsardi/cli gitlab::r-hub/filelock@main +gitlab::group/subgroup/subsubgroup/project/-/subdir@ref }\if{html}{\out{
}} } @@ -306,6 +317,9 @@ a git branch, tag or (prefix of) a commit hash: \verb{@}. If \verb{} is missing, then the latest commit of the \emph{default} branch is used. +\verb{git::} supports git submodules, see the \code{git-submodules} configuration +entry. + Examples: \if{html}{\out{
}}\preformatted{git::https://github.com/r-lib/crayon diff --git a/tests/testthat/_snaps/git-protocol.md b/tests/testthat/_snaps/git-protocol.md index 487a6841..95b2d534 100644 --- a/tests/testthat/_snaps/git-protocol.md +++ b/tests/testthat/_snaps/git-protocol.md @@ -3,24 +3,26 @@ Code git_list_refs(fake_git$url("/pak-test.git"))$refs Output - # A data frame: 4 x 2 - ref hash - - 1 HEAD 3f3b0b4ee8a0ff4563073924e5fe069da67a6d8b - 2 refs/heads/main 3f3b0b4ee8a0ff4563073924e5fe069da67a6d8b - 3 refs/heads/subdir cefdc0eebcd7f757efb9a80652fd8aaf1a87508e - 4 refs/tags/v1 cefdc0eebcd7f757efb9a80652fd8aaf1a87508e + # A data frame: 5 x 2 + ref hash + + 1 HEAD 3f3b0b4ee8a0ff4563073924e5fe069da67a6d8b + 2 refs/heads/build-ignore a9ffc55f59e0567ecdc67fb3f0333eca49be8d03 + 3 refs/heads/main 3f3b0b4ee8a0ff4563073924e5fe069da67a6d8b + 4 refs/heads/subdir cefdc0eebcd7f757efb9a80652fd8aaf1a87508e + 5 refs/tags/v1 cefdc0eebcd7f757efb9a80652fd8aaf1a87508e --- Code git_list_refs_v2(fake_git$url("/pak-test.git"), "refs/heads/")$refs Output - # A data frame: 2 x 2 - ref hash - - 1 refs/heads/main 3f3b0b4ee8a0ff4563073924e5fe069da67a6d8b - 2 refs/heads/subdir cefdc0eebcd7f757efb9a80652fd8aaf1a87508e + # A data frame: 3 x 2 + ref hash + + 1 refs/heads/build-ignore a9ffc55f59e0567ecdc67fb3f0333eca49be8d03 + 2 refs/heads/main 3f3b0b4ee8a0ff4563073924e5fe069da67a6d8b + 3 refs/heads/subdir cefdc0eebcd7f757efb9a80652fd8aaf1a87508e # git_list_files @@ -75,6 +77,8 @@ [1] "cefdc0eebcd7f757efb9a80652fd8aaf1a87508e" attr(,"protocol") [1] 2 + attr(,"filter") + [1] TRUE $commit tree @@ -230,13 +234,14 @@ Code git_list_refs_v1(fake_git$url("/pak-test.git"))$refs Output - # A data frame: 4 x 2 - ref hash - - 1 HEAD 3f3b0b4ee8a0ff4563073924e5fe069da67a6d8b - 2 refs/heads/main 3f3b0b4ee8a0ff4563073924e5fe069da67a6d8b - 3 refs/heads/subdir cefdc0eebcd7f757efb9a80652fd8aaf1a87508e - 4 refs/tags/v1 cefdc0eebcd7f757efb9a80652fd8aaf1a87508e + # A data frame: 5 x 2 + ref hash + + 1 HEAD 3f3b0b4ee8a0ff4563073924e5fe069da67a6d8b + 2 refs/heads/build-ignore a9ffc55f59e0567ecdc67fb3f0333eca49be8d03 + 3 refs/heads/main 3f3b0b4ee8a0ff4563073924e5fe069da67a6d8b + 4 refs/heads/subdir cefdc0eebcd7f757efb9a80652fd8aaf1a87508e + 5 refs/tags/v1 cefdc0eebcd7f757efb9a80652fd8aaf1a87508e # git_list_refs_v1_process_1 @@ -661,6 +666,8 @@ [1] "3f3b0b4ee8a0ff4563073924e5fe069da67a6d8b" attr(,"protocol") [1] 2 + attr(,"filter") + [1] TRUE --- @@ -670,6 +677,8 @@ [1] "cefdc0eebcd7f757efb9a80652fd8aaf1a87508e" attr(,"protocol") [1] 2 + attr(,"filter") + [1] TRUE --- @@ -679,6 +688,8 @@ [1] "3f3b0b4ee8a0ff4563073924e5fe069da67a6d8b" attr(,"protocol") [1] 2 + attr(,"filter") + [1] TRUE --- diff --git a/tests/testthat/_snaps/git-submodules.md b/tests/testthat/_snaps/git-submodules.md new file mode 100644 index 00000000..6991ddb7 --- /dev/null +++ b/tests/testthat/_snaps/git-submodules.md @@ -0,0 +1,156 @@ +# parse_submodules + + Code + parse_submodules(sm) + Output + submodule path + 1 dependencies/fast_double_parser dependencies/fast_double_parser + 2 dependencies/fmt dependencies/fmt + 3 dependencies/boost_math dependencies/boost_math + 4 dependencies/eigen dependencies/eigen + url branch + 1 https://github.com/lemire/fast_double_parser/ + 2 https://github.com/fmtlib/fmt/ + 3 https://github.com/boostorg/math + 4 https://gitlab.com/libeigen/eigen + Code + parse_submodules(read_char(sm)) + Output + submodule path + 1 dependencies/fast_double_parser dependencies/fast_double_parser + 2 dependencies/fmt dependencies/fmt + 3 dependencies/boost_math dependencies/boost_math + 4 dependencies/eigen dependencies/eigen + url branch + 1 https://github.com/lemire/fast_double_parser/ + 2 https://github.com/fmtlib/fmt/ + 3 https://github.com/boostorg/math + 4 https://gitlab.com/libeigen/eigen + +--- + + Code + parse_submodules(tmp) + Output + list() + +--- + + Code + parse_submodules(sm2) + Condition + Warning: + Invalid submodule definition, skipping submodule installation + Output + list() + Code + parse_submodules(sm3) + Condition + Warning: + Invalid submodule definition, skipping submodule installation + Output + list() + +# git_download_repo with submodules + + Code + dir(tmp, recursive = TRUE) + Output + [1] "v1/DESCRIPTION" "v1/NAMESPACE" "v1/R/foo.R" "v1/README.md" + [5] "v1/submod/README" "v1/wipe.R" + +--- + + Code + readLines(file.path(output, "submod", "README")) + Output + [1] "A git submodule" "Another commit" + +--- + + Code + dir(tmp, recursive = TRUE) + Output + [1] "v1/DESCRIPTION" "v1/NAMESPACE" "v1/R/foo.R" "v1/README.md" + [5] "v1/submod/README" "v1/wipe.R" + +--- + + Code + readLines(file.path(output, "submod", "README")) + Output + [1] "A git submodule" "Another commit" "Third commit" + +# git_download_repo R package with submodules + + Code + dir(tmp, recursive = TRUE) + Output + [1] "v1/DESCRIPTION" "v1/NAMESPACE" "v1/R/foo.R" "v1/README.md" + [5] "v1/submod/README" "v1/wipe.R" + +--- + + Code + readLines(file.path(output, "submod", "README")) + Output + [1] "A git submodule" "Another commit" + +--- + + Code + dir(tmp, recursive = TRUE) + Output + [1] "v1/DESCRIPTION" "v1/NAMESPACE" "v1/R/foo.R" "v1/README.md" + [5] "v1/submod/README" "v1/wipe.R" + +--- + + Code + readLines(file.path(output, "submod", "README")) + Output + [1] "A git submodule" "Another commit" "Third commit" + +--- + + Code + dir(tmp, recursive = TRUE) + Output + [1] "v1/DESCRIPTION" "v1/NAMESPACE" "v1/R/foo.R" "v1/README.md" + [5] "v1/wipe.R" + +--- + + Code + dir(tmp, recursive = TRUE) + Output + [1] "v1/DESCRIPTION" "v1/NAMESPACE" "v1/R/foo.R" "v1/README.md" + [5] "v1/wipe.R" + +# git_download_repo R package with ignored submodule + + Code + dir(tmp, recursive = TRUE, all.files = TRUE, no.. = TRUE) + Output + [1] "v1/.Rbuildignore" + [2] "v1/.github/actions/parameters/action.yml" + [3] "v1/.github/workflows/inputtest.yml" + [4] "v1/.gitignore" + [5] "v1/.gitmodules" + [6] "v1/DESCRIPTION" + [7] "v1/NAMESPACE" + [8] "v1/R/foo.R" + [9] "v1/README.md" + [10] "v1/wipe.R" + +# directories + + Code + directories("a") + Output + character(0) + Code + directories("a/b/c/d") + Output + [1] "a" "a/b" "a/b/c" + diff --git a/tests/testthat/_snaps/parse-remotes.md b/tests/testthat/_snaps/parse-remotes.md index f0ba8ece..bcda31d0 100644 --- a/tests/testthat/_snaps/parse-remotes.md +++ b/tests/testthat/_snaps/parse-remotes.md @@ -261,10 +261,10 @@ # gitlab Code - parse_pkg_ref("gitlab::user/repo") + parse_pkg_ref("gitlab::user/project") Output $package - [1] "repo" + [1] "project" $protocol [1] "https" @@ -272,11 +272,11 @@ $host [1] "gitlab.com" - $username + $projectpath [1] "user" - $repo - [1] "repo" + $project + [1] "project" $subdir [1] "" @@ -285,16 +285,16 @@ [1] "HEAD" $ref - [1] "gitlab::user/repo" + [1] "gitlab::user/project" $path - [1] "/user/" + [1] "/user/project" $dotgit [1] "" $url - [1] "https://gitlab.com/user/repo.git" + [1] "https://gitlab.com/user/project.git" $type [1] "gitlab" @@ -305,10 +305,10 @@ attr(,"class") [1] "remote_ref_gitlab" "remote_ref" "list" Code - parse_pkg_ref("gitlab::user/repo@ref") + parse_pkg_ref("gitlab::user/project@ref") Output $package - [1] "repo" + [1] "project" $protocol [1] "https" @@ -316,11 +316,11 @@ $host [1] "gitlab.com" - $username + $projectpath [1] "user" - $repo - [1] "repo" + $project + [1] "project" $subdir [1] "" @@ -329,16 +329,16 @@ [1] "ref" $ref - [1] "gitlab::user/repo@ref" + [1] "gitlab::user/project@ref" $path - [1] "/user/" + [1] "/user/project" $dotgit [1] "" $url - [1] "https://gitlab.com/user/repo.git" + [1] "https://gitlab.com/user/project.git" $type [1] "gitlab" @@ -349,10 +349,10 @@ attr(,"class") [1] "remote_ref_gitlab" "remote_ref" "list" Code - parse_pkg_ref("gitlab::user/repo/sub/dir") + parse_pkg_ref("gitlab::user/project/-/sub/dir") Output $package - [1] "repo" + [1] "project" $protocol [1] "https" @@ -360,11 +360,11 @@ $host [1] "gitlab.com" - $username + $projectpath [1] "user" - $repo - [1] "repo" + $project + [1] "project" $subdir [1] "sub/dir" @@ -373,16 +373,16 @@ [1] "HEAD" $ref - [1] "gitlab::user/repo/sub/dir" + [1] "gitlab::user/project/-/sub/dir" $path - [1] "/user/" + [1] "/user/project" $dotgit [1] "" $url - [1] "https://gitlab.com/user/repo.git" + [1] "https://gitlab.com/user/project.git" $type [1] "gitlab" @@ -393,10 +393,10 @@ attr(,"class") [1] "remote_ref_gitlab" "remote_ref" "list" Code - parse_pkg_ref("gitlab::user/repo/sub/dir@ref") + parse_pkg_ref("gitlab::user/project/-/sub/dir@ref") Output $package - [1] "repo" + [1] "project" $protocol [1] "https" @@ -404,11 +404,11 @@ $host [1] "gitlab.com" - $username + $projectpath [1] "user" - $repo - [1] "repo" + $project + [1] "project" $subdir [1] "sub/dir" @@ -417,16 +417,16 @@ [1] "ref" $ref - [1] "gitlab::user/repo/sub/dir@ref" + [1] "gitlab::user/project/-/sub/dir@ref" $path - [1] "/user/" + [1] "/user/project" $dotgit [1] "" $url - [1] "https://gitlab.com/user/repo.git" + [1] "https://gitlab.com/user/project.git" $type [1] "gitlab" @@ -437,7 +437,227 @@ attr(,"class") [1] "remote_ref_gitlab" "remote_ref" "list" Code - parse_pkg_ref("pkg=gitlab::user/repo") + parse_pkg_ref("gitlab::group/subgroup/project") + Output + $package + [1] "project" + + $protocol + [1] "https" + + $host + [1] "gitlab.com" + + $projectpath + [1] "group/subgroup" + + $project + [1] "project" + + $subdir + [1] "" + + $commitish + [1] "HEAD" + + $ref + [1] "gitlab::group/subgroup/project" + + $path + [1] "/group/subgroup/project" + + $dotgit + [1] "" + + $url + [1] "https://gitlab.com/group/subgroup/project.git" + + $type + [1] "gitlab" + + $params + character(0) + + attr(,"class") + [1] "remote_ref_gitlab" "remote_ref" "list" + Code + parse_pkg_ref("gitlab::group/subgroup/project@ref") + Output + $package + [1] "project" + + $protocol + [1] "https" + + $host + [1] "gitlab.com" + + $projectpath + [1] "group/subgroup" + + $project + [1] "project" + + $subdir + [1] "" + + $commitish + [1] "ref" + + $ref + [1] "gitlab::group/subgroup/project@ref" + + $path + [1] "/group/subgroup/project" + + $dotgit + [1] "" + + $url + [1] "https://gitlab.com/group/subgroup/project.git" + + $type + [1] "gitlab" + + $params + character(0) + + attr(,"class") + [1] "remote_ref_gitlab" "remote_ref" "list" + Code + parse_pkg_ref("gitlab::group/subgroup/project/-/sub/dir") + Output + $package + [1] "project" + + $protocol + [1] "https" + + $host + [1] "gitlab.com" + + $projectpath + [1] "group/subgroup" + + $project + [1] "project" + + $subdir + [1] "sub/dir" + + $commitish + [1] "HEAD" + + $ref + [1] "gitlab::group/subgroup/project/-/sub/dir" + + $path + [1] "/group/subgroup/project" + + $dotgit + [1] "" + + $url + [1] "https://gitlab.com/group/subgroup/project.git" + + $type + [1] "gitlab" + + $params + character(0) + + attr(,"class") + [1] "remote_ref_gitlab" "remote_ref" "list" + Code + parse_pkg_ref("gitlab::group/subgroup/project/-/sub/dir@ref") + Output + $package + [1] "project" + + $protocol + [1] "https" + + $host + [1] "gitlab.com" + + $projectpath + [1] "group/subgroup" + + $project + [1] "project" + + $subdir + [1] "sub/dir" + + $commitish + [1] "ref" + + $ref + [1] "gitlab::group/subgroup/project/-/sub/dir@ref" + + $path + [1] "/group/subgroup/project" + + $dotgit + [1] "" + + $url + [1] "https://gitlab.com/group/subgroup/project.git" + + $type + [1] "gitlab" + + $params + character(0) + + attr(,"class") + [1] "remote_ref_gitlab" "remote_ref" "list" + Code + parse_pkg_ref("gitlab::https://acme.co/group/subgroup/project/-/sub/dir@ref") + Output + $package + [1] "project" + + $protocol + [1] "https" + + $host + [1] "acme.co" + + $projectpath + [1] "group/subgroup" + + $project + [1] "project" + + $subdir + [1] "sub/dir" + + $commitish + [1] "ref" + + $ref + [1] "gitlab::https://acme.co/group/subgroup/project/-/sub/dir@ref" + + $path + [1] "/group/subgroup/project" + + $dotgit + [1] "" + + $url + [1] "https://acme.co/group/subgroup/project.git" + + $type + [1] "gitlab" + + $params + character(0) + + attr(,"class") + [1] "remote_ref_gitlab" "remote_ref" "list" + Code + parse_pkg_ref("pkg=gitlab::user/project") Output $package [1] "pkg" @@ -448,11 +668,11 @@ $host [1] "gitlab.com" - $username + $projectpath [1] "user" - $repo - [1] "repo" + $project + [1] "project" $subdir [1] "" @@ -461,16 +681,16 @@ [1] "HEAD" $ref - [1] "pkg=gitlab::user/repo" + [1] "pkg=gitlab::user/project" $path - [1] "/user/" + [1] "/user/project" $dotgit [1] "" $url - [1] "https://gitlab.com/user/repo.git" + [1] "https://gitlab.com/user/project.git" $type [1] "gitlab" @@ -481,7 +701,7 @@ attr(,"class") [1] "remote_ref_gitlab" "remote_ref" "list" Code - parse_pkg_ref("pkg=gitlab::user/repo@ref") + parse_pkg_ref("pkg=gitlab::user/project@ref") Output $package [1] "pkg" @@ -492,11 +712,11 @@ $host [1] "gitlab.com" - $username + $projectpath [1] "user" - $repo - [1] "repo" + $project + [1] "project" $subdir [1] "" @@ -505,16 +725,16 @@ [1] "ref" $ref - [1] "pkg=gitlab::user/repo@ref" + [1] "pkg=gitlab::user/project@ref" $path - [1] "/user/" + [1] "/user/project" $dotgit [1] "" $url - [1] "https://gitlab.com/user/repo.git" + [1] "https://gitlab.com/user/project.git" $type [1] "gitlab" @@ -525,7 +745,7 @@ attr(,"class") [1] "remote_ref_gitlab" "remote_ref" "list" Code - parse_pkg_ref("pkg=gitlab::user/repo/sub/dir") + parse_pkg_ref("pkg=gitlab::user/project/-/sub/dir") Output $package [1] "pkg" @@ -536,11 +756,11 @@ $host [1] "gitlab.com" - $username + $projectpath [1] "user" - $repo - [1] "repo" + $project + [1] "project" $subdir [1] "sub/dir" @@ -549,16 +769,16 @@ [1] "HEAD" $ref - [1] "pkg=gitlab::user/repo/sub/dir" + [1] "pkg=gitlab::user/project/-/sub/dir" $path - [1] "/user/" + [1] "/user/project" $dotgit [1] "" $url - [1] "https://gitlab.com/user/repo.git" + [1] "https://gitlab.com/user/project.git" $type [1] "gitlab" @@ -569,7 +789,7 @@ attr(,"class") [1] "remote_ref_gitlab" "remote_ref" "list" Code - parse_pkg_ref("pkg=gitlab::user/repo/sub/dir@ref") + parse_pkg_ref("pkg=gitlab::user/project/-/sub/dir@ref") Output $package [1] "pkg" @@ -580,11 +800,232 @@ $host [1] "gitlab.com" - $username + $projectpath [1] "user" - $repo - [1] "repo" + $project + [1] "project" + + $subdir + [1] "sub/dir" + + $commitish + [1] "ref" + + $ref + [1] "pkg=gitlab::user/project/-/sub/dir@ref" + + $path + [1] "/user/project" + + $dotgit + [1] "" + + $url + [1] "https://gitlab.com/user/project.git" + + $type + [1] "gitlab" + + $params + character(0) + + attr(,"class") + [1] "remote_ref_gitlab" "remote_ref" "list" + Code + parse_pkg_ref("pkg=gitlab::group/subgroup/project") + Output + $package + [1] "pkg" + + $protocol + [1] "https" + + $host + [1] "gitlab.com" + + $projectpath + [1] "group/subgroup" + + $project + [1] "project" + + $subdir + [1] "" + + $commitish + [1] "HEAD" + + $ref + [1] "pkg=gitlab::group/subgroup/project" + + $path + [1] "/group/subgroup/project" + + $dotgit + [1] "" + + $url + [1] "https://gitlab.com/group/subgroup/project.git" + + $type + [1] "gitlab" + + $params + character(0) + + attr(,"class") + [1] "remote_ref_gitlab" "remote_ref" "list" + Code + parse_pkg_ref("pkg=gitlab::group/subgroup/project@ref") + Output + $package + [1] "pkg" + + $protocol + [1] "https" + + $host + [1] "gitlab.com" + + $projectpath + [1] "group/subgroup" + + $project + [1] "project" + + $subdir + [1] "" + + $commitish + [1] "ref" + + $ref + [1] "pkg=gitlab::group/subgroup/project@ref" + + $path + [1] "/group/subgroup/project" + + $dotgit + [1] "" + + $url + [1] "https://gitlab.com/group/subgroup/project.git" + + $type + [1] "gitlab" + + $params + character(0) + + attr(,"class") + [1] "remote_ref_gitlab" "remote_ref" "list" + Code + parse_pkg_ref("pkg=gitlab::group/subgroup/project/-/sub/dir") + Output + $package + [1] "pkg" + + $protocol + [1] "https" + + $host + [1] "gitlab.com" + + $projectpath + [1] "group/subgroup" + + $project + [1] "project" + + $subdir + [1] "sub/dir" + + $commitish + [1] "HEAD" + + $ref + [1] "pkg=gitlab::group/subgroup/project/-/sub/dir" + + $path + [1] "/group/subgroup/project" + + $dotgit + [1] "" + + $url + [1] "https://gitlab.com/group/subgroup/project.git" + + $type + [1] "gitlab" + + $params + character(0) + + attr(,"class") + [1] "remote_ref_gitlab" "remote_ref" "list" + Code + parse_pkg_ref("pkg=gitlab::group/subgroup/project/-/sub/dir@ref") + Output + $package + [1] "pkg" + + $protocol + [1] "https" + + $host + [1] "gitlab.com" + + $projectpath + [1] "group/subgroup" + + $project + [1] "project" + + $subdir + [1] "sub/dir" + + $commitish + [1] "ref" + + $ref + [1] "pkg=gitlab::group/subgroup/project/-/sub/dir@ref" + + $path + [1] "/group/subgroup/project" + + $dotgit + [1] "" + + $url + [1] "https://gitlab.com/group/subgroup/project.git" + + $type + [1] "gitlab" + + $params + character(0) + + attr(,"class") + [1] "remote_ref_gitlab" "remote_ref" "list" + Code + parse_pkg_ref( + "pkg=gitlab::https://acme.co/group/subgroup/project/-/sub/dir@ref") + Output + $package + [1] "pkg" + + $protocol + [1] "https" + + $host + [1] "acme.co" + + $projectpath + [1] "group/subgroup" + + $project + [1] "project" $subdir [1] "sub/dir" @@ -593,16 +1034,16 @@ [1] "ref" $ref - [1] "pkg=gitlab::user/repo/sub/dir@ref" + [1] "pkg=gitlab::https://acme.co/group/subgroup/project/-/sub/dir@ref" $path - [1] "/user/" + [1] "/group/subgroup/project" $dotgit [1] "" $url - [1] "https://gitlab.com/user/repo.git" + [1] "https://acme.co/group/subgroup/project.git" $type [1] "gitlab" diff --git a/tests/testthat/_snaps/pillar-1.9.0/type-bioc.md b/tests/testthat/_snaps/pillar-1.9.0/type-bioc.md index 245d1323..8a626b8b 100644 --- a/tests/testthat/_snaps/pillar-1.9.0/type-bioc.md +++ b/tests/testthat/_snaps/pillar-1.9.0/type-bioc.md @@ -121,4 +121,7 @@ $sysreqs [1] NA + $os_type + [1] NA + diff --git a/tests/testthat/_snaps/pillar-1.9.0/type-git.md b/tests/testthat/_snaps/pillar-1.9.0/type-git.md index d8db24e0..45eb7175 100644 --- a/tests/testthat/_snaps/pillar-1.9.0/type-git.md +++ b/tests/testthat/_snaps/pillar-1.9.0/type-git.md @@ -150,6 +150,8 @@ [1] "4cc6312883f2842e948f34a816ce8e846f323a6e" attr(,"protocol") [1] 2 + attr(,"filter") + [1] TRUE @@ -166,6 +168,9 @@ $sysreqs [1] "" + $os_type + [1] NA + $cache_status [1] "miss" diff --git a/tests/testthat/_snaps/pkg-dependencies.md b/tests/testthat/_snaps/pkg-dependencies.md index 7f7b76db..db26aad0 100644 --- a/tests/testthat/_snaps/pkg-dependencies.md +++ b/tests/testthat/_snaps/pkg-dependencies.md @@ -23,17 +23,17 @@ Output [1] "build_vignettes" "cache_dir" [3] "cran_mirror" "dependencies" - [5] "goal" "include_linkingto" - [7] "library" "metadata_cache_dir" - [9] "metadata_update_after" "package_cache_dir" - [11] "platforms" "r_versions" - [13] "sysreqs" "sysreqs_db_update" - [15] "sysreqs_db_update_timeout" "sysreqs_dry_run" - [17] "sysreqs_lookup_system" "sysreqs_platform" - [19] "sysreqs_rspm_repo_id" "sysreqs_rspm_url" - [21] "sysreqs_sudo" "sysreqs_update" - [23] "sysreqs_verbose" "use_bioconductor" - [25] "windows_archs" + [5] "git_submodules" "goal" + [7] "include_linkingto" "library" + [9] "metadata_cache_dir" "metadata_update_after" + [11] "package_cache_dir" "platforms" + [13] "r_versions" "sysreqs" + [15] "sysreqs_db_update" "sysreqs_db_update_timeout" + [17] "sysreqs_dry_run" "sysreqs_lookup_system" + [19] "sysreqs_platform" "sysreqs_rspm_repo_id" + [21] "sysreqs_rspm_url" "sysreqs_sudo" + [23] "sysreqs_update" "sysreqs_verbose" + [25] "use_bioconductor" "windows_archs" --- diff --git a/tests/testthat/_snaps/pkg-downloads.md b/tests/testthat/_snaps/pkg-downloads.md index bf1057aa..81a93de1 100644 --- a/tests/testthat/_snaps/pkg-downloads.md +++ b/tests/testthat/_snaps/pkg-downloads.md @@ -22,17 +22,17 @@ Output [1] "build_vignettes" "cache_dir" [3] "cran_mirror" "dependencies" - [5] "goal" "include_linkingto" - [7] "library" "metadata_cache_dir" - [9] "metadata_update_after" "package_cache_dir" - [11] "platforms" "r_versions" - [13] "sysreqs" "sysreqs_db_update" - [15] "sysreqs_db_update_timeout" "sysreqs_dry_run" - [17] "sysreqs_lookup_system" "sysreqs_platform" - [19] "sysreqs_rspm_repo_id" "sysreqs_rspm_url" - [21] "sysreqs_sudo" "sysreqs_update" - [23] "sysreqs_verbose" "use_bioconductor" - [25] "windows_archs" + [5] "git_submodules" "goal" + [7] "include_linkingto" "library" + [9] "metadata_cache_dir" "metadata_update_after" + [11] "package_cache_dir" "platforms" + [13] "r_versions" "sysreqs" + [15] "sysreqs_db_update" "sysreqs_db_update_timeout" + [17] "sysreqs_dry_run" "sysreqs_lookup_system" + [19] "sysreqs_platform" "sysreqs_rspm_repo_id" + [21] "sysreqs_rspm_url" "sysreqs_sudo" + [23] "sysreqs_update" "sysreqs_verbose" + [25] "use_bioconductor" "windows_archs" --- diff --git a/tests/testthat/_snaps/pkg-installation.md b/tests/testthat/_snaps/pkg-installation.md index bcdb76f7..df8e314d 100644 --- a/tests/testthat/_snaps/pkg-installation.md +++ b/tests/testthat/_snaps/pkg-installation.md @@ -23,17 +23,17 @@ Output [1] "build_vignettes" "cache_dir" [3] "cran_mirror" "dependencies" - [5] "goal" "include_linkingto" - [7] "library" "metadata_cache_dir" - [9] "metadata_update_after" "package_cache_dir" - [11] "platforms" "r_versions" - [13] "sysreqs" "sysreqs_db_update" - [15] "sysreqs_db_update_timeout" "sysreqs_dry_run" - [17] "sysreqs_lookup_system" "sysreqs_platform" - [19] "sysreqs_rspm_repo_id" "sysreqs_rspm_url" - [21] "sysreqs_sudo" "sysreqs_update" - [23] "sysreqs_verbose" "use_bioconductor" - [25] "windows_archs" + [5] "git_submodules" "goal" + [7] "include_linkingto" "library" + [9] "metadata_cache_dir" "metadata_update_after" + [11] "package_cache_dir" "platforms" + [13] "r_versions" "sysreqs" + [15] "sysreqs_db_update" "sysreqs_db_update_timeout" + [17] "sysreqs_dry_run" "sysreqs_lookup_system" + [19] "sysreqs_platform" "sysreqs_rspm_repo_id" + [21] "sysreqs_rspm_url" "sysreqs_sudo" + [23] "sysreqs_update" "sysreqs_verbose" + [25] "use_bioconductor" "windows_archs" --- diff --git a/tests/testthat/_snaps/pkgdepends-config.md b/tests/testthat/_snaps/pkgdepends-config.md index 3906a408..de6947b0 100644 --- a/tests/testthat/_snaps/pkgdepends-config.md +++ b/tests/testthat/_snaps/pkgdepends-config.md @@ -91,15 +91,15 @@ Output [1] "build_vignettes" "cache_dir" [3] "cran_mirror" "dependencies" - [5] "goal" "include_linkingto" - [7] "library" "metadata_cache_dir" - [9] "metadata_update_after" "package_cache_dir" - [11] "platforms" "r_versions" - [13] "sysreqs" "sysreqs_db_update" - [15] "sysreqs_db_update_timeout" "sysreqs_dry_run" - [17] "sysreqs_lookup_system" "sysreqs_platform" - [19] "sysreqs_rspm_repo_id" "sysreqs_rspm_url" - [21] "sysreqs_sudo" "sysreqs_update" - [23] "sysreqs_verbose" "use_bioconductor" - [25] "windows_archs" + [5] "git_submodules" "goal" + [7] "include_linkingto" "library" + [9] "metadata_cache_dir" "metadata_update_after" + [11] "package_cache_dir" "platforms" + [13] "r_versions" "sysreqs" + [15] "sysreqs_db_update" "sysreqs_db_update_timeout" + [17] "sysreqs_dry_run" "sysreqs_lookup_system" + [19] "sysreqs_platform" "sysreqs_rspm_repo_id" + [21] "sysreqs_rspm_url" "sysreqs_sudo" + [23] "sysreqs_update" "sysreqs_verbose" + [25] "use_bioconductor" "windows_archs" diff --git a/tests/testthat/_snaps/type-cran.md b/tests/testthat/_snaps/type-cran.md index cda95a0b..0b79f65e 100644 --- a/tests/testthat/_snaps/type-cran.md +++ b/tests/testthat/_snaps/type-cran.md @@ -3,7 +3,7 @@ Code snapshot(res, extra = "all") Output - # A data frame: 1 x 30 + # A data frame: 1 x 31 ref type direct directpkg status package version license 1 pkg1 standard TRUE TRUE OK pkg1 1.0.0 @@ -16,9 +16,9 @@ mirror sources remote error metadata 1 http://127.0.0.1:/ - extra dep_types params sysreqs cache_status - - 1 miss + extra dep_types params sysreqs os_type cache_status + + 1 miss + sources: http://127.0.0.1://src/contrib/pkg1_1.0.0.tar.gz, http://127.0.0.1://src/contrib/Archive/pkg1/pkg1_1.0.0.tar.gz + remote: @@ -35,7 +35,7 @@ Code snapshot(res, extra = "all") Output - # A data frame: 3 x 30 + # A data frame: 3 x 31 ref type direct directpkg status package version license 1 pkg2 standard FALSE FALSE OK pkg2 1.0.0 @@ -56,11 +56,11 @@ 1 http://127.0.0.1:/ 2 http://127.0.0.1:/ 3 http://127.0.0.1:/ - extra dep_types params sysreqs cache_status - - 1 miss - 2 miss - 3 miss + extra dep_types params sysreqs os_type cache_status + + 1 miss + 2 miss + 3 miss + sources: http://127.0.0.1://src/contrib/pkg2_1.0.0.tar.gz, http://127.0.0.1://src/contrib/Archive/pkg2/pkg2_1.0.0.tar.gz http://127.0.0.1://src/contrib/pkg3_1.0.0.tar.gz, http://127.0.0.1://src/contrib/Archive/pkg3/pkg3_1.0.0.tar.gz @@ -87,7 +87,7 @@ Code snapshot(res, extra = "all") Output - # A data frame: 3 x 30 + # A data frame: 3 x 31 ref type direct directpkg status package version license 1 pkg1 standard FALSE FALSE OK pkg1 1.0.0 @@ -108,11 +108,11 @@ 1 http://127.0.0.1:/ 2 http://127.0.0.1:/ 3 http://127.0.0.1:/ - extra dep_types params sysreqs cache_status - - 1 miss - 2 miss - 3 miss + extra dep_types params sysreqs os_type cache_status + + 1 miss + 2 miss + 3 miss + sources: http://127.0.0.1://src/contrib/pkg1_1.0.0.tar.gz, http://127.0.0.1://src/contrib/Archive/pkg1/pkg1_1.0.0.tar.gz http://127.0.0.1://src/contrib/pkg2_1.0.0.tar.gz, http://127.0.0.1://src/contrib/Archive/pkg2/pkg2_1.0.0.tar.gz @@ -139,7 +139,7 @@ Code snapshot(res, extra = "all") Output - # A data frame: 1 x 30 + # A data frame: 1 x 31 ref type direct directpkg status package 1 cran::xxyyzzqwertyqwerty cran TRUE TRUE FAILED xxyyzzqwertyqwerty @@ -155,9 +155,9 @@ remote error metadata extra dep_types params sysreqs 1 - cache_status - - 1 miss + os_type cache_status + + 1 miss + sources: NA + remote: @@ -174,7 +174,7 @@ Code snapshot(res, extra = "all") Output - # A data frame: 2 x 30 + # A data frame: 2 x 31 ref type direct directpkg status package 1 cran::pkg1 cran TRUE TRUE OK pkg1 @@ -195,10 +195,10 @@ 1 2 - sysreqs cache_status - - 1 miss - 2 miss + sysreqs os_type cache_status + + 1 miss + 2 miss + sources: http://127.0.0.1://src/contrib/pkg1_1.0.0.tar.gz, http://127.0.0.1://src/contrib/Archive/pkg1/pkg1_1.0.0.tar.gz NA @@ -220,7 +220,7 @@ Code snapshot(res, extra = "all") Output - # A data frame: 1 x 30 + # A data frame: 1 x 31 ref type direct directpkg status package version license 1 cran::pkg1@current cran TRUE TRUE OK pkg1 1.0.0 @@ -233,9 +233,9 @@ mirror sources remote error metadata 1 http://127.0.0.1:/ - extra dep_types params sysreqs cache_status - - 1 miss + extra dep_types params sysreqs os_type cache_status + + 1 miss + sources: http://127.0.0.1://src/contrib/pkg1_1.0.0.tar.gz, http://127.0.0.1://src/contrib/Archive/pkg1/pkg1_1.0.0.tar.gz + remote: @@ -252,7 +252,7 @@ Code snapshot(res, extra = "all") Output - # A data frame: 2 x 30 + # A data frame: 2 x 31 ref type direct directpkg status package version license 1 pkg1@0.9.0 standard TRUE TRUE OK pkg1 0.9.0 @@ -269,10 +269,10 @@ 1 2 http://127.0.0.1:/ - extra dep_types params sysreqs cache_status - - 1 "" miss - 2 miss + extra dep_types params sysreqs os_type cache_status + + 1 "" miss + 2 miss + sources: http://127.0.0.1://src/contrib/Archive/pkg1/pkg1_0.9.0.tar.gz http://127.0.0.1://src/contrib/pkg1_1.0.0.tar.gz, http://127.0.0.1://src/contrib/Archive/pkg1/pkg1_1.0.0.tar.gz @@ -294,7 +294,7 @@ Code snapshot(res, extra = "all") Output - # A data frame: 1 x 30 + # A data frame: 1 x 31 ref type direct directpkg status package version license 1 pkg1@1.0.0 standard TRUE TRUE OK pkg1 1.0.0 @@ -307,9 +307,9 @@ mirror sources remote error metadata 1 http://127.0.0.1:/ - extra dep_types params sysreqs cache_status - - 1 miss + extra dep_types params sysreqs os_type cache_status + + 1 miss + sources: http://127.0.0.1://src/contrib/pkg1_1.0.0.tar.gz, http://127.0.0.1://src/contrib/Archive/pkg1/pkg1_1.0.0.tar.gz + remote: @@ -326,7 +326,7 @@ Code snapshot(res, extra = "all") Output - # A data frame: 1 x 30 + # A data frame: 1 x 31 ref type direct directpkg status package version license 1 pkg1@>=0.9.0 standard TRUE TRUE FAILED pkg1 @@ -339,9 +339,9 @@ remote error metadata extra dep_types params sysreqs 1 - cache_status - - 1 miss + os_type cache_status + + 1 miss + sources: NA + remote: diff --git a/tests/testthat/_snaps/type-gitlab.md b/tests/testthat/_snaps/type-gitlab.md index 9fe80373..f7847769 100644 --- a/tests/testthat/_snaps/type-gitlab.md +++ b/tests/testthat/_snaps/type-gitlab.md @@ -130,7 +130,7 @@ RemoteUrl "https://gitlab.com/gaborcsardi/feather.git" RemotePkgRef - "gitlab::gaborcsardi/feather/R" + "gitlab::gaborcsardi/feather/-/R" RemoteRef "HEAD" RemoteSha diff --git a/tests/testthat/fixtures/git-repo.tar.gz b/tests/testthat/fixtures/git-repo.tar.gz index 07b1be4f..3f39fcec 100644 Binary files a/tests/testthat/fixtures/git-repo.tar.gz and b/tests/testthat/fixtures/git-repo.tar.gz differ diff --git a/tests/testthat/fixtures/submodules.ini b/tests/testthat/fixtures/submodules.ini new file mode 100644 index 00000000..bfc75124 --- /dev/null +++ b/tests/testthat/fixtures/submodules.ini @@ -0,0 +1,12 @@ +[submodule "dependencies/fast_double_parser"] + path = dependencies/fast_double_parser + url = https://github.com/lemire/fast_double_parser/ +[submodule "dependencies/fmt"] + path = dependencies/fmt + url = https://github.com/fmtlib/fmt/ +[submodule "dependencies/boost_math"] + path = dependencies/boost_math + url = https://github.com/boostorg/math +[submodule "dependencies/eigen"] + path = dependencies/eigen + url = https://gitlab.com/libeigen/eigen diff --git a/tests/testthat/fixtures/submodules2.ini b/tests/testthat/fixtures/submodules2.ini new file mode 100644 index 00000000..be4f8380 --- /dev/null +++ b/tests/testthat/fixtures/submodules2.ini @@ -0,0 +1,11 @@ +[submodule "dependencies/fast_double_parser"] + path = dependencies/fast_double_parser + url = https://github.com/lemire/fast_double_parser/ +[submodule "dependencies/fmt"] + url = https://github.com/fmtlib/fmt/ +[submodule "dependencies/boost_math"] + path = dependencies/boost_math + url = https://github.com/boostorg/math +[submodule "dependencies/eigen"] + path = dependencies/eigen + url = https://gitlab.com/libeigen/eigen diff --git a/tests/testthat/fixtures/submodules3.ini b/tests/testthat/fixtures/submodules3.ini new file mode 100644 index 00000000..d2161445 --- /dev/null +++ b/tests/testthat/fixtures/submodules3.ini @@ -0,0 +1,6 @@ +[submodule "dependencies/fast_double_parser"] + path = dependencies/fast_double_parser +[submodule "dependencies/fmt"] + path = dependencies/fmt +[submodule "dependencies/boost_math"] + path = dependencies/boost_math diff --git a/tests/testthat/helper-install.R b/tests/testthat/helper-install.R index 3f622fd2..e2f6bcb2 100644 --- a/tests/testthat/helper-install.R +++ b/tests/testthat/helper-install.R @@ -115,7 +115,7 @@ make_dummy_worker_process <- function(n_iter = 10, sleep = 1, status = 0) { } make_install_plan <- function(ref, lib = .libPaths()[1]) { - r <- pkg_plan$new(ref, lib = lib) + r <- pkg_plan$new(ref, library = lib) r$resolve() r$solve() r$download_solution() diff --git a/tests/testthat/test-assertions.R b/tests/testthat/test-assertions.R index d311631b..adac0344 100644 --- a/tests/testthat/test-assertions.R +++ b/tests/testthat/test-assertions.R @@ -7,6 +7,7 @@ test_that("is_character", { }) test_that("is_character errors", { + if (is_windows() && getRversion() < "4.0.0") skip("No magick") asciicast::expect_snapshot_r_process( fn <- function(x) assert_that(is_character(x)), fn(1:2), @@ -19,6 +20,7 @@ test_that("is_character errors", { }) test_that("is_character errors, noninteractive", { + if (is_windows() && getRversion() < "4.0.0") skip("No magick") asciicast::expect_snapshot_r_process( interactive = FALSE, fn <- function(x) assert_that(is_character(x)), @@ -57,6 +59,7 @@ test_that("is_string", { }) test_that("is_string errors", { + if (is_windows() && getRversion() < "4.0.0") skip("No magick") asciicast::expect_snapshot_r_process( transform = transform_show_cursor, fn <- function(x) assert_that(is_string(x)), @@ -76,6 +79,7 @@ test_that("is_optional_string", { }) test_that("is_optional_string errors", { + if (is_windows() && getRversion() < "4.0.0") skip("No magick") asciicast::expect_snapshot_r_process( transform = transform_show_cursor, fn <- function(x) assert_that(is_optional_string(x)), @@ -93,6 +97,7 @@ test_that("is_flag", { }) test_that("is_flag errors", { + if (is_windows() && getRversion() < "4.0.0") skip("No magick") asciicast::expect_snapshot_r_process( transform = transform_show_cursor, fn <- function(x) assert_that(is_flag(x)), @@ -110,6 +115,7 @@ test_that("is_path", { }) test_that("is_path errors", { + if (is_windows() && getRversion() < "4.0.0") skip("No magick") asciicast::expect_snapshot_r_process( transform = transform_show_cursor, fn <- function(x) assert_that(is_path(x)), @@ -128,6 +134,7 @@ test_that("is_optional_path", { }) test_that("is_optional path errors", { + if (is_windows() && getRversion() < "4.0.0") skip("No magick") asciicast::expect_snapshot_r_process( transform = transform_show_cursor, fn <- function(x) assert_that(is_optional_path(x)), @@ -145,6 +152,7 @@ test_that("all_named", { }) test_that("all_named errors", { + if (is_windows() && getRversion() < "4.0.0") skip("No magick") asciicast::expect_snapshot_r_process( transform = transform_show_cursor, fn <- function(x) assert_that(all_named(x)), @@ -164,6 +172,7 @@ test_that("is_existing_file", { }) test_that("is_existing_file errors", { + if (is_windows() && getRversion() < "4.0.0") skip("No magick") asciicast::expect_snapshot_r_process( transform = function(x) transform_no_links(transform_show_cursor(x)), fn <- function(x) assert_that(is_existing_file(x)), @@ -181,6 +190,7 @@ test_that("is_platform_list", { }) test_that("is_platform_list errors", { + if (is_windows() && getRversion() < "4.0.0") skip("No magick") asciicast::expect_snapshot_r_process( transform = transform_show_cursor, fn <- function(x) assert_that(is_platform_list(x)), @@ -201,6 +211,7 @@ test_that("is_dependencies", { }) test_that("is_dependencies errors", { + if (is_windows() && getRversion() < "4.0.0") skip("No magick") asciicast::expect_snapshot_r_process( transform = transform_show_cursor, fn <- function(x) assert_that(is_dependencies(x)), @@ -218,6 +229,7 @@ test_that("is_r_version_list", { }) test_that("is_r_version_list errors", { + if (is_windows() && getRversion() < "4.0.0") skip("No magick") asciicast::expect_snapshot_r_process( transform = function(x) transform_show_cursor(transform_no_srcref(x)), fn <- function(x) assert_that(is_r_version_list(x)), @@ -233,6 +245,7 @@ test_that("is_difftime", { }) test_that("is_difftime errors", { + if (is_windows() && getRversion() < "4.0.0") skip("No magick") asciicast::expect_snapshot_r_process( transform = transform_show_cursor, fn <- function(x) assert_that(is_difftime(x)), diff --git a/tests/testthat/test-assertthat.R b/tests/testthat/test-assertthat.R index 3a284181..fd9523ca 100644 --- a/tests/testthat/test-assertthat.R +++ b/tests/testthat/test-assertthat.R @@ -47,6 +47,7 @@ test_that("assertion returns invalid value", { }) test_that("default messages", { + if (is_windows() && getRversion() < "4.0.0") skip("No magick") asciicast::expect_snapshot_r_process( transform = function(x) { transform_no_srcref(transform_no_links(transform_show_cursor(x))) diff --git a/tests/testthat/test-git-submodules.R b/tests/testthat/test-git-submodules.R new file mode 100644 index 00000000..914835ae --- /dev/null +++ b/tests/testthat/test-git-submodules.R @@ -0,0 +1,149 @@ +withr::local_envvar(GITHUB_PAT="FAIL") + +test_that("parse_submodules", { + sm <- test_path("fixtures/submodules.ini") + expect_snapshot({ + parse_submodules(sm) + parse_submodules(read_char(sm)) + }) + + file.create(tmp <- tempfile()) + on.exit(unlink(tmp), add = TRUE) + expect_snapshot({ + parse_submodules(tmp) + }) + + # invalid file + sm2 <- test_path("fixtures/submodules2.ini") + sm3 <- test_path("fixtures/submodules3.ini") + expect_snapshot({ + parse_submodules(sm2) + parse_submodules(sm3) + }) + +}) + +test_that("git_download_repo with submodules", { + skip_on_cran() + if (Sys.which("git") == "") skip("Needs git") + + dir.create(tmp <- tempfile()) + on.exit(unlink(tmp, recursive = TRUE), add = TRUE) + + output <- file.path(tmp, "v1") + git_download_repo( + fake_git$url("/pak-test.git"), + output = output + ) + + # tag + writeLines(c( + "[submodule \"submod\"]", + "\tpath = submod", + paste0("\turl = ", fake_git$url("/submod")), + "\tbranch = v2" + ), file.path(output, ".gitmodules")) + + update_git_submodules(output) + expect_snapshot(dir(tmp, recursive = TRUE)) + expect_snapshot(readLines(file.path(output, "submod", "README"))) + + # HEAD + unlink(file.path(output, "submod"), recursive = TRUE) + writeLines(c( + "[submodule \"submod\"]", + "\tpath = submod", + paste0("\turl = ", fake_git$url("/submod")) + ), file.path(output, ".gitmodules")) + + update_git_submodules(output) + # it will skip existing ones + update_git_submodules(output) + expect_snapshot(dir(tmp, recursive = TRUE)) + expect_snapshot(readLines(file.path(output, "submod", "README"))) +}) + +test_that("git_download_repo R package with submodules", { + skip_on_cran() + if (Sys.which("git") == "") skip("Needs git") + + dir.create(tmp <- tempfile()) + on.exit(unlink(tmp, recursive = TRUE), add = TRUE) + + output <- file.path(tmp, "v1") + git_download_repo( + fake_git$url("/pak-test.git"), + output = output + ) + + # tag + writeLines(c( + "[submodule \"submod\"]", + "\tpath = submod", + paste0("\turl = ", fake_git$url("/submod")), + "\tbranch = v2" + ), file.path(output, ".gitmodules")) + + update_git_submodules_r(output, ".") + expect_snapshot(dir(tmp, recursive = TRUE)) + expect_snapshot(readLines(file.path(output, "submod", "README"))) + + # HEAD + unlink(file.path(output, "submod"), recursive = TRUE) + writeLines(c( + "[submodule \"submod\"]", + "\tpath = submod", + paste0("\turl = ", fake_git$url("/submod")) + ), file.path(output, ".gitmodules")) + + update_git_submodules_r(output, ".") + # it will skip existing ones + update_git_submodules_r(output, ".") + expect_snapshot(dir(tmp, recursive = TRUE)) + expect_snapshot(readLines(file.path(output, "submod", "README"))) + + # no submodule file + unlink(file.path(output, "submod"), recursive = TRUE) + unlink(file.path(output, ".gitmodules")) + update_git_submodules_r(output, ".") + expect_snapshot(dir(tmp, recursive = TRUE)) + + # Empty submodule file + unlink(file.path(output, "submod"), recursive = TRUE) + writeLines(character(), file.path(output, ".gitmodules")) + update_git_submodules_r(output, ".") + expect_snapshot(dir(tmp, recursive = TRUE)) +}) + +test_that("git_download_repo R package with ignored submodule", { + skip_on_cran() + if (Sys.which("git") == "") skip("Needs git") + + dir.create(tmp <- tempfile()) + on.exit(unlink(tmp, recursive = TRUE), add = TRUE) + + output <- file.path(tmp, "v1") + git_download_repo( + fake_git$url("/pak-test.git"), + ref = "build-ignore", + output = output + ) + + update_git_submodules_r(output, ".") + expect_snapshot(dir(tmp, recursive = TRUE, all.files = TRUE, no.. = TRUE)) +}) + +test_that("directories", { + dir.create(tmp <- tempfile()) + on.exit(unlink(tmp, recursive = TRUE), add = TRUE) + + wd <- getwd() + on.exit(setwd(wd), add = TRUE) + setwd(tmp) + + mkdirp("a/b/c/d") + expect_snapshot({ + directories("a") + directories("a/b/c/d") + }) +}) \ No newline at end of file diff --git a/tests/testthat/test-parse-remotes.R b/tests/testthat/test-parse-remotes.R index 5caef05f..0b1e727b 100644 --- a/tests/testthat/test-parse-remotes.R +++ b/tests/testthat/test-parse-remotes.R @@ -300,13 +300,24 @@ test_that("explicit package names", { test_that("gitlab", { expect_snapshot({ - parse_pkg_ref("gitlab::user/repo") - parse_pkg_ref("gitlab::user/repo@ref") - parse_pkg_ref("gitlab::user/repo/sub/dir") - parse_pkg_ref("gitlab::user/repo/sub/dir@ref") - parse_pkg_ref("pkg=gitlab::user/repo") - parse_pkg_ref("pkg=gitlab::user/repo@ref") - parse_pkg_ref("pkg=gitlab::user/repo/sub/dir") - parse_pkg_ref("pkg=gitlab::user/repo/sub/dir@ref") + parse_pkg_ref("gitlab::user/project") + parse_pkg_ref("gitlab::user/project@ref") + parse_pkg_ref("gitlab::user/project/-/sub/dir") + parse_pkg_ref("gitlab::user/project/-/sub/dir@ref") + parse_pkg_ref("gitlab::group/subgroup/project") + parse_pkg_ref("gitlab::group/subgroup/project@ref") + parse_pkg_ref("gitlab::group/subgroup/project/-/sub/dir") + parse_pkg_ref("gitlab::group/subgroup/project/-/sub/dir@ref") + parse_pkg_ref("gitlab::https://acme.co/group/subgroup/project/-/sub/dir@ref") + + parse_pkg_ref("pkg=gitlab::user/project") + parse_pkg_ref("pkg=gitlab::user/project@ref") + parse_pkg_ref("pkg=gitlab::user/project/-/sub/dir") + parse_pkg_ref("pkg=gitlab::user/project/-/sub/dir@ref") + parse_pkg_ref("pkg=gitlab::group/subgroup/project") + parse_pkg_ref("pkg=gitlab::group/subgroup/project@ref") + parse_pkg_ref("pkg=gitlab::group/subgroup/project/-/sub/dir") + parse_pkg_ref("pkg=gitlab::group/subgroup/project/-/sub/dir@ref") + parse_pkg_ref("pkg=gitlab::https://acme.co/group/subgroup/project/-/sub/dir@ref") }) }) diff --git a/tests/testthat/test-type-git.R b/tests/testthat/test-type-git.R index 3b6c9b2b..c3ac71f9 100644 --- a/tests/testthat/test-type-git.R +++ b/tests/testthat/test-type-git.R @@ -167,27 +167,6 @@ test_that("installedok_remote_git", { ) }) -test_that("git_auth_url", { - mockery::stub(git_auth_url, "gitcreds_get", function(...) stop("oops")) - expect_equal( - git_auth_url(list(url = "https://github.com/r-lib/cli.git")), - "https://github.com/r-lib/cli.git" - ) - - mockery::stub( - git_auth_url, - "gitcreds_get", - list(username = "user", password = "secret") - ) - expect_equal( - git_auth_url(list( - protocol = "https", - url = "https://github.com/r-lib/cli.git" - )), - "https://user:secret@github.com/r-lib/cli.git" - ) -}) - test_that("type_git_get_data", { # TODO expect_true(TRUE) diff --git a/tests/testthat/test-type-gitlab.R b/tests/testthat/test-type-gitlab.R index ba4b257e..ccc070c5 100644 --- a/tests/testthat/test-type-gitlab.R +++ b/tests/testthat/test-type-gitlab.R @@ -47,7 +47,7 @@ test_that("resolve", { # subdirectory p <- suppressMessages(new_pkg_installation_proposal( - "gitlab::gaborcsardi/feather/R", + "gitlab::gaborcsardi/feather/-/R", config = list(library = tmp, dependencies = FALSE) )) suppressMessages(p$resolve()) @@ -67,7 +67,7 @@ test_that("download", { # subdirectory p <- suppressMessages(new_pkg_installation_proposal( - "gitlab::gaborcsardi/feather/R", + "gitlab::gaborcsardi/feather/-/R", config = list(library = tmp, dependencies = FALSE) )) suppressMessages(p$resolve()) diff --git a/tools/doc/pak-config-docs.md b/tools/doc/pak-config-docs.md index 0b50888b..e7b9d067 100644 --- a/tools/doc/pak-config-docs.md +++ b/tools/doc/pak-config-docs.md @@ -7,6 +7,9 @@ $cache_dir $cran_mirror [1] "CRAN mirror to use. Defaults to the \\code{repos} option\n(see \\code{\\link[base:options]{base::options()}}), if that's not set then\n\\verb{https://cran.rstudio.com}. See also \\code{\\link[pak:repo_add]{pak::repo_add()}} and\n\\code{\\link[pak:repo_get]{pak::repo_get()}}" +$git_submodules +[1] "Whether or not to update submodules in git repositories. This\naffects \\verb{git::} and \\verb{gitlab::} package sources only.\nIf the R package is in a subdirectory then only the submodules\nwithin that directory are updated. If a submodule appears in\n\\code{.Rbuildignore}, then it is skipped." + $include_linkingto [1] "Whether to always include \\code{LinkingTo} dependencies in the solution\nof and installation, even if they are needed because the packages\nare installed from binaries. This is sometimes useful, see e.g.\n\\url{https://github.com/r-lib/pak/issues/485} for an example use case." diff --git a/tools/doc/pkg-refs.Rmd b/tools/doc/pkg-refs.Rmd index fb81738f..f066873e 100644 --- a/tools/doc/pkg-refs.Rmd +++ b/tools/doc/pkg-refs.Rmd @@ -143,6 +143,10 @@ it is already installed. `Matrix=?ignore-before-r=4.1.2` will ignore the Matrix package on R versions that are older than 4.1.2. This parameter really only makes sense in the `packgename=?ignore` form. +- `ignore-unavailable` is a flag. It can only be specified for soft + dependencies. If specified and the package is not available, it will be + ignored. This parameter really only makes sense in the + `packagename=?ignore-unavailable` form. - `source` is a flag parameter. If specified, then a source R package is requested from a CRAN-like repository. For package installations `source` always triggers a re-install. In other words, `source` implies the @@ -260,24 +264,31 @@ A GitHub remote string can also be used instead of an URL, for example: Packages from a GitLab repository. Full syntax: ``` -[=][github::]/[/][] +[=][github::]/[/-/][] ``` - `` is the name of the package. If this is missing, then the name of the repository is used. -- `` is a GitLab username or group name. -- `` is the name of the repository. +- `` is a typically the GitLab username or group name, but + it may contain subgroups. +- `` is the name of the repository, or the project in GitLab + terminology. - `` optional subdirectory, if the package is within a - subdirectory in the repository. + subdirectory in the repository. Note that for GitLab, this must come + after a `/-` prefix, to be able to distinguish it from subgroups. - `` may specify a git branch, tag or (prefix of) a commit hash. If `` is missing, then the latest commit of the _default_ branch is used. +`gitlab::` supports git submodules, see the `git-submodules` configuration +entry. + Examples: ``` gitlab::gaborcsardi/cli gitlab::r-hub/filelock@main +gitlab::group/subgroup/subsubgroup/project/-/subdir@ref ``` ### Packages in git repositories (`git::`) @@ -298,6 +309,9 @@ Full syntax: If `` is missing, then the latest commit of the _default_ branch is used. +`git::` supports git submodules, see the `git-submodules` configuration +entry. + Examples: ``` git::https://github.com/r-lib/crayon diff --git a/tools/doc/pkg-refs.md b/tools/doc/pkg-refs.md index 90e703e1..c6a9422f 100644 --- a/tools/doc/pkg-refs.md +++ b/tools/doc/pkg-refs.md @@ -135,6 +135,10 @@ ignored on R versions that are older than the specified one. E.g. \verb{Matrix=?ignore-before-r=4.1.2} will ignore the Matrix package on R versions that are older than 4.1.2. This parameter really only makes sense in the \code{packgename=?ignore} form. +\item \code{ignore-unavailable} is a flag. It can only be specified for soft +dependencies. If specified and the package is not available, it will be +ignored. This parameter really only makes sense in the +\code{packagename=?ignore-unavailable} form. \item \code{source} is a flag parameter. If specified, then a source R package is requested from a CRAN-like repository. For package installations \code{source} always triggers a re-install. In other words, \code{source} implies the @@ -256,25 +260,32 @@ A GitHub remote string can also be used instead of an URL, for example: Packages from a GitLab repository. Full syntax: -\if{html}{\out{
}}\preformatted{[=][github::]/[/][] +\if{html}{\out{
}}\preformatted{[=][github::]/[/-/][] }\if{html}{\out{
}} \itemize{ \item \verb{} is the name of the package. If this is missing, then the name of the repository is used. -\item \verb{} is a GitLab username or group name. -\item \verb{} is the name of the repository. +\item \verb{} is a typically the GitLab username or group name, but +it may contain subgroups. +\item \verb{} is the name of the repository, or the project in GitLab +terminology. \item \verb{} optional subdirectory, if the package is within a -subdirectory in the repository. +subdirectory in the repository. Note that for GitLab, this must come +after a \verb{/-} prefix, to be able to distinguish it from subgroups. \item \verb{} may specify a git branch, tag or (prefix of) a commit hash. } If \verb{} is missing, then the latest commit of the \emph{default} branch is used. +\verb{gitlab::} supports git submodules, see the \code{git-submodules} configuration +entry. + Examples: \if{html}{\out{
}}\preformatted{gitlab::gaborcsardi/cli gitlab::r-hub/filelock@main +gitlab::group/subgroup/subsubgroup/project/-/subdir@ref }\if{html}{\out{
}} } @@ -296,6 +307,9 @@ a git branch, tag or (prefix of) a commit hash: \verb{@}. If \verb{} is missing, then the latest commit of the \emph{default} branch is used. +\verb{git::} supports git submodules, see the \code{git-submodules} configuration +entry. + Examples: \if{html}{\out{
}}\preformatted{git::https://github.com/r-lib/crayon diff --git a/tools/doc/resolution-result.md b/tools/doc/resolution-result.md index c0fc2d66..29ba5951 100644 --- a/tools/doc/resolution-result.md +++ b/tools/doc/resolution-result.md @@ -40,8 +40,22 @@ It is a zero length vector for \verb{installed::} refs. \item \code{target}: path where this package should be saved in a CRAN-repository. \item \code{type}: ref type. \item \code{version}: package version. +\item \code{fulltarget}: absolute path to the downloaded file. At most one of +\code{fulltarget} and \code{fulltarget_tree} must exist on the disk. +\item \code{fulltarget_tree}: absolute path to a package tree directory. At most +one of \code{fulltarget} and \code{fulltarget_tree} must exist on the disk. +\item \code{download_status}: \code{"Had"} or \code{"Got"}, depending on whether the file +was obtained from the cache. +\item \code{download_error}: error object for failed downloads. +\item \code{file_size}: Size of the file, or \code{NA}. For \verb{installed::} refs, it is +\code{NA}, and it is also \code{NA} for refs that created \code{fulltarget_tree} +instead of \code{fulltarget}. } +\code{fulltarget}, if it exists, contains a packaged (via \verb{R CMD build}) +source R package. If \code{fulltarget_tree} exists, it is a package tree +directory, that still needs an \verb{R CMD build} call. + Additional columns might be present. They are either used internally or they are experimental. They might be removed or changed at any time.