Add experimental r_session$debug()

NEWS.md

@@ -4,6 +4,9 @@
 * `r_session` now avoids creating `data` and `env` objects in the global
   environment of the subprocess.
 
+* New `$debug()` method for `r_session` to inspect the dumped frames
+  in the subprocess, after an error.
+
 # callr 3.3.0
 
 * callr now sets the `.Last.error` variable for every uncaught callr

R/r-session.R

@@ -134,6 +134,8 @@ r_session <- R6::R6Class(
 
     traceback = function()
       rs_traceback(self, private),
+    debug = function()
+      rs_debug(self, private),
 
     attach = function()
       rs_attach(self, private),
@@ -382,9 +384,76 @@ rs_poll_process <- function(self, private, timeout) {
 }
 
 rs_traceback <- function(self, private) {
+  ## TODO: get rid of magic number 12
   traceback(utils::head(self$run(function() traceback()), -12))
 }
 
+rs_debug <- function(self, private) {
+  hasdump <- self$run(function() {
+    ! is.null(as.environment("tools:callr")$`__callr_data__`$.Last.dump)
+  })
+  if (!hasdump) stop("Can't find dumped frames, nothing to debug")
+
+  help <- function() {
+    cat("Debugging in process ", self$get_pid(),
+        ", press CTRL+C (ESC) to quit. Commands:\n", sep = "")
+    cat("  .where       -- print stack trace\n",
+        "  .inspect <n> -- inspect a frame, 0 resets to .GlobalEnv\n",
+        "  .help        -- print this message\n",
+        "  <cmd>        -- run <cmd> in frame or .GlobalEnv\n\n", sep = "")
+  }
+
+  translate_cmd <- function(cmd) {
+    if (cmd == ".where") {
+      traceback(tb)
+      if (frame) cat("Inspecting frame", frame, "\n")
+      NULL
+
+    } else if (cmd == ".help") {
+      help()
+      NULL
+
+    } else if (grepl("^.inspect ", cmd)) {
+      newframe <- as.integer(strsplit(cmd, " ")[[1]][[2]])
+      if (is.na(newframe)) {
+        message("Cannot parse frame number")
+      } else {
+        frame <<- newframe
+      }
+      NULL
+
+    } else {
+      cmd
+    }
+  }
+
+  help()
+  tb <- self$traceback()
+  frame <- 0L
+
+  while (TRUE) {
+    prompt <- paste0(
+      "\nRS ", self$get_pid(),
+      if (frame) paste0(" (frame ", frame, ")"), " > ")
+    cmd <- rs__attach_get_input(prompt)
+    cmd2 <- translate_cmd(cmd)
+    if (is.null(cmd2)) next
+
+    update_history(cmd)
+
+    ret <- self$run_with_output(function(cmd, frame) {
+      dump <- as.environment("tools:callr")$`__callr_data__`$.Last.dump
+      envir <- if (!frame) .GlobalEnv else dump[[frame + 12L]]
+      eval(parse(text = cmd), envir = envir)
+    }, list(cmd = cmd, frame = frame))
+    cat(ret$stdout)
+    cat(ret$stderr)
+    if (!is.null(ret$error)) print(ret$error)
+    print(ret$result)
+  }
+  invisible()
+}
+
 rs_attach <- function(self, private) {
   out <- self$get_output_connection()
   err <- self$get_error_connection()

R/script.R

@@ -6,9 +6,16 @@ make_vanilla_script_expr <- function(expr_file, res, error,
   ## This will inserted into the main script
   err <- if (error == "error") {
     substitute({
+      callr_data <- as.environment("tools:callr")$`__callr_data__`
+      err <- callr_data$err
+
       # TODO: get rid of magic number 9
       capture.output(assign(".Traceback", traceback(9), envir = baseenv()))
 
+      dump.frames("__callr_dump__")
+      assign(".Last.dump", .GlobalEnv$`__callr_dump__`, envir = callr_data)
+      rm("__callr_dump__", envir = .GlobalEnv)
+
       # To find the frame of the evaluated function, we search for
       # do.call in the stack, and then skip one more frame, the other
       # do.call. This method only must change if the eval code changes,
@@ -22,7 +29,6 @@ make_vanilla_script_expr <- function(expr_file, res, error,
       if (!is.na(dcframe)) e$`_ignore` <- list(c(1, dcframe + 1L))
       e$`_pid` <- Sys.getpid()
       e$`_timestamp` <- Sys.time()
-      err <- as.environment("tools:callr")$`__callr_data__`$err
       e <- err$add_trace_back(e)
       saveRDS(list("error", e), file = paste0(`__res__`, ".error")) },
       list(`__res__` = res)