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)
 

Reply via email to