Skip to content

capture_all_outputs should re-emit output when an error occurs #102

@martinmodrak

Description

@martinmodrak

Currently, when an error occurs, we may loose outputs/messages etc..

Currently failing tests::

 test_that("capture_all_outputs re-emits on error", {
  expect_output({
    try(capture_all_outputs({
      cat("Test-output\n")
      stop("Special Error")
    }))
  },
  "Test-output"
  )

  expect_message({
    try(capture_all_outputs({
      message("Test-MSG\n")
      stop("Special Error")
    }))
  },
  "Test-MSG"
  )

  expect_warning({
    try(capture_all_outputs({
      warning("Test-WARN\n")
      stop("Special Error")
    }))
  },
  "Test-WARN"
  )

  # Error is not muffled
  expect_output({
    tryCatch(capture_all_outputs({
      cat("Test-output")
      stop("My special test error")
    }), error = function(e) {
      cat("special error encountered")
    })
  },
  "special error encountered"
  )
})

Attempted rewrite that didn't quite work

capture_all_outputs <- function(expr) {
  logs <- list(message = list(), warning = list())
  output_file <- tempfile()
  output_connection <- file(output_file, open = "w")

  add_log <- function(type, message) {
    new_l <- logs
    new_l[[type]][[length(new_l[[type]]) + 1]]  <- message
    logs <<- new_l
  }
  reemit_logs <- function() {
    #close(output_connection)
    output <- readLines(output_file, warn = FALSE)
    cat(output, sep = "\n")
    for(m in seq_along(logs$message)) {
      message(logs$message[[m]], appendLF = FALSE)
    }
    for(w in seq_along(logs$warning)) {
      warning(logs$warning[[w]])
    }
  }

  withCallingHandlers(
    capture.output({
      previous_try_outfile <- getOption("try.outFile")
      options(try.outFile = stdout())
      res <- tryCatch(
        expr,
        finally = {
          options(try.outFile = previous_try_outfile)
        })
      }, type = "output", file = output_connection),
  warning=function(w) {
    add_log("warning", conditionMessage(w))
    invokeRestart("muffleWarning")
  }, message = function(m) {
    add_log("message", conditionMessage(m))
    invokeRestart("muffleMessage")
  }, error = function(e) {
    # Re-emit what was captured so-far to provide context for the error
    reemit_logs()
  }
  )


  if(isOpen(output_connection)) {
    close(output_connection)
  }

  output <- readLines(output_file)

  list(result = res, messages = do.call(c, logs$message), warnings = do.call(c, logs$warning), output = output)
}

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions