branch: externals/ess commit 47f86dbe093f84358ffc0bc875e10a65d2556368 Merge: cbebb1f655 9b5f800026 Author: Lionel Henry <lionel....@gmail.com> Commit: Lionel Henry <lionel....@gmail.com>
Merge branch 'ess-command-propagate-error' --- doc/newfeat.texi | 2 ++ etc/ESSR.rds | Bin 15250 -> 79396 bytes etc/ESSR/R/.basic.R | 15 +++++++++++--- etc/ESSR/R/.load.R | 3 +++ lisp/ess-inf.el | 55 ++++++++++++++++++++++++++++++++++++---------------- lisp/ess-r-mode.el | 23 +++++++++++++++------- test/ess-test-r.el | 20 ++++++++++++++++++- 7 files changed, 90 insertions(+), 28 deletions(-) diff --git a/doc/newfeat.texi b/doc/newfeat.texi index e483d01d40..4ee3961aad 100644 --- a/doc/newfeat.texi +++ b/doc/newfeat.texi @@ -4,6 +4,8 @@ Changes and New Features in 19.04 (unreleased): @itemize @bullet +@item ESS[R]: Background commands now propagate errors to Emacs. + @item ESS[R]: Background commands can now be disabled by process instad of globally. For instance when a process has failed to initialize properly, background evals are disabled for that particular process to avoid diff --git a/etc/ESSR.rds b/etc/ESSR.rds index b4c4839f88..5203244f23 100644 Binary files a/etc/ESSR.rds and b/etc/ESSR.rds differ diff --git a/etc/ESSR/R/.basic.R b/etc/ESSR/R/.basic.R index 6eaca404e0..b7a41a57e6 100644 --- a/etc/ESSR/R/.basic.R +++ b/etc/ESSR/R/.basic.R @@ -235,9 +235,18 @@ if(.ess.Rversion < "1.8") invokeRestart("browser") } - out <- withCallingHandlers( - interrupt = restart, - withVisible(expr) + ## Should be an exiting handler to be able to catch + ## stack overflow errors + rethrow <- function(cnd) { + stop('ESSR::ERROR \"', conditionMessage(cnd), '\"') + } + + out <- tryCatch( + error = rethrow, + withCallingHandlers( + interrupt = restart, + withVisible(expr) + ) ) ## Print result manually because we can't rely on auto-print diff --git a/etc/ESSR/R/.load.R b/etc/ESSR/R/.load.R index 2bc6715d77..9b38af2b81 100644 --- a/etc/ESSR/R/.load.R +++ b/etc/ESSR/R/.load.R @@ -11,6 +11,9 @@ ## load .base.R and all other files into ESSR environment; then attach ESSR .ess.ESSR.load <- function(dir) { + if (nzchar(Sys.getenv("ESSR_TEST_LOAD_ERROR"))) + stop('Loading failed with a nice message.') + Rver <- .ess.ESSR.get.rver() ESSR <- .ess.ESSR.create.env(Rver) .ess.ESSR.source.files(ESSR, dir, Rver) diff --git a/lisp/ess-inf.el b/lisp/ess-inf.el index b8cafe807f..89253037f4 100644 --- a/lisp/ess-inf.el +++ b/lisp/ess-inf.el @@ -129,6 +129,11 @@ If `ess-plain-first-buffername', then initial process is number-free." (defvar-local inferior-ess--local-data nil "Program name and arguments used to start the inferior process.") +(defvar inferior-ess--last-started-process-buffer nil + "Useful in unit tests to check initialisation errors. +In that case the command fails before it can return the process +buffer to us. This global variable can be checked instead.") + (defun inferior-ess (start-args customize-alist &optional no-wait) "Start inferior ESS process. Without a prefix argument, starts a new ESS process, or switches @@ -209,6 +214,7 @@ This may be useful for debugging." (unless no-wait (ess-write-to-dribble-buffer "(inferior-ess): waiting for process (after hook)\n") (ess-wait-for-process proc))) + (setq inferior-ess--last-started-process-buffer inf-buf) inf-buf))) (defun inferior-ess--get-proc-buffer-create (name) @@ -480,6 +486,12 @@ inserted in the process buffer instead of the command buffer." (defun ess--delimiter-end-re (delim) (concat "\\(" delim "-END\r*\\)")) +(defun ess--delimiter-error-start-re () + "ESSR::ERROR \\(\"\\)") + +(defun ess--delimiter-error-end-re () + "\\(\"\\)") + (defun inferior-ess-mark-as-busy (proc) "Put PROC's busy value to t." (process-put proc 'busy t) @@ -1422,23 +1434,32 @@ wrapping the code into: (error "Timeout during background ESS command `%s'" (ess--strip-final-newlines cmd))))) (setq early-exit nil)) - (when early-exit - ;; Protect process interruption from further quits - (let ((inhibit-quit t)) - ;; In case of early exit send an interrupt to the - ;; process to abort the command - (with-current-buffer out-buffer - (goto-char (point-min)) - (when (and use-delimiter - (not (re-search-forward (ess--delimiter-start-re delim) nil t))) - ;; CMD probably failed to parse if the start delimiter - ;; can't be found in the output. Disable the delimiter - ;; before interrupt to avoid a freeze. - (ess-write-to-dribble-buffer - "Disabling output delimiter because CMD failed to parse\n") - (process-put proc 'cmd-output-delimiter nil)) - (goto-char (point-max)) - (ess--interrupt proc))))))) + (if early-exit + ;; Protect process interruption from further quits + (let ((inhibit-quit t)) + ;; In case of early exit send an interrupt to the + ;; process to abort the command + (with-current-buffer out-buffer + (goto-char (point-min)) + (when (and use-delimiter + (not (re-search-forward (ess--delimiter-start-re delim) nil t))) + ;; CMD probably failed to parse if the start delimiter + ;; can't be found in the output. Disable the delimiter + ;; before interrupt to avoid a freeze. + (ess-write-to-dribble-buffer + "Disabling output delimiter because CMD failed to parse\n") + (process-put proc 'cmd-output-delimiter nil)) + (goto-char (point-max)) + (ess--interrupt proc))) + (with-current-buffer out-buffer + (goto-char (point-min)) + (when (re-search-forward (ess--delimiter-error-start-re) nil t) + (let ((start (1+ (match-beginning 1)))) + (when (re-search-forward (ess--delimiter-error-end-re) nil t) + (let ((end (match-beginning 1))) + (error "R error during background ESS command `%s'\nError: %s" + (ess--strip-final-newlines cmd) + (buffer-substring start end))))))))))) out-buffer)) (defun ess--command-make-restore-function (proc) diff --git a/lisp/ess-r-mode.el b/lisp/ess-r-mode.el index 704641b9dc..e3648c780e 100644 --- a/lisp/ess-r-mode.el +++ b/lisp/ess-r-mode.el @@ -1582,17 +1582,26 @@ Source the etc/ESSR/.load.R file into the R process. The etc/ESSR/R directory into the ESSR environment and attaches the environment to the search path." (let* ((src-dir (expand-file-name "ESSR/R" ess-etc-directory)) - (cmd (format "base::local({ - base::source('%s/.load.R', local=TRUE) #define load.ESSR - .ess.ESSR.load('%s') - })\n" - src-dir - src-dir))) - (with-current-buffer (ess-command cmd) + (buf (ess-command (ess-r--load-ESSR-command src-dir)))) + (with-current-buffer buf (let ((msg (buffer-string))) (when (> (length msg) 1) (message (format "Messages while loading ESSR: %s" msg))))))) +(defun ess-r--load-ESSR-command (src-dir) + (format "base::tryCatch( + base::local({ + base::source('%s/.load.R', local=TRUE) #define load.ESSR + .ess.ESSR.load('%s') + }), + error = function(cnd) { + msg <- paste0('ESSR::ERROR \"', conditionMessage(cnd), '\"') + writeLines(msg) + } + )\n" + src-dir + src-dir)) + (defun ess-r--load-ESSR-remote (&optional chunked) "Load ESSR into a remote process through the process connection. Send the contents of the etc/ESSR/R directory to the remote diff --git a/test/ess-test-r.el b/test/ess-test-r.el index c3b1194e92..e138771347 100644 --- a/test/ess-test-r.el +++ b/test/ess-test-r.el @@ -908,7 +908,25 @@ https://github.com/emacs-ess/ESS/issues/725#issuecomment-431781558" (should-error (ess-r--init-error-handler)) (should (not (ess-can-eval-in-background))) (let ((proc (ess-get-current-process))) - (should (and proc (not (eq (ess-get-next-available-bg-process) proc))))))) + (should (and proc (not (eq (ess-get-next-available-bg-process) proc)))))) + (unwind-protect + (progn + (setenv "ESSR_TEST_LOAD_ERROR" "true") + (let ((err (should-error (progn + (run-ess-test-r-vanilla) + (with-current-buffer buf + (ess-wait-for-process nil nil nil nil 2)))))) + (with-current-buffer inferior-ess--last-started-process-buffer + (should (string-match-p "Loading failed with a nice message." + (caddr err))) + (should (not (ess-can-eval-in-background)))))) + (setenv "ESSR_TEST_LOAD_ERROR" nil))) + +(etest-deftest ess-r-command-error-test () + (let ((err (should-error (ess-command "stop('bar')\n")))) + (should (string-match-p "R error during background ESS command ‘stop('bar')’\nError: bar" + (cadr err)))) + :inf-result "") (provide 'ess-test-r)