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)
 

Reply via email to