repl: Fix exception handling for interpreted code.

The 'stack' variable could be #f when code is interpreted, which in
practice happens when running in "legacy" mode--i.e., when
'open-inferior' invokes "guile" instead of "guix repl".

* guix/repl.scm (send-repl-response)[handle-exception]: Check whether
STACK is true before passing it to 'stack->frames'.
* tests/inferior.scm ("&inferior-exception, legacy mode"): New test.

diff --git a/guix/repl.scm b/guix/repl.scm
index 0ace597..94d8581 100644 (file)
--- a/guix/repl.scm
+++ b/guix/repl.scm
@@ -78,8 +78,14 @@ output port.  VERSION is the client's protocol version we are targeting."
          (let ((stack (if (repl-prompt)
                           (make-stack #t handle-exception (repl-prompt))
                           (make-stack #t))))
+           ;; Note: 'make-stack' returns #f if there's no 'handle-exception'
+           ;; stack frame, which is the case when this file is being
+           ;; interpreted as with 'primitive-load'.
            `(exception (arguments ,key ,@(map value->sexp args))
-                       (stack ,@(map frame->sexp (stack->frames stack))))))
+                       (stack ,@(map frame->sexp
+                                     (if stack
+                                         (stack->frames stack)
+                                         '()))))))
         (_
          ;; Protocol (0 0).
          `(exception ,key ,@(map value->sexp args)))))

diff --git a/tests/inferior.scm b/tests/inferior.scm
index fb12111..7c3d730 100644 (file)
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -75,6 +75,18 @@
       (inferior-eval '(throw 'a 'b 'c 'd) inferior)
       'badness)))
 
+(test-equal "&inferior-exception, legacy mode"
+  '(a b c d)
+  ;; Omit #:command to open an inferior in "legacy" mode, where Guile runs
+  ;; directly.
+  (let ((inferior (open-inferior %top-builddir)))
+    (guard (c ((inferior-exception? c)
+               (close-inferior inferior)
+               (and (eq? inferior (inferior-exception-inferior c))
+                    (inferior-exception-arguments c))))
+      (inferior-eval '(throw 'a 'b 'c 'd) inferior)
+      'badness)))
+
 (test-equal "inferior-packages"
   (take (sort (fold-packages (lambda (package lst)
                                (cons (list (package-name package)