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'.
This commit is contained in:
Ludovic Courtès 2020-03-15 17:26:45 +01:00
parent 2b0a370d00
commit 1dca6aaafa
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 18 additions and 4 deletions

@ -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 key 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)))))))
(inferior inferior)
(stack frames)))))
(('exception key objects ...)
;; Protocol (0 0).
(raise (condition (&inferior-exception
(arguments (cons key (map sexp->object objects)))
(inferior inferior)
(stack '())))))))
(define (read-inferior-response inferior)
(read-repl-response (inferior-socket inferior)

@ -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)))