nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

store: Rename '&nix-error' to '&store-error'. 

* guix/store.scm (&nix-error): Rename to...
(&store-error): ... this, and adjust users.
(&nix-connection-error): Rename to...
(&store-connection-error): ... this, and adjust users.
(&nix-protocol-error): Rename to...
(&store-protocol-error): ... this, adjust users.
(&nix-error, &nix-connection-error, &nix-protocol-error): Define these
condition types and their getters as deprecrated aliases.
* build-aux/run-system-tests.scm, guix/derivations.scm,
guix/grafts.scm, guix/scripts/challenge.scm,
guix/scripts/graph.scm, guix/scripts/lint.scm,
guix/scripts/offload.scm, guix/serialization.scm,
guix/ssh.scm, guix/tests.scm, guix/ui.scm,
tests/derivations.scm, tests/gexp.scm, tests/guix-daemon.sh,
tests/packages.scm, tests/store.scm, doc/guix.texi: Adjust to use the
new names.
master
Ludovic Courtès 2019-01-21 17:41:11 +01:00
parent de9fbe9cdc
commit f9e8a12379
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
18 changed files with 123 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
build-aux/run-system-tests.scm
View File

@ -30,7 +30,7 @@
(define (built-derivations* drv) (define (built-derivations* drv)
(lambda (store) (lambda (store)
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(values #f store))) (values #f store)))
(values (build-derivations store drv) store)))) (values (build-derivations store drv) store))))

2
doc/guix.texi
View File

@ -5027,7 +5027,7 @@ Return @code{#t} when @var{path} designates a valid store item and
invalid, for instance because it is the result of an aborted or failed invalid, for instance because it is the result of an aborted or failed
build.) build.)
A @code{&nix-protocol-error} condition is raised if @var{path} is not A @code{&store-protocol-error} condition is raised if @var{path} is not
prefixed by the store directory (@file{/gnu/store}). prefixed by the store directory (@file{/gnu/store}).
@end deffn @end deffn

2
guix/derivations.scm
View File

@ -113,7 +113,7 @@
;;; Error conditions. ;;; Error conditions.
;;; ;;;
(define-condition-type &derivation-error &nix-error (define-condition-type &derivation-error &store-error
derivation-error? derivation-error?
(derivation derivation-error-derivation)) (derivation derivation-error-derivation))

2
guix/grafts.scm
View File

@ -189,7 +189,7 @@ available."
items))) items)))
(define (references* items) (define (references* items)
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
;; As a last resort, build DRV and query the references of the ;; As a last resort, build DRV and query the references of the
;; build result. ;; build result.

2
guix/scripts/challenge.scm
View File

@ -109,7 +109,7 @@
"Return the hash of ITEM, a store item, if ITEM was built locally. "Return the hash of ITEM, a store item, if ITEM was built locally.
Otherwise return #f." Otherwise return #f."
(lambda (store) (lambda (store)
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(values #f store))) (values #f store)))
(if (locally-built? store item) (if (locally-built? store item)
(values (query-path-hash store item) store) (values (query-path-hash store item) store)

2
guix/scripts/graph.scm
View File

@ -299,7 +299,7 @@ this type of graph")))))))
information available in the local store or using information about information available in the local store or using information about
substitutes." substitutes."
(lambda (store) (lambda (store)
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(match (substitutable-path-info store (list item)) (match (substitutable-path-info store (list item))
((info) ((info)
(values (substitutable-references info) store)) (values (substitutable-references info) store))

4
guix/scripts/lint.scm
View File

@ -833,11 +833,11 @@ descriptions maintained upstream."
(define (try system) (define (try system)
(catch #t (catch #t
(lambda () (lambda ()
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(emit-warning package (emit-warning package
(format #f (G_ "failed to create ~a derivation: ~a") (format #f (G_ "failed to create ~a derivation: ~a")
system system
(nix-protocol-error-message c)))) (store-protocol-error-message c))))
((message-condition? c) ((message-condition? c)
(emit-warning package (emit-warning package
(format #f (G_ "failed to create ~a derivation: ~a") (format #f (G_ "failed to create ~a derivation: ~a")

6
guix/scripts/offload.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -358,12 +358,12 @@ MACHINE."
(format (current-error-port) "@ build-remote ~a ~a~%" (format (current-error-port) "@ build-remote ~a ~a~%"
(derivation-file-name drv) (build-machine-name machine)) (derivation-file-name drv) (build-machine-name machine))
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(format (current-error-port) (format (current-error-port)
(G_ "derivation '~a' offloaded to '~a' failed: ~a~%") (G_ "derivation '~a' offloaded to '~a' failed: ~a~%")
(derivation-file-name drv) (derivation-file-name drv)
(build-machine-name machine) (build-machine-name machine)
(nix-protocol-error-message c)) (store-protocol-error-message c))
(let* ((inferior (false-if-exception (remote-inferior session))) (let* ((inferior (false-if-exception (remote-inferior session)))
(space (false-if-exception (space (false-if-exception
(node-free-disk-space inferior)))) (node-free-disk-space inferior))))

2
guix/serialization.scm
View File

@ -59,7 +59,7 @@
;; Similar to serialize.cc in Nix. ;; Similar to serialize.cc in Nix.
(define-condition-type &nar-error &error ; XXX: inherit from &nix-error ? (define-condition-type &nar-error &error ; XXX: inherit from &store-error ?
nar-error? nar-error?
(file nar-error-file) ; file we were restoring, or #f (file nar-error-file) ; file we were restoring, or #f
(port nar-error-port)) ; port from which we read (port nar-error-port)) ; port from which we read

6
guix/ssh.scm
View File

@ -328,17 +328,17 @@ Return the list of store items actually sent."
missing) missing)
(('protocol-error message) (('protocol-error message)
(raise (condition (raise (condition
(&nix-protocol-error (message message) (status 42))))) (&store-protocol-error (message message) (status 42)))))
(('error key args ...) (('error key args ...)
(raise (condition (raise (condition
(&nix-protocol-error (&store-protocol-error
(message (call-with-output-string (message (call-with-output-string
(lambda (port) (lambda (port)
(print-exception port #f key args)))) (print-exception port #f key args))))
(status 43))))) (status 43)))))
(_ (_
(raise (condition (raise (condition
(&nix-protocol-error (&store-protocol-error
(message "unknown error while sending files over SSH") (message "unknown error while sending files over SSH")
(status 44))))))))) (status 44)))))))))

77
guix/store.scm
View File

@ -68,6 +68,15 @@
current-store-protocol-version ;for internal use current-store-protocol-version ;for internal use
mcached mcached
&store-error store-error?
&store-connection-error store-connection-error?
store-connection-error-file
store-connection-error-code
&store-protocol-error store-protocol-error?
store-protocol-error-message
store-protocol-error-status
;; Deprecated forms for '&store-error' et al.
&nix-error nix-error? &nix-error nix-error?
&nix-connection-error nix-connection-error? &nix-connection-error nix-connection-error?
nix-connection-error-file nix-connection-error-file
@ -377,34 +386,50 @@
(define-deprecated/alias nix-server-socket store-connection-socket) (define-deprecated/alias nix-server-socket store-connection-socket)
(define-condition-type &nix-error &error (define-condition-type &store-error &error
nix-error?) store-error?)
(define-condition-type &nix-connection-error &nix-error (define-condition-type &store-connection-error &store-error
nix-connection-error? store-connection-error?
(file nix-connection-error-file) (file store-connection-error-file)
(errno nix-connection-error-code)) (errno store-connection-error-code))
(define-condition-type &store-protocol-error &store-error
store-protocol-error?
(message store-protocol-error-message)
(status store-protocol-error-status))
(define-deprecated/alias &nix-error &store-error)
(define-deprecated/alias nix-error? store-error?)
(define-deprecated/alias &nix-connection-error &store-connection-error)
(define-deprecated/alias nix-connection-error? store-connection-error?)
(define-deprecated/alias nix-connection-error-file
store-connection-error-file)
(define-deprecated/alias nix-connection-error-code
store-connection-error-code)
(define-deprecated/alias &nix-protocol-error &store-protocol-error)
(define-deprecated/alias nix-protocol-error? store-protocol-error?)
(define-deprecated/alias nix-protocol-error-message
store-protocol-error-message)
(define-deprecated/alias nix-protocol-error-status
store-protocol-error-status)
(define-condition-type &nix-protocol-error &nix-error
nix-protocol-error?
(message nix-protocol-error-message)
(status nix-protocol-error-status))
(define-syntax-rule (system-error-to-connection-error file exp ...) (define-syntax-rule (system-error-to-connection-error file exp ...)
"Catch 'system-error' exceptions and translate them to "Catch 'system-error' exceptions and translate them to
'&nix-connection-error'." '&store-connection-error'."
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
exp ...) exp ...)
(lambda args (lambda args
(let ((errno (system-error-errno args))) (let ((errno (system-error-errno args)))
(raise (condition (&nix-connection-error (raise (condition (&store-connection-error
(file file) (file file)
(errno errno)))))))) (errno errno))))))))
(define (open-unix-domain-socket file) (define (open-unix-domain-socket file)
"Connect to the Unix-domain socket at FILE and return it. Raise a "Connect to the Unix-domain socket at FILE and return it. Raise a
'&nix-connection-error' upon error." '&store-connection-error' upon error."
(let ((s (with-fluids ((%default-port-encoding #f)) (let ((s (with-fluids ((%default-port-encoding #f))
;; This trick allows use of the `scm_c_read' optimization. ;; This trick allows use of the `scm_c_read' optimization.
(socket PF_UNIX SOCK_STREAM 0))) (socket PF_UNIX SOCK_STREAM 0)))
@ -420,7 +445,7 @@
(define (open-inet-socket host port) (define (open-inet-socket host port)
"Connect to the Unix-domain socket at HOST:PORT and return it. Raise a "Connect to the Unix-domain socket at HOST:PORT and return it. Raise a
'&nix-connection-error' upon error." '&store-connection-error' upon error."
(let ((sock (with-fluids ((%default-port-encoding #f)) (let ((sock (with-fluids ((%default-port-encoding #f))
;; This trick allows use of the `scm_c_read' optimization. ;; This trick allows use of the `scm_c_read' optimization.
(socket PF_UNIX SOCK_STREAM 0)))) (socket PF_UNIX SOCK_STREAM 0))))
@ -452,7 +477,7 @@
;; Connection failed, so try one of the other addresses. ;; Connection failed, so try one of the other addresses.
(close s) (close s)
(if (null? rest) (if (null? rest)
(raise (condition (&nix-connection-error (raise (condition (&store-connection-error
(file host) (file host)
(errno (system-error-errno args))))) (errno (system-error-errno args)))))
(loop rest)))))))))) (loop rest))))))))))
@ -461,7 +486,7 @@
"Connect to the daemon at URI, a string that may be an actual URI or a file "Connect to the daemon at URI, a string that may be an actual URI or a file
name." name."
(define (not-supported) (define (not-supported)
(raise (condition (&nix-connection-error (raise (condition (&store-connection-error
(file uri) (file uri)
(errno ENOTSUP))))) (errno ENOTSUP)))))
@ -510,8 +535,8 @@ for this connection will be pinned. Return a server object."
;; One of the 'write-' or 'read-' calls below failed, but this is ;; One of the 'write-' or 'read-' calls below failed, but this is
;; really a connection error. ;; really a connection error.
(raise (condition (raise (condition
(&nix-connection-error (file (or port uri)) (&store-connection-error (file (or port uri))
(errno EPROTO)) (errno EPROTO))
(&message (message "build daemon handshake failed")))))) (&message (message "build daemon handshake failed"))))))
(let*-values (((port) (let*-values (((port)
(or port (connect-to-daemon uri))) (or port (connect-to-daemon uri)))
@ -689,14 +714,14 @@ encoding conversion errors."
(not (eof-object? (lookahead-u8 p)))) (not (eof-object? (lookahead-u8 p))))
(read-int p) (read-int p)
1))) 1)))
(raise (condition (&nix-protocol-error (raise (condition (&store-protocol-error
(message error) (message error)
(status status)))))) (status status))))))
((= k %stderr-last) ((= k %stderr-last)
;; The daemon is done (see `stopWork' in `nix-worker.cc'.) ;; The daemon is done (see `stopWork' in `nix-worker.cc'.)
#t) #t)
(else (else
(raise (condition (&nix-protocol-error (raise (condition (&store-protocol-error
(message "invalid error code") (message "invalid error code")
(status k)))))))) (status k))))))))
@ -926,7 +951,7 @@ bytevector) as its internal buffer, and a thunk to flush this output port."
invalid item may exist on disk but still be invalid, for instance because it invalid item may exist on disk but still be invalid, for instance because it
is the result of an aborted or failed build.) is the result of an aborted or failed build.)
A '&nix-protocol-error' condition is raised if PATH is not prefixed by the A '&store-protocol-error' condition is raised if PATH is not prefixed by the
store directory (/gnu/store)." store directory (/gnu/store)."
boolean) boolean)
@ -1141,7 +1166,7 @@ Return #t on success."
(build store things mode) (build store things mode)
(if (= mode (build-mode normal)) (if (= mode (build-mode normal))
(build/old store things) (build/old store things)
(raise (condition (&nix-protocol-error (raise (condition (&store-protocol-error
(message "unsupported build mode") (message "unsupported build mode")
(status 1)))))))))) (status 1))))))))))
@ -1201,12 +1226,12 @@ error if there is no such root."
(define (references/substitutes store items) (define (references/substitutes store items)
"Return the list of list of references of ITEMS; the result has the same "Return the list of list of references of ITEMS; the result has the same
length as ITEMS. Query substitute information for any item missing from the length as ITEMS. Query substitute information for any item missing from the
store at once. Raise a '&nix-protocol-error' exception if reference store at once. Raise a '&store-protocol-error' exception if reference
information for one of ITEMS is missing." information for one of ITEMS is missing."
(let* ((requested items) (let* ((requested items)
(local-refs (map (lambda (item) (local-refs (map (lambda (item)
(or (hash-ref %reference-cache item) (or (hash-ref %reference-cache item)
(guard (c ((nix-protocol-error? c) #f)) (guard (c ((store-protocol-error? c) #f))
(references store item)))) (references store item))))
items)) items))
(missing (fold-right (lambda (item local-ref result) (missing (fold-right (lambda (item local-ref result)
@ -1222,7 +1247,7 @@ information for one of ITEMS is missing."
'() '()
(substitutable-path-info store missing)))) (substitutable-path-info store missing))))
(when (< (length substs) (length missing)) (when (< (length substs) (length missing))
(raise (condition (&nix-protocol-error (raise (condition (&store-protocol-error
(message "cannot determine \ (message "cannot determine \
the list of references") the list of references")
(status 1))))) (status 1)))))
@ -1673,7 +1698,7 @@ where FILE is the entry's absolute file name and STAT is the result of
"Monadic version of 'query-path-info' that returns #f when ITEM is not in "Monadic version of 'query-path-info' that returns #f when ITEM is not in
the store." the store."
(lambda (store) (lambda (store)
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
;; ITEM is not in the store; return #f. ;; ITEM is not in the store; return #f.
(values #f store))) (values #f store)))
(values (query-path-info store item) store)))) (values (query-path-info store item) store))))

2
guix/tests.scm
View File

@ -64,7 +64,7 @@
(define* (open-connection-for-tests #:optional (uri (%daemon-socket-uri))) (define* (open-connection-for-tests #:optional (uri (%daemon-socket-uri)))
"Open a connection to the build daemon for tests purposes and return it." "Open a connection to the build daemon for tests purposes and return it."
(guard (c ((nix-error? c) (guard (c ((store-error? c)
(format (current-error-port) (format (current-error-port)
"warning: build daemon error: ~s~%" c) "warning: build daemon error: ~s~%" c)
#f)) #f))

10
guix/ui.scm
View File

@ -684,14 +684,14 @@ or remove one of them from the profile.")
file (or (port-filename* port) port)) file (or (port-filename* port) port))
(leave (G_ "corrupt input while restoring archive from ~s~%") (leave (G_ "corrupt input while restoring archive from ~s~%")
(or (port-filename* port) port))))) (or (port-filename* port) port)))))
((nix-connection-error? c) ((store-connection-error? c)
(leave (G_ "failed to connect to `~a': ~a~%") (leave (G_ "failed to connect to `~a': ~a~%")
(nix-connection-error-file c) (store-connection-error-file c)
(strerror (nix-connection-error-code c)))) (strerror (store-connection-error-code c))))
((nix-protocol-error? c) ((store-protocol-error? c)
;; FIXME: Server-provided error messages aren't i18n'd. ;; FIXME: Server-provided error messages aren't i18n'd.
(leave (G_ "build failed: ~a~%") (leave (G_ "build failed: ~a~%")
(nix-protocol-error-message c))) (store-protocol-error-message c)))
((derivation-missing-output-error? c) ((derivation-missing-output-error? c)
(leave (G_ "reference to invalid output '~a' of derivation '~a'~%") (leave (G_ "reference to invalid output '~a' of derivation '~a'~%")
(derivation-missing-output c) (derivation-missing-output c)

42
tests/derivations.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -185,9 +185,9 @@
(set-build-options %store (set-build-options %store
#:use-substitutes? #f #:use-substitutes? #f
#:keep-going? #t) #:keep-going? #t)
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(and (= 100 (nix-protocol-error-status c)) (and (= 100 (store-protocol-error-status c))
(string-contains (nix-protocol-error-message c) (string-contains (store-protocol-error-message c)
(derivation-file-name d1)) (derivation-file-name d1))
(not (valid-path? %store (derivation->output-path d1))) (not (valid-path? %store (derivation->output-path d1)))
(valid-path? %store (derivation->output-path d2))))) (valid-path? %store (derivation->output-path d2)))))
@ -222,8 +222,8 @@
(test-assert "unknown built-in builder" (test-assert "unknown built-in builder"
(let ((drv (derivation %store "ohoh" "builtin:does-not-exist" '()))) (let ((drv (derivation %store "ohoh" "builtin:does-not-exist" '())))
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(string-contains (nix-protocol-error-message c) "failed"))) (string-contains (store-protocol-error-message c) "failed")))
(build-derivations %store (list drv)) (build-derivations %store (list drv))
#f))) #f)))
@ -253,8 +253,8 @@
. ,(object->string (%local-url)))) . ,(object->string (%local-url))))
#:hash-algo 'sha256 #:hash-algo 'sha256
#:hash (sha256 (random-bytevector 100))))) ;wrong #:hash (sha256 (random-bytevector 100))))) ;wrong
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(string-contains (nix-protocol-error-message c) "failed"))) (string-contains (store-protocol-error-message c) "failed")))
(build-derivations %store (list drv)) (build-derivations %store (list drv))
#f)))) #f))))
@ -268,8 +268,8 @@
. ,(object->string (%local-url)))) . ,(object->string (%local-url))))
#:hash-algo 'sha256 #:hash-algo 'sha256
#:hash (sha256 (random-bytevector 100))))) #:hash (sha256 (random-bytevector 100)))))
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(string-contains (nix-protocol-error-message (pk c)) "failed"))) (string-contains (store-protocol-error-message (pk c)) "failed")))
(build-derivations %store (list drv)) (build-derivations %store (list drv))
#f)))) #f))))
@ -279,8 +279,8 @@
(drv (derivation %store "world" (drv (derivation %store "world"
"builtin:download" '() "builtin:download" '()
#:env-vars `(("url" . ,(object->string url)))))) #:env-vars `(("url" . ,(object->string url))))))
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(string-contains (nix-protocol-error-message c) "failed"))) (string-contains (store-protocol-error-message c) "failed")))
(build-derivations %store (list drv)) (build-derivations %store (list drv))
#f))) #f)))
@ -607,7 +607,7 @@
`("-c" ,(string-append "echo " txt "> $out")) `("-c" ,(string-append "echo " txt "> $out"))
#:inputs `((,%bash) (,txt)) #:inputs `((,%bash) (,txt))
#:allowed-references '()))) #:allowed-references '())))
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
;; There's no specific error message to check for. ;; There's no specific error message to check for.
#t)) #t))
(build-derivations %store (list drv)) (build-derivations %store (list drv))
@ -625,7 +625,7 @@
`("-c" ,"echo $out > $out") `("-c" ,"echo $out > $out")
#:inputs `((,%bash)) #:inputs `((,%bash))
#:allowed-references '()))) #:allowed-references '())))
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
;; There's no specific error message to check for. ;; There's no specific error message to check for.
#t)) #t))
(build-derivations %store (list drv)) (build-derivations %store (list drv))
@ -644,7 +644,7 @@
`("-c" ,(string-append "echo " txt "> $out")) `("-c" ,(string-append "echo " txt "> $out"))
#:inputs `((,%bash) (,txt)) #:inputs `((,%bash) (,txt))
#:disallowed-references (list txt)))) #:disallowed-references (list txt))))
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
;; There's no specific error message to check for. ;; There's no specific error message to check for.
#t)) #t))
(build-derivations %store (list drv)) (build-derivations %store (list drv))
@ -765,8 +765,8 @@
(builder '(begin (sleep 100) (mkdir %output) #t)) (builder '(begin (sleep 100) (mkdir %output) #t))
(drv (build-expression->derivation store "silent" builder)) (drv (build-expression->derivation store "silent" builder))
(out-path (derivation->output-path drv))) (out-path (derivation->output-path drv)))
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(and (string-contains (nix-protocol-error-message c) (and (string-contains (store-protocol-error-message c)
"failed") "failed")
(not (valid-path? store out-path))))) (not (valid-path? store out-path)))))
(build-derivations store (list drv)) (build-derivations store (list drv))
@ -779,8 +779,8 @@
(builder '(begin (sleep 100) (mkdir %output) #t)) (builder '(begin (sleep 100) (mkdir %output) #t))
(drv (build-expression->derivation store "slow" builder)) (drv (build-expression->derivation store "slow" builder))
(out-path (derivation->output-path drv))) (out-path (derivation->output-path drv)))
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(and (string-contains (nix-protocol-error-message c) (and (string-contains (store-protocol-error-message c)
"failed") "failed")
(not (valid-path? store out-path))))) (not (valid-path? store out-path)))))
(build-derivations store (list drv)) (build-derivations store (list drv))
@ -942,11 +942,11 @@
#f)) ; fail! #f)) ; fail!
(drv (build-expression->derivation %store "fail" builder)) (drv (build-expression->derivation %store "fail" builder))
(out-path (derivation->output-path drv))) (out-path (derivation->output-path drv)))
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
;; Note that the output path may exist at this point, but it ;; Note that the output path may exist at this point, but it
;; is invalid. ;; is invalid.
(and (string-match "build .* failed" (and (string-match "build .* failed"
(nix-protocol-error-message c)) (store-protocol-error-message c))
(not (valid-path? %store out-path))))) (not (valid-path? %store out-path)))))
(build-derivations %store (list drv)) (build-derivations %store (list drv))
#f))) #f)))

4
tests/gexp.scm
View File

@ -919,7 +919,7 @@
(chdir #$output) (chdir #$output)
(symlink #$%bootstrap-guile "guile")) (symlink #$%bootstrap-guile "guile"))
#:allowed-references '())))) #:allowed-references '()))))
(guard (c ((nix-protocol-error? c) #t)) (guard (c ((store-protocol-error? c) #t))
(build-derivations %store (list drv)) (build-derivations %store (list drv))
#f))) #f)))
@ -943,7 +943,7 @@
(chdir #$output) (chdir #$output)
(symlink #$%bootstrap-guile "guile")) (symlink #$%bootstrap-guile "guile"))
#:disallowed-references (list %bootstrap-guile))))) #:disallowed-references (list %bootstrap-guile)))))
(guard (c ((nix-protocol-error? c) #t)) (guard (c ((store-protocol-error? c) #t))
(build-derivations %store (list drv)) (build-derivations %store (list drv))
#f))) #f)))

8
tests/guix-daemon.sh
View File

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU # GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> # Copyright © 2012, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
# #
# This file is part of GNU Guix. # This file is part of GNU Guix.
# #
@ -109,7 +109,7 @@ guile -c "
(define (build-without-failing drv) (define (build-without-failing drv)
(lambda (store) (lambda (store)
(guard (c ((nix-protocol-error? c) (values #t store))) (guard (c ((store-protocol-error? c) (values #t store)))
(build-derivations store (list drv)) (build-derivations store (list drv))
(values #f store)))) (values #f store))))
@ -177,9 +177,9 @@ client_code='
`("-e" ,build) `("-e" ,build)
#:inputs `((,bash) (,build)) #:inputs `((,bash) (,build))
#:env-vars `(("x" . ,(random-text)))))) #:env-vars `(("x" . ,(random-text))))))
(exit (guard (c ((nix-protocol-error? c) (exit (guard (c ((store-protocol-error? c)
(->bool (->bool
(string-contains (pk (nix-protocol-error-message c)) (string-contains (pk (store-protocol-error-message c))
"failed")))) "failed"))))
(build-derivations store (list drv)) (build-derivations store (list drv))
#f))))' #f))))'

2
tests/packages.scm
View File

@ -570,7 +570,7 @@
(symlink %output (string-append %output "/self")) (symlink %output (string-append %output "/self"))
#t))))) #t)))))
(d (package-derivation %store p))) (d (package-derivation %store p)))
(guard (c ((nix-protocol-error? c) #t)) (guard (c ((store-protocol-error? c) #t))
(build-derivations %store (list d)) (build-derivations %store (list d))
#f))) #f)))

46
tests/store.scm
View File

@ -63,9 +63,9 @@
(test-equal "connection handshake error" (test-equal "connection handshake error"
EPROTO EPROTO
(let ((port (%make-void-port "rw"))) (let ((port (%make-void-port "rw")))
(guard (c ((nix-connection-error? c) (guard (c ((store-connection-error? c)
(and (eq? port (nix-connection-error-file c)) (and (eq? port (store-connection-error-file c))
(nix-connection-error-code c)))) (store-connection-error-code c))))
(open-connection #f #:port port) (open-connection #f #:port port)
'broken))) 'broken)))
@ -120,7 +120,7 @@
(test-assert "valid-path? error" (test-assert "valid-path? error"
(with-store s (with-store s
(guard (c ((nix-protocol-error? c) #t)) (guard (c ((store-protocol-error? c) #t))
(valid-path? s "foo") (valid-path? s "foo")
#f))) #f)))
@ -133,7 +133,7 @@
(with-store s (with-store s
(let-syntax ((true-if-error (syntax-rules () (let-syntax ((true-if-error (syntax-rules ()
((_ exp) ((_ exp)
(guard (c ((nix-protocol-error? c) #t)) (guard (c ((store-protocol-error? c) #t))
exp #f))))) exp #f)))))
(and (true-if-error (valid-path? s "foo")) (and (true-if-error (valid-path? s "foo"))
(true-if-error (valid-path? s "bar")) (true-if-error (valid-path? s "bar"))
@ -274,7 +274,7 @@
(test-assert "references/substitutes missing reference info" (test-assert "references/substitutes missing reference info"
(with-store s (with-store s
(set-build-options s #:use-substitutes? #f) (set-build-options s #:use-substitutes? #f)
(guard (c ((nix-protocol-error? c) #t)) (guard (c ((store-protocol-error? c) #t))
(let* ((b (add-to-store s "bash" #t "sha256" (let* ((b (add-to-store s "bash" #t "sha256"
(search-bootstrap-binary "bash" (search-bootstrap-binary "bash"
(%current-system)))) (%current-system))))
@ -422,7 +422,7 @@
%store "foo" `(display ,s) %store "foo" `(display ,s)
#:guile-for-build #:guile-for-build
(package-derivation s %bootstrap-guile (%current-system))))) (package-derivation s %bootstrap-guile (%current-system)))))
(guard (c ((nix-protocol-error? c) #t)) (guard (c ((store-protocol-error? c) #t))
(build-derivations %store (list d)))))))) (build-derivations %store (list d))))))))
"Here’s a Greek letter: λ.")) "Here’s a Greek letter: λ."))
@ -442,7 +442,7 @@
(display "lambda: λ\n")) (display "lambda: λ\n"))
#:guile-for-build #:guile-for-build
(package-derivation %store %bootstrap-guile)))) (package-derivation %store %bootstrap-guile))))
(guard (c ((nix-protocol-error? c) #t)) (guard (c ((store-protocol-error? c) #t))
(build-derivations %store (list d)))))))) (build-derivations %store (list d))))))))
"garbage: <20>lambda: λ")) "garbage: <20>lambda: λ"))
@ -620,12 +620,12 @@
#:fallback? #f #:fallback? #f
#:substitute-urls (%test-substitute-urls)) #:substitute-urls (%test-substitute-urls))
(and (has-substitutes? s o) (and (has-substitutes? s o)
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
;; XXX: the daemon writes "hash mismatch in downloaded ;; XXX: the daemon writes "hash mismatch in downloaded
;; path", but the actual error returned to the client ;; path", but the actual error returned to the client
;; doesn't mention that. ;; doesn't mention that.
(pk 'corrupt c) (pk 'corrupt c)
(not (zero? (nix-protocol-error-status c))))) (not (zero? (store-protocol-error-status c)))))
(build-derivations s (list d)) (build-derivations s (list d))
#f)))))) #f))))))
@ -646,7 +646,7 @@
(set-build-options s #:use-substitutes? #t (set-build-options s #:use-substitutes? #t
#:substitute-urls (%test-substitute-urls)) #:substitute-urls (%test-substitute-urls))
(and (has-substitutes? s o) (and (has-substitutes? s o)
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
;; The substituter failed as expected. Now make ;; The substituter failed as expected. Now make
;; sure that #:fallback? #t works correctly. ;; sure that #:fallback? #t works correctly.
(set-build-options s (set-build-options s
@ -712,9 +712,9 @@
(dump (call-with-bytevector-output-port (dump (call-with-bytevector-output-port
(cute export-paths %store (list file2) <>)))) (cute export-paths %store (list file2) <>))))
(delete-paths %store (list file0 file1 file2)) (delete-paths %store (list file0 file1 file2))
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(and (not (zero? (nix-protocol-error-status c))) (and (not (zero? (store-protocol-error-status c)))
(string-contains (nix-protocol-error-message c) (string-contains (store-protocol-error-message c)
"not valid")))) "not valid"))))
;; Here we get an exception because DUMP does not include FILE0 and ;; Here we get an exception because DUMP does not include FILE0 and
;; FILE1, which are dependencies of FILE2. ;; FILE1, which are dependencies of FILE2.
@ -816,10 +816,10 @@
(bytevector-u8-set! dump index (logxor #xff byte))) (bytevector-u8-set! dump index (logxor #xff byte)))
(and (not (file-exists? file)) (and (not (file-exists? file))
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(pk 'c c) (pk 'c c)
(and (not (zero? (nix-protocol-error-status c))) (and (not (zero? (store-protocol-error-status c)))
(string-contains (nix-protocol-error-message c) (string-contains (store-protocol-error-message c)
"corrupt")))) "corrupt"))))
(let* ((source (open-bytevector-input-port dump)) (let* ((source (open-bytevector-input-port dump))
(imported (import-paths %store source))) (imported (import-paths %store source)))
@ -906,10 +906,10 @@
(begin (begin
(write (random-text) entropy-port) (write (random-text) entropy-port)
(force-output entropy-port) (force-output entropy-port)
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(pk 'determinism-exception c) (pk 'determinism-exception c)
(and (not (zero? (nix-protocol-error-status c))) (and (not (zero? (store-protocol-error-status c)))
(string-contains (nix-protocol-error-message c) (string-contains (store-protocol-error-message c)
"deterministic")))) "deterministic"))))
;; This one will produce a different result. Since we're in ;; This one will produce a different result. Since we're in
;; 'check' mode, this must fail. ;; 'check' mode, this must fail.
@ -945,10 +945,10 @@
#:guile-for-build #:guile-for-build
(package-derivation store %bootstrap-guile (%current-system)))) (package-derivation store %bootstrap-guile (%current-system))))
(file (derivation->output-path drv))) (file (derivation->output-path drv)))
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(pk 'multiple-build c) (pk 'multiple-build c)
(and (not (zero? (nix-protocol-error-status c))) (and (not (zero? (store-protocol-error-status c)))
(string-contains (nix-protocol-error-message c) (string-contains (store-protocol-error-message c)
"deterministic")))) "deterministic"))))
;; This one will produce a different result on the second run. ;; This one will produce a different result on the second run.
(current-build-output-port (current-error-port)) (current-build-output-port (current-error-port))