[bug#40077] [PATCH 4/4] inferior: '&inferior-exception' includes a stack trace.

["Ludovic Courtès" <ludo@gnu.org>]

* guix/inferior.scm (port->inferior): Bump protocol to (0 1 1).
(&inferior-exception)[stack]: New field.
(read-repl-response): Recognize 'exception' form for protocol (0 1 1).
* tests/inferior.scm ("&inferior-exception"): Check the value returned
by 'inferior-exception-stack'.
---
 guix/inferior.scm  | 17 ++++++++++++++---
 tests/inferior.scm |  3 +++
 2 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index ec8ff8ddbe..c9a5ee5129 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -66,6 +66,7 @@
             inferior-exception?
             inferior-exception-arguments
             inferior-exception-inferior
+            inferior-exception-stack
             read-repl-response
 
             inferior-packages
@@ -164,7 +165,7 @@ inferior."
        (match rest
          ((n _ ...)
           (when (>= n 1)
-            (send-inferior-request '(() repl-version 0 1) result)))
+            (send-inferior-request '(() repl-version 0 1 1) result)))
          (_
           #t))
 
@@ -211,7 +212,8 @@ equivalent.  Return #f if the inferior could not be launched."
 (define-condition-type &inferior-exception &error
   inferior-exception?
   (arguments  inferior-exception-arguments)       ;key + arguments
-  (inferior   inferior-exception-inferior))       ;<inferior> | #f
+  (inferior   inferior-exception-inferior)        ;<inferior> | #f
+  (stack      inferior-exception-stack))          ;list of (FILE COLUMN LINE)
 
 (define* (read-repl-response port #:optional inferior)
   "Read a (guix repl) response from PORT and return it as a Scheme object.
@@ -226,10 +228,19 @@ Raise '&inferior-exception' when an exception is read from PORT."
   (match (read port)
     (('values objects ...)
      (apply values (map sexp->object objects)))
+    (('exception ('arguments key objects ...)
+                 ('stack frames ...))
+     ;; Protocol (0 1 1) and later.
+     (raise (condition (&inferior-exception
+                        (arguments (cons key (map sexp->object objects)))
+                        (inferior inferior)
+                        (stack frames)))))
     (('exception key objects ...)
+     ;; Protocol (0 0).
      (raise (condition (&inferior-exception
                         (arguments (cons key (map sexp->object objects)))
-                        (inferior inferior)))))))
+                        (inferior inferior)
+                        (stack '())))))))
 
 (define (read-inferior-response inferior)
   (read-repl-response (inferior-socket inferior)
diff --git a/tests/inferior.scm b/tests/inferior.scm
index b4417d8629..2f5215920b 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -68,6 +68,9 @@
     (guard (c ((inferior-exception? c)
                (close-inferior inferior)
                (and (eq? inferior (inferior-exception-inferior c))
+                    (match (inferior-exception-stack c)
+                      (((_ (files lines columns)) ..1)
+                       (member "guix/repl.scm" files)))
                     (inferior-exception-arguments c))))
       (inferior-eval '(throw 'a 'b 'c 'd) inferior)
       'badness)))
-- 
2.25.1