branch: externals/ess commit 3b15d0efd9c0b22248d29ac84ec4b55d209c16f8 Author: Lionel Henry <lionel....@gmail.com> Commit: Lionel Henry <lionel....@gmail.com>
Propagate ESSR init errors to elisp side Which allows the init error handler to disable background evals --- etc/ESSR/R/.load.R | 3 +++ lisp/ess-inf.el | 55 +++++++++++++++++++++++++++++++++++++----------------- lisp/ess-r-mode.el | 23 ++++++++++++++++------- test/ess-test-r.el | 14 +++++++++++++- 4 files changed, 70 insertions(+), 25 deletions(-) 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..1efc94ec87 100644 --- a/test/ess-test-r.el +++ b/test/ess-test-r.el @@ -908,7 +908,19 @@ 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))) (provide 'ess-test-r)