summaryrefslogtreecommitdiff
path: root/guix/inferior.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-03-15 17:26:45 +0100
committerLudovic Courtès <ludo@gnu.org>2020-03-19 15:14:08 +0100
commit1dca6aaafa9f842565deab1fe7e6929f25544551 (patch)
tree4410b84cb55e9ffbbc26310cd815aa0a8b3ec16f /guix/inferior.scm
parent2b0a370d00e72aba7385eba0fa5db2e3ca7085fb (diff)
inferior: '&inferior-exception' includes a stack trace.
* 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'.
Diffstat (limited to 'guix/inferior.scm')
-rw-r--r--guix/inferior.scm17
1 files changed, 14 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)