inferior: Propagate '&store-protocol-error' error conditions.
Until now '&store-protocol-error' conditions raised in the inferior would not be correctly propagated because SRFI-35 records lack a read syntax. Reported at <https://bugs.gnu.org/37449> by Carl Dong <contact@carldong.me>. * guix/inferior.scm (port->inferior): Import (srfi srfi-34) in the inferior. (inferior-eval-with-store): Define 'error?' and 'error-message'. Wrap call to PROC in 'guard'. Check the response of INFERIOR for a 'store-protocol-error' or a 'result' tag. * tests/inferior.scm ("inferior-eval-with-store, &store-protocol-error"): New test.
This commit is contained in:
parent
a43e9157ef
commit
7150743522
|
@ -19,6 +19,8 @@
|
||||||
(define-module (guix inferior)
|
(define-module (guix inferior)
|
||||||
#:use-module (srfi srfi-9)
|
#:use-module (srfi srfi-9)
|
||||||
#:use-module (srfi srfi-9 gnu)
|
#:use-module (srfi srfi-9 gnu)
|
||||||
|
#:use-module (srfi srfi-34)
|
||||||
|
#:use-module (srfi srfi-35)
|
||||||
#:use-module ((guix utils)
|
#:use-module ((guix utils)
|
||||||
#:select (%current-system
|
#:select (%current-system
|
||||||
source-properties->location
|
source-properties->location
|
||||||
|
@ -29,7 +31,8 @@
|
||||||
#:select (store-connection-socket
|
#:select (store-connection-socket
|
||||||
store-connection-major-version
|
store-connection-major-version
|
||||||
store-connection-minor-version
|
store-connection-minor-version
|
||||||
store-lift))
|
store-lift
|
||||||
|
&store-protocol-error))
|
||||||
#:use-module ((guix derivations)
|
#:use-module ((guix derivations)
|
||||||
#:select (read-derivation-from-file))
|
#:select (read-derivation-from-file))
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
|
@ -151,6 +154,7 @@ inferior."
|
||||||
(inferior-eval '(use-modules (guix)) result)
|
(inferior-eval '(use-modules (guix)) result)
|
||||||
(inferior-eval '(use-modules (gnu)) result)
|
(inferior-eval '(use-modules (gnu)) result)
|
||||||
(inferior-eval '(use-modules (ice-9 match)) result)
|
(inferior-eval '(use-modules (ice-9 match)) result)
|
||||||
|
(inferior-eval '(use-modules (srfi srfi-34)) result)
|
||||||
(inferior-eval '(define %package-table (make-hash-table))
|
(inferior-eval '(define %package-table (make-hash-table))
|
||||||
result)
|
result)
|
||||||
result))
|
result))
|
||||||
|
@ -462,7 +466,13 @@ thus be the code of a one-argument procedure that accepts a store."
|
||||||
(listen socket 1024)
|
(listen socket 1024)
|
||||||
(send-inferior-request
|
(send-inferior-request
|
||||||
`(let ((proc ,code)
|
`(let ((proc ,code)
|
||||||
(socket (socket AF_UNIX SOCK_STREAM 0)))
|
(socket (socket AF_UNIX SOCK_STREAM 0))
|
||||||
|
(error? (if (defined? 'store-protocol-error?)
|
||||||
|
store-protocol-error?
|
||||||
|
nix-protocol-error?))
|
||||||
|
(error-message (if (defined? 'store-protocol-error-message)
|
||||||
|
store-protocol-error-message
|
||||||
|
nix-protocol-error-message)))
|
||||||
(connect socket AF_UNIX ,name)
|
(connect socket AF_UNIX ,name)
|
||||||
|
|
||||||
;; 'port->connection' appeared in June 2018 and we can hardly
|
;; 'port->connection' appeared in June 2018 and we can hardly
|
||||||
|
@ -475,7 +485,13 @@ thus be the code of a one-argument procedure that accepts a store."
|
||||||
(dynamic-wind
|
(dynamic-wind
|
||||||
(const #t)
|
(const #t)
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(proc store))
|
;; Serialize '&store-protocol-error' conditions. The
|
||||||
|
;; exception serialization mechanism that
|
||||||
|
;; 'read-repl-response' expects is unsuitable for SRFI-35
|
||||||
|
;; error conditions, hence this special case.
|
||||||
|
(guard (c ((error? c)
|
||||||
|
`(store-protocol-error ,(error-message c))))
|
||||||
|
`(result ,(proc store))))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(close-connection store)
|
(close-connection store)
|
||||||
(close-port socket)))))
|
(close-port socket)))))
|
||||||
|
@ -484,7 +500,14 @@ thus be the code of a one-argument procedure that accepts a store."
|
||||||
((client . address)
|
((client . address)
|
||||||
(proxy client (store-connection-socket store))))
|
(proxy client (store-connection-socket store))))
|
||||||
(close-port socket)
|
(close-port socket)
|
||||||
(read-inferior-response inferior)))))
|
|
||||||
|
(match (read-inferior-response inferior)
|
||||||
|
(('store-protocol-error message)
|
||||||
|
(raise (condition
|
||||||
|
(&store-protocol-error (message message)
|
||||||
|
(status 1)))))
|
||||||
|
(('result result)
|
||||||
|
result))))))
|
||||||
|
|
||||||
(define* (inferior-package-derivation store package
|
(define* (inferior-package-derivation store package
|
||||||
#:optional
|
#:optional
|
||||||
|
|
|
@ -27,6 +27,7 @@
|
||||||
#:use-module (gnu packages bootstrap)
|
#:use-module (gnu packages bootstrap)
|
||||||
#:use-module (gnu packages guile)
|
#:use-module (gnu packages guile)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
#:use-module (ice-9 match))
|
#:use-module (ice-9 match))
|
||||||
|
|
||||||
|
@ -186,6 +187,18 @@
|
||||||
(add-text-to-store store "foo"
|
(add-text-to-store store "foo"
|
||||||
"Hello, world!")))))
|
"Hello, world!")))))
|
||||||
|
|
||||||
|
(test-assert "inferior-eval-with-store, &store-protocol-error"
|
||||||
|
(let* ((inferior (open-inferior %top-builddir
|
||||||
|
#:command "scripts/guix")))
|
||||||
|
(guard (c ((store-protocol-error? c)
|
||||||
|
(string-contains (store-protocol-error-message c)
|
||||||
|
"invalid character")))
|
||||||
|
(inferior-eval-with-store inferior %store
|
||||||
|
'(lambda (store)
|
||||||
|
(add-text-to-store store "we|rd/?!@"
|
||||||
|
"uh uh")))
|
||||||
|
#f)))
|
||||||
|
|
||||||
(test-equal "inferior-package-derivation"
|
(test-equal "inferior-package-derivation"
|
||||||
(map derivation-file-name
|
(map derivation-file-name
|
||||||
(list (package-derivation %store %bootstrap-guile "x86_64-linux")
|
(list (package-derivation %store %bootstrap-guile "x86_64-linux")
|
||||||
|
|
Loading…
Reference in New Issue