diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-03-15 17:26:45 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-03-19 15:14:08 +0100 |
| commit | 1dca6aaafa9f842565deab1fe7e6929f25544551 (patch) | |
| tree | 4410b84cb55e9ffbbc26310cd815aa0a8b3ec16f | |
| parent | 2b0a370d00e72aba7385eba0fa5db2e3ca7085fb (diff) | |
| download | guix-1dca6aaafa9f842565deab1fe7e6929f25544551.tar guix-1dca6aaafa9f842565deab1fe7e6929f25544551.tar.gz | |
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'.
| -rw-r--r-- | guix/inferior.scm | 17 | ||||
| -rw-r--r-- | 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))) |