diff --git a/R/install-plan.R b/R/install-plan.R index 137109df..fa5d104d 100644 --- a/R/install-plan.R +++ b/R/install-plan.R @@ -236,7 +236,6 @@ handle_event <- function(state, evidx) { worker <- state$workers[[evidx]] state$workers[evidx] <- list(NULL) - ## Post-process, this will throw on error if (is.function(proc$get_result)) proc$get_result() ## Cut stdout to lines @@ -690,6 +689,7 @@ stop_task_build <- function(state, worker) { version <- state$plan$version[pkgidx] time <- Sys.time() - state$plan$build_time[[pkgidx]] ptime <- format_time$pretty_sec(as.numeric(time, units = "secs")) + prms <- state$plan$params[[pkgidx]] if (success) { alert("success", paste0( @@ -699,7 +699,14 @@ stop_task_build <- function(state, worker) { ## Need to save the name of the built package state$plan$file[pkgidx] <- worker$process$get_built_file() } else { - alert("danger", "Failed to build {.pkg {pkg}} {.version {version}}") + ignore_error <- is_true_param(prms, "ignore-build-errors") + alert( + if (ignore_error) "warning" else "danger", + paste0( + "Failed to build {.pkg {pkg}} {.version {version}}", + if (isTRUE(state$config$show_time)) " {.timestamp {ptime}}" + ) + ) } update_progress_bar(state, 1L) @@ -709,7 +716,14 @@ stop_task_build <- function(state, worker) { state$plan$build_stdout[[pkgidx]] <- worker$stdout state$plan$worker_id[[pkgidx]] <- NA_character_ - if (!success) { + if (success) { + # do nothing + } else if (ignore_error) { + # upstream will probably fail as well, but march on, neverthelesss + state$plan$install_done[[pkgidx]] <- TRUE + ## Need to remove from the dependency list + state$plan$deps_left <- lapply(state$plan$deps_left, setdiff, pkg) + } else { throw(pkg_error( "Failed to build source package {.pkg {pkg}}.", .data = list( @@ -722,8 +736,7 @@ stop_task_build <- function(state, worker) { )) } - prms <- state$plan$params[[pkgidx]] - if (!is.null(state$cache) && !is_true_param(prms, "nocache")) { + if (success && !is.null(state$cache) && !is_true_param(prms, "nocache")) { ptfm <- current_r_platform() rv <- current_r_version() target <- paste0(state$plan$target[pkgidx], "-", ptfm, "-", rv) diff --git a/R/parse-remotes.R b/R/parse-remotes.R index 39a28528..2e3142ee 100644 --- a/R/parse-remotes.R +++ b/R/parse-remotes.R @@ -272,8 +272,8 @@ add_ref_params <- function(res, params) { res } -known_query_params <- c("ignore", "ignore-before-r", "nocache", - "reinstall", "source") +known_query_params <- c("ignore", "ignore-before-r", "ignore-build-errors", + "nocache", "reinstall", "source") parse_query <- function(ref) { query <- sub("^[^?]*(\\?|$)", "", ref) diff --git a/tests/testthat/_snaps/install-plan.md b/tests/testthat/_snaps/install-plan.md index ffb8d589..0af15442 100644 --- a/tests/testthat/_snaps/install-plan.md +++ b/tests/testthat/_snaps/install-plan.md @@ -59,3 +59,35 @@ character(0) +# ignore-build-errors parameter + + Code + suppressMessages(inst$solve()) + suppressMessages(inst$download()) + inst$install() + Message + i Packaging badbuild 1.0.0 + v Packaged badbuild 1.0.0 + i Building badbuild 1.0.0 + x Failed to build badbuild 1.0.0 + Condition + Error: + ! Failed to build source package badbuild. + +--- + + Code + suppressMessages(inst$solve()) + suppressMessages(inst$download()) + inst$install() + Message + i Packaging badbuild 1.0.0 + v Packaged badbuild 1.0.0 + i Building badbuild 1.0.0 + ! Failed to build badbuild 1.0.0 + i Packaging goodbuild 1.0.0 + v Packaged goodbuild 1.0.0 + i Building goodbuild 1.0.0 + ! Failed to build goodbuild 1.0.0 + v Summary: 2 new + diff --git a/tests/testthat/fixtures/packages/badbuild/DESCRIPTION b/tests/testthat/fixtures/packages/badbuild/DESCRIPTION new file mode 100644 index 00000000..d5f983b8 --- /dev/null +++ b/tests/testthat/fixtures/packages/badbuild/DESCRIPTION @@ -0,0 +1,9 @@ +Package: badbuild +Title: Title +Version: 1.0.0 +Author: Gábor Csárdi +Maintainer: Gábor Csárdi +Description: Test package. +License: MIT + file LICENSE +LazyData: true +Encoding: UTF-8 diff --git a/tests/testthat/fixtures/packages/badbuild/NAMESPACE b/tests/testthat/fixtures/packages/badbuild/NAMESPACE new file mode 100644 index 00000000..e69de29b diff --git a/tests/testthat/fixtures/packages/badbuild/R/foo.R b/tests/testthat/fixtures/packages/badbuild/R/foo.R new file mode 100644 index 00000000..2e32b340 --- /dev/null +++ b/tests/testthat/fixtures/packages/badbuild/R/foo.R @@ -0,0 +1,2 @@ +This is an error, sorry! +fun <- function() NULL diff --git a/tests/testthat/fixtures/packages/goodbuild/DESCRIPTION b/tests/testthat/fixtures/packages/goodbuild/DESCRIPTION new file mode 100644 index 00000000..257e905b --- /dev/null +++ b/tests/testthat/fixtures/packages/goodbuild/DESCRIPTION @@ -0,0 +1,11 @@ +Package: goodbuild +Title: Title +Version: 1.0.0 +Author: Gábor Csárdi +Maintainer: Gábor Csárdi +Description: Test package. +License: MIT + file LICENSE +LazyData: true +Imports: + badbuild +Encoding: UTF-8 diff --git a/tests/testthat/fixtures/packages/goodbuild/NAMESPACE b/tests/testthat/fixtures/packages/goodbuild/NAMESPACE new file mode 100644 index 00000000..e69de29b diff --git a/tests/testthat/fixtures/packages/goodbuild/R/foo.R b/tests/testthat/fixtures/packages/goodbuild/R/foo.R new file mode 100644 index 00000000..425b6487 --- /dev/null +++ b/tests/testthat/fixtures/packages/goodbuild/R/foo.R @@ -0,0 +1 @@ +fun <- function() NULL diff --git a/tests/testthat/test-install-plan.R b/tests/testthat/test-install-plan.R index 2987fd7b..166379ae 100644 --- a/tests/testthat/test-install-plan.R +++ b/tests/testthat/test-install-plan.R @@ -124,6 +124,34 @@ test_that("add_recursive_dependencies", { expect_snapshot(add_recursive_dependencies(plan)$dependencies) }) +test_that("ignore-build-errors parameter", { + setup_fake_apps() + local_cli_config() + dir.create(tmplib <- tempfile()) + on.exit(rimraf(tmplib), add = TRUE) + pkgdir1 <- test_path("fixtures", "packages", "badbuild") + pkgdir2 <- test_path("fixtures", "packages", "goodbuild") + inst <- new_pkg_installation_proposal( + paste0("local::", c(pkgdir1, pkgdir2), "?nocache"), + config = list(library = tmplib, platforms = "source") + ) + expect_snapshot({ + suppressMessages(inst$solve()) + suppressMessages(inst$download()) + inst$install() + }, error = TRUE) + + inst <- new_pkg_installation_proposal( + paste0("local::", c(pkgdir1, pkgdir2), "?nocache&ignore-build-errors"), + config = list(library = tmplib, platforms = "source") + ) + expect_snapshot({ + suppressMessages(inst$solve()) + suppressMessages(inst$download()) + inst$install() + }) +}) + test_that("install package from GH", { setup_fake_apps() setup_fake_gh_app()