diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-12-13 22:20:08 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-12-19 23:25:00 +0100 |
commit | 6d955f1731dc593a51625b455882102a67d95e1a (patch) | |
tree | 2cd7629c194c6e4f724ddd819e1ad88b877b3a11 | |
parent | f6f6e1efeecd553c3af4c31695b17fb69849967b (diff) | |
download | guix-6d955f1731dc593a51625b455882102a67d95e1a.tar guix-6d955f1731dc593a51625b455882102a67d95e1a.tar.gz |
tests: Check the build trace for hash mismatches on substitutes.
* tests/store.scm ("substitute, corrupt output hash, build trace"): New
test.
-rw-r--r-- | tests/store.scm | 55 |
1 files changed, 55 insertions, 0 deletions
diff --git a/tests/store.scm b/tests/store.scm index 38051bf5e5..7f1ec51875 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -787,6 +787,61 @@ (build-derivations s (list d)) #f)))))) +(test-assert "substitute, corrupt output hash, build trace" + ;; Likewise, and check the build trace. + (with-store s + (let* ((c "hello, world") ; contents of the output + (d (build-expression->derivation + s "corrupt-substitute" + `(mkdir %output) + #:guile-for-build + (package-derivation s %bootstrap-guile (%current-system)))) + (o (derivation->output-path d))) + ;; Make sure we use 'guix substitute'. + (set-build-options s + #:print-build-trace #t + #:use-substitutes? #t + #:fallback? #f + #:substitute-urls (%test-substitute-urls)) + + (with-derivation-substitute d c + (sha256 => (make-bytevector 32 0)) ;select a hash that doesn't match C + + (define output + (call-with-output-string + (lambda (port) + (parameterize ((current-build-output-port port)) + (guard (c ((store-protocol-error? c) #t)) + (build-derivations s (list d)) + #f))))) + + (define actual-hash + (let-values (((port get-hash) + (gcrypt:open-hash-port + (gcrypt:hash-algorithm gcrypt:sha256)))) + (write-file-tree "foo" port + #:file-type+size + (lambda _ + (values 'regular (string-length c))) + #:file-port + (lambda _ + (open-input-string c))) + (close-port port) + (bytevector->nix-base32-string (get-hash)))) + + (define expected-hash + (bytevector->nix-base32-string (make-bytevector 32 0))) + + (define mismatch + (string-append "@ hash-mismatch " o " sha256 " + expected-hash " " actual-hash "\n")) + + (define failure + (string-append "@ substituter-failed " o)) + + (and (string-contains output mismatch) + (string-contains output failure)))))) + (test-assert "substitute --fallback" (with-store s (let* ((t (random-text)) ; contents of the output |