From 98d3abe7440717724263cacca8c36e9f43d53fcc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 21 Jan 2021 00:05:29 +0100
Subject: [PATCH] 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 0ace5976cf..94d85815ef 100644
--- a/guix/repl.scm
+++ b/guix/repl.scm
@@ -78,8 +78,14 @@ (define reply
          (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 fb12111343..7c3d730d0c 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -75,6 +75,18 @@ (define (manifest-entry->list entry)
       (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)