03/04: repl: Fix exception handling for interpreted code.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 98d3abe7440717724263cacca8c36e9f43d53fcc
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Jan 21 00:05:29 2021 +0100

    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.
---
 guix/repl.scm      |  8 +++++++-
 tests/inferior.scm | 12 ++++++++++++
 2 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/guix/repl.scm b/guix/repl.scm
index 0ace597..94d8581 100644
--- 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
--- 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)