diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-02-02 11:24:24 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-02-02 12:46:35 +0100 |
| commit | e6c8839c180b88a9ef9e68af8acc3148099e286b (patch) | |
| tree | e2bba56486a3eb8954f3af88618c75a68ab1e3f7 /tests | |
| parent | 6eebbab5624f213a298afb1baed28cec026b2727 (diff) | |
| download | patches-e6c8839c180b88a9ef9e68af8acc3148099e286b.tar patches-e6c8839c180b88a9ef9e68af8acc3148099e286b.tar.gz | |
tests: Add 'with-derivation-substitute' and use it.
* guix/tests.scm (%substitute-directory): New variable.
(call-with-derivation-narinfo): Use it.
(call-with-derivation-substitute): New procedure.
(with-derivation-substitute): New macro.
* tests/store.scm ("substitute"): Use 'with-derivation-substitute'.
("substitute, corrupt output hash"): Likewise.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/store.scm | 71 |
1 files changed, 23 insertions, 48 deletions
diff --git a/tests/store.scm b/tests/store.scm index 07ebff2ea2..73d64e468b 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -343,27 +343,12 @@ (display ,c p))) #:guile-for-build (package-derivation s %bootstrap-guile (%current-system)))) - (o (derivation->output-path d)) - (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") - (compose uri-path string->uri)))) - (call-with-output-file (string-append dir "/example.out") - (lambda (p) - (display c p))) - (call-with-output-file (string-append dir "/example.nar") - (lambda (p) - (write-file (string-append dir "/example.out") p))) - - (let ((h (call-with-input-file (string-append dir "/example.nar") - port-sha256))) - ;; Create fake substituter data, to be read by `substitute-binary'. - (with-derivation-narinfo d - (sha256 => h) - - ;; Make sure we use `substitute-binary'. - (set-build-options s #:use-substitutes? #t) - (and (has-substitutes? s o) - (build-derivations s (list d)) - (equal? c (call-with-input-file o get-string-all)))))))) + (o (derivation->output-path d))) + (with-derivation-substitute d c + (set-build-options s #:use-substitutes? #t) + (and (has-substitutes? s o) + (build-derivations s (list d)) + (equal? c (call-with-input-file o get-string-all))))))) (test-assert "substitute, corrupt output hash" ;; Tweak the substituter into installing a substitute whose hash doesn't @@ -376,33 +361,23 @@ `(mkdir %output) #:guile-for-build (package-derivation s %bootstrap-guile (%current-system)))) - (o (derivation->output-path d)) - (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") - (compose uri-path string->uri)))) - ;; Create fake substituter data, to be read by `substitute-binary'. - (with-derivation-narinfo d - (sha256 => (sha256 (string->utf8 c))) - - (call-with-output-file (string-append dir "/example.out") - (lambda (p) - (display "The contents here do not match C." p))) - (call-with-output-file (string-append dir "/example.nar") - (lambda (p) - (write-file (string-append dir "/example.out") p))) - - ;; Make sure we use `substitute-binary'. - (set-build-options s - #:use-substitutes? #t - #:fallback? #f) - (and (has-substitutes? s o) - (guard (c ((nix-protocol-error? c) - ;; XXX: the daemon writes "hash mismatch in downloaded - ;; path", but the actual error returned to the client - ;; doesn't mention that. - (pk 'corrupt c) - (not (zero? (nix-protocol-error-status c))))) - (build-derivations s (list d)) - #f)))))) + (o (derivation->output-path d))) + (with-derivation-substitute d c + (sha256 => (make-bytevector 32 0)) ;select a hash that doesn't match C + + ;; Make sure we use `substitute-binary'. + (set-build-options s + #:use-substitutes? #t + #:fallback? #f) + (and (has-substitutes? s o) + (guard (c ((nix-protocol-error? c) + ;; XXX: the daemon writes "hash mismatch in downloaded + ;; path", but the actual error returned to the client + ;; doesn't mention that. + (pk 'corrupt c) + (not (zero? (nix-protocol-error-status c))))) + (build-derivations s (list d)) + #f)))))) (test-assert "substitute --fallback" (with-store s |