Redirect stderr to stdout in subprocesses

This creates a better output. Also add tests for installing binaries.
r-lib · Oct 18, 2022 · 0669f0f · 0669f0f
1 parent cfceae3
commit 0669f0f
Show file tree

Hide file tree

Showing 20 changed files with 332 additions and 104 deletions.
diff --git a/R/files.R b/R/files.R
@@ -8,27 +8,3 @@ mkdirp <- function(dir, msg = NULL) {
   }
   invisible(s)
 }
-
-file_get_time <- function(path) {
-  file.info(path)$mtime
-}
-
-file_set_time <- function(path, time = Sys.time()) {
-  assert_that(
-    is_character(path),
-    inherits(time, "POSIXct"))
-  vlapply(path, Sys.setFileTime, time = time)
-}
-
-## file.copy is buggy when to is a vector
-
-file_copy_with_time <- function(from, to) {
-  mkdirp(dirname(to))
-  if (length(to) > 1) {
-    mapply(file.copy, from, to,
-           MoreArgs = list(overwrite =  TRUE, copy.date = TRUE),
-           USE.NAMES = FALSE)
-  } else {
-    file.copy(from, to, overwrite = TRUE, copy.date = TRUE)
-  }
-}
diff --git a/R/git-auth.R b/R/git-auth.R
@@ -1,4 +1,6 @@
 
+# nocov start
+
 gitcreds_get <- NULL
 gitcreds_set <- NULL
 gitcreds_delete <- NULL
@@ -812,3 +814,5 @@ read_file <- function(path, ...) {
 
 environment()
 })
+
+# nocov end
diff --git a/R/install-binary.R b/R/install-binary.R
@@ -11,22 +11,19 @@ install_binary <- function(filename, lib = .libPaths()[[1L]],
     is.null(quiet) || is_flag(quiet))
 
   stdout <- ""
-  stderr <- ""
 
   px <- make_install_process(filename, lib = lib, metadata = metadata)
 
   repeat {
     px$poll_io(100)
     stdout <- paste0(stdout, px$read_output())
-    stderr <- paste0(stderr, px$read_error())
-    if (!px$is_alive() &&
-        !px$is_incomplete_output() && !px$is_incomplete_error()) {
+    if (!px$is_alive() && !px$is_incomplete_output()) {
       break
     }
   }
 
   if (px$get_exit_status() != 0) {
-    stop("Package installation failed\n", stderr)
+    stop("Package installation failed\n", stdout)
   }
 
   cli_alert_success(paste0("Installed ", filename))

diff --git a/R/install-plan.R b/R/install-plan.R
@@ -168,17 +168,14 @@ make_start_state <- function(plan, config) {
     package_time = I(rep_list(nrow(plan), as.POSIXct(NA))),
     package_error = I(rep_list(nrow(plan), list())),
     package_stdout = I(rep_list(nrow(plan), character())),
-    package_stderr = I(rep_list(nrow(plan), character())),
     build_done = (plan$type %in% c("deps", "installed")) | plan$binary,
     build_time = I(rep_list(nrow(plan), as.POSIXct(NA))),
     build_error = I(rep_list(nrow(plan), list())),
     build_stdout = I(rep_list(nrow(plan), character())),
-    build_stderr = I(rep_list(nrow(plan), character())),
     install_done = plan$type %in% c("deps", "installed"),
     install_time = I(rep_list(nrow(plan), as.POSIXct(NA))),
     install_error = I(rep_list(nrow(plan), list())),
     install_stdout = I(rep_list(nrow(plan), character())),
-    install_stderr = I(rep_list(nrow(plan), character())),
     worker_id = NA_character_
   )
   plan <- cbind(plan, install_cols)
@@ -221,22 +218,17 @@ handle_events <- function(state, events) {
 handle_event <- function(state, evidx) {
   proc <- state$workers[[evidx]]$process
 
-  ## Read out stdout and stderr. If process is done, then read out all
+  ## Read out stdout. If process is done, then read out all
   if (proc$is_alive()) {
     state$workers[[evidx]]$stdout <-
       c(state$workers[[evidx]]$stdout, out <- proc$read_output(n = 10000))
-    state$workers[[evidx]]$stderr <-
-      c(state$workers[[evidx]]$stderr, err <- proc$read_error(n = 10000))
   } else {
     state$workers[[evidx]]$stdout <-
       c(state$workers[[evidx]]$stdout, out <- proc$read_all_output())
-    state$workers[[evidx]]$stderr <-
-      c(state$workers[[evidx]]$stderr, err <- proc$read_all_error())
   }
 
   ## If there is still output, then wait a bit more
-  if (proc$is_alive() ||
-      proc$is_incomplete_output() || proc$is_incomplete_error()) {
+  if (proc$is_alive() || proc$is_incomplete_output()) {
     return(state)
   }
 
@@ -247,9 +239,8 @@ handle_event <- function(state, evidx) {
   ## Post-process, this will throw on error
   if (is.function(proc$get_result)) proc$get_result()
 
-  ## Cut stdout and stderr to lines
+  ## Cut stdout to lines
   worker$stdout <- cut_into_lines(worker$stdout)
-  worker$stderr <- cut_into_lines(worker$stderr)
 
   ## Record what was done
   stop_task(state, worker)
@@ -436,7 +427,7 @@ start_task_package_uncompress <- function(state, task) {
   task$args$phase <- "uncompress"
   px <- make_uncompress_process(path, task$args$tree_dir)
   worker <- list(id = get_worker_id(), task = task, process = px,
-                 stdout = character(), stderr = character())
+                 stdout = character())
   state$workers <- c(
     state$workers, structure(list(worker), names = worker$id))
   state$plan$worker_id[pkgidx] <- worker$id
@@ -465,7 +456,7 @@ start_task_package_build <- function(state, task) {
                            needscompilation, binary = FALSE,
                            cmd_args = NULL)
   worker <- list(id = get_worker_id(), task = task, process = px,
-                 stdout = character(), stderr = character())
+                 stdout = character())
   state$workers <- c(
     state$workers, structure(list(worker), names = worker$id))
   state$plan$worker_id[pkgidx] <- worker$id
@@ -496,7 +487,7 @@ start_task_build <- function(state, task) {
   px <- make_build_process(path, pkg, tmp_dir, lib, vignettes, needscompilation,
                            binary = TRUE, cmd_args = cmd_args)
   worker <- list(id = get_worker_id(), task = task, process = px,
-                 stdout = character(), stderr = character())
+                 stdout = character())
   state$workers <- c(
     state$workers, structure(list(worker), names = worker$id))
   state$plan$worker_id[pkgidx] <- worker$id
@@ -517,7 +508,7 @@ start_task_install <- function(state, task) {
   px <- make_install_process(filename, lib = lib, metadata = metadata)
   worker <- list(
     id = get_worker_id(), task = task, process = px,
-    stdout = character(), stderr = character())
+    stdout = character())
 
   state$workers <- c(
     state$workers, structure(list(worker), names = worker$id))
@@ -565,7 +556,6 @@ stop_task_package_uncompress <- function(state, worker) {
     state$plan$package_time[[pkgidx]] <- time
     state$plan$package_error[[pkgidx]] <- ! success
     state$plan$package_stdout[[pkgidx]] <- worker$stdout
-    state$plan$package_stderr[[pkgidx]] <- worker$stderr
     state$plan$worker_id[[pkgidx]] <- NA_character_
 
     throw(new_pkg_uncompress_error(
@@ -574,8 +564,7 @@ stop_task_package_uncompress <- function(state, worker) {
         package = pkg,
         version = version,
         time = time,
-        stdout = worker$stdout,
-        stderr = worker$stderr
+        stdout = worker$stdout
       )
     ))
   }
@@ -608,20 +597,13 @@ stop_task_package_build <- function(state, worker) {
     } else {
       alert("info", "Standard output is empty")
     }
-    if (!identical(worker$stderr, "")) {
-      cli::cli_h1("Standard error")
-      cli::cli_verbatim(worker$stdout)
-    } else {
-      alert("info", "Standard error is empty")
-    }
   }
   update_progress_bar(state, 1L)
 
   state$plan$package_done[[pkgidx]] <- TRUE
   state$plan$package_time[[pkgidx]] <- time
   state$plan$package_error[[pkgidx]] <- ! success
   state$plan$package_stdout[[pkgidx]] <- worker$stdout
-  state$plan$package_stderr[[pkgidx]] <- worker$stderr
   state$plan$worker_id[[pkgidx]] <- NA_character_
 
   if (!success) {
@@ -632,7 +614,6 @@ stop_task_package_build <- function(state, worker) {
         package = pkg,
         version = version,
         stdout = worker$stdout,
-        stderr = worker$stderr,
         time = time
       )
     ))
@@ -685,7 +666,6 @@ stop_task_build <- function(state, worker) {
   state$plan$build_time[[pkgidx]] <- time
   state$plan$build_error[[pkgidx]] <- ! success
   state$plan$build_stdout[[pkgidx]] <- worker$stdout
-  state$plan$build_stderr[[pkgidx]] <- worker$stderr
   state$plan$worker_id[[pkgidx]] <- NA_character_
 
   if (!success) {
@@ -695,7 +675,6 @@ stop_task_build <- function(state, worker) {
         package = pkg,
         version = version,
         stdout = worker$stdout,
-        stderr = worker$stderr,          # empty, but anyway...
         time = time
       )
     ))
@@ -777,7 +756,6 @@ stop_task_install <- function(state, worker) {
   state$plan$install_time[[pkgidx]] <- time
   state$plan$install_error[[pkgidx]] <- ! success
   state$plan$install_stdout[[pkgidx]] <- worker$stdout
-  state$plan$install_stderr[[pkgidx]] <- worker$stderr
   state$plan$worker_id[[pkgidx]] <- NA_character_
 
   if (!success) {

diff --git a/R/install-tar.R b/R/install-tar.R
@@ -21,7 +21,7 @@
 
 make_untar_process <- function(tarfile, files = NULL, exdir = ".",
                                restore_times = TRUE, post_process = NULL,
-                               stdout = "|", stderr = "|", ...) {
+                               stdout = "|", stderr = "2>&1", ...) {
   internal <- need_internal_tar()
   if (internal) {
     r_untar_process$new(tarfile, files, exdir, restore_times,
@@ -106,7 +106,7 @@ external_untar_process <- R6::R6Class(
       restore_times = TRUE,
       tar = Sys.getenv("TAR", "tar"),
       stdout = "|",
-      stderr = "|",
+      stderr = "2>&1",
       post_process = NULL,
       ...) {
 
@@ -167,7 +167,7 @@ r_untar_process <- R6::R6Class(
 
     initialize = function(tarfile, files = NULL, exdir = ".",
                           restore_times = TRUE, post_process = NULL,
-                          stdout = "|", stderr = "|", ...) {
+                          stdout = "|", stderr = "2>&1", ...) {
       options <- list(
         tarfile = normalizePath(tarfile),
         files = files,
@@ -300,22 +300,23 @@ run_uncompress_process <- function(archive, exdir = ".", ...) {
     ))
   }
 
+  stdout <- tempfile()
   if (type == "zip") {
     external_process(
       make_unzip_process,
       zipfile = archive,
       exdir = exdir,
-      stdout = tempfile(),
-      stderr = tempfile()
-      )
+      stdout = stdout,
+      stderr = stdout
+    )
 
   } else {
     external_process(
       make_untar_process,
       tarfile = archive,
       exdir = exdir,
-      stdout = tempfile(),
-      stderr = tempfile()
+      stdout = stdout,
+      stderr = stdout
     )
   }
 }
diff --git a/R/install-utils.R b/R/install-utils.R
@@ -59,10 +59,6 @@ format.package_uncompress_error <- function(x, ...) {
     stdout <- last_stdout_lines(x$data$stdout, "", prefix = "O> ")[-(1:2)]
     out <- c(out, "", "Standard output:", stdout)
   }
-  if (!is.null(x$data$stderr)) {
-    stderr <- last_stdout_lines(x$data$stderr, "", prefix = "E> ")[-(1:2)]
-    out <- c(out, "", "Standard error:", stderr)
-  }
   out
 }
 

diff --git a/R/install-zip.R b/R/install-zip.R
@@ -3,7 +3,7 @@
 
 make_unzip_process <- function(zipfile, exdir = ".",
                                post_process = NULL, stdout = "|",
-                               stderr = "|", ...) {
+                               stderr = "2>&1", ...) {
   up <- unzip_process()
   up$new(zipfile, exdir = exdir, post_process = post_process,
          stdout = stdout, stderr = stderr, ...)