ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

inferior: Distinguish inferior exceptions.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2020-03-10 16:45:57 +01:00
parent c00ae79cca
commit f7537e30b8
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 29 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
guix/inferior.scm
View file

@ -63,6 +63,9 @@ (define-module (guix inferior)
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 @@ (define (write-inferior-object object port)
(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 @@ (define sexp->object
(('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))

13
tests/inferior.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -61,6 +61,17 @@ (define (manifest-entry->list entry)
(close-inferior inferior)
(list a (inferior-object? b))))))
(test-equal "&inferior-exception"
'(a b c d)
(let ((inferior (open-inferior %top-builddir
#:command "scripts/guix")))
(guard (c ((inferior-exception? c)
(close-inferior inferior)
(and (eq? inferior (inferior-exception-inferior c))
(inferior-exception-arguments c))))
(inferior-eval '(throw 'a 'b 'c 'd) inferior)
'badness)))
(test-equal "inferior-packages"
(take (sort (fold-packages (lambda (package lst)
(cons (list (package-name package)