summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/inferior.scm17
-rw-r--r--tests/inferior.scm3
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)))