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)
