From f7537e30b892cef09d91902547c00e5fa9b66f3b Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 10 Mar 2020 16:45:57 +0100
Subject: inferior: Distinguish inferior exceptions.

This avoids ambiguities when looking at a backtrace where the exception
was actually thrown by an inferior in a very different context.

* guix/inferior.scm (&inferior-exception): New condition type.
(read-repl-response): Add optional 'inferior' parameter.  Raise
'&inferior-exception' instead of rethrowing to KEY when receiving an
'exception' message.
(read-inferior-response): Pass INFERIOR to 'read-repl-response'.
* tests/inferior.scm ("&inferior-exception"): New test.
---
 guix/inferior.scm | 21 +++++++++++++++++----
 1 file changed, 17 insertions(+), 4 deletions(-)

(limited to 'guix/inferior.scm')

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 0236fb61ad..6b685ece30 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -63,6 +63,9 @@
             inferior-eval
             inferior-eval-with-store
             inferior-object?
+            inferior-exception?
+            inferior-exception-arguments
+            inferior-exception-inferior
             read-repl-response
 
             inferior-packages
@@ -195,8 +198,15 @@ equivalent.  Return #f if the inferior could not be launched."
 
 (set-record-type-printer! <inferior-object> write-inferior-object)
 
-(define (read-repl-response port)
-  "Read a (guix repl) response from PORT and return it as a Scheme object."
+;; Reified exception thrown by an inferior.
+(define-condition-type &inferior-exception &error
+  inferior-exception?
+  (arguments  inferior-exception-arguments)       ;key + arguments
+  (inferior   inferior-exception-inferior))       ;<inferior> | #f
+
+(define* (read-repl-response port #:optional inferior)
+  "Read a (guix repl) response from PORT and return it as a Scheme object.
+Raise '&inferior-exception' when an exception is read from PORT."
   (define sexp->object
     (match-lambda
       (('value value)
@@ -208,10 +218,13 @@ equivalent.  Return #f if the inferior could not be launched."
     (('values objects ...)
      (apply values (map sexp->object objects)))
     (('exception key objects ...)
-     (apply throw key (map sexp->object objects)))))
+     (raise (condition (&inferior-exception
+                        (arguments (cons key (map sexp->object objects)))
+                        (inferior inferior)))))))
 
 (define (read-inferior-response inferior)
-  (read-repl-response (inferior-socket inferior)))
+  (read-repl-response (inferior-socket inferior)
+                      inferior))
 
 (define (send-inferior-request exp inferior)
   (write exp (inferior-socket inferior))
-- 
cgit v1.2.3