diff options
| -rw-r--r-- | guix/derivations.scm | 10 | ||||
| -rw-r--r-- | tests/derivations.scm | 40 |
2 files changed, 46 insertions, 4 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm index 354ec20e3f..0bb6a28147 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012-2021, 2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org> ;;; ;;; This file is part of GNU Guix. @@ -484,17 +484,21 @@ things as appropriate and is thus more efficient." (fold-right (lambda (output result) (match output ((name path "" "") + ;; Regular derivation. (alist-cons name (make-derivation-output path #f #f #f) result)) ((name path hash-algo hash) - ;; fixed-output + ;; Fixed-output, unless HASH is the empty string (in that + ;; case, HASH-ALGO must be preserved despite being + ;; unused). (let* ((rec? (string-prefix? "r:" hash-algo)) (algo (string->symbol (if rec? (string-drop hash-algo 2) hash-algo))) - (hash (base16-string->bytevector hash))) + (hash (and (not (string-null? hash)) + (base16-string->bytevector hash)))) (alist-cons name (make-derivation-output path algo hash rec?) diff --git a/tests/derivations.scm b/tests/derivations.scm index 3912fd31d8..3d25365b14 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -256,6 +256,21 @@ (build-derivations %store (list drv)) #f))) +(test-assert "'download' built-in builder, no fixed-output hash" + ;; 'guix perform-download' should bail out with a message saying "not a + ;; fixed-output derivation". + (with-http-server '((200 "This should not be downloaded.")) + (let* ((drv (derivation %store "download-without-hash" + "builtin:download" '() + #:env-vars `(("url" + . ,(object->string (%local-url)))) + #:hash-algo 'sha256 + #:hash #f))) + (guard (c ((store-protocol-error? c) + (string-contains (store-protocol-error-message c) "failed"))) + (build-derivations %store (list drv)) + #f)))) + (test-assert "'download' built-in builder, check mode" ;; Make sure rebuilding the 'builtin:download' derivation in check mode ;; works. See <http://bugs.gnu.org/25089>. @@ -316,6 +331,13 @@ #:hash hash #:hash-algo 'sha256))) (fixed-output-derivation? drv))) +(test-assert "fixed-output-derivation?, no hash" + ;; A derivation that has #:hash-algo and #:hash #f is *not* fixed-output. + (let* ((drv (derivation %store "not-quite-fixed" + "builtin:download" '() + #:hash #f #:hash-algo 'sha256))) + (not (fixed-output-derivation? drv)))) + (test-equal "fixed-output derivation" '(sha1 sha256 sha512) (map (lambda (hash-algorithm) @@ -543,6 +565,22 @@ read-derivation))) (equal? drv* drv))) +(test-assert "read-derivation with hash = #f" + ;; Passing #:hash-algo together with #:hash #f is accepted and #:hash-algo + ;; is preserved. However it is not a fixed-output derivation. It used to + ;; be that 'read-derivation' would incorrectly return #vu8() instead of #f + ;; for the hash in this case: + ;; <https://lists.gnu.org/archive/html/guix-devel/2023-01/msg00040.html>. + (let* ((drv1 (derivation %store "almost-fixed-output" + "builtin:download" '() + #:env-vars `(("url" . "http://example.org")) + #:hash-algo 'sha256 + #:hash #f)) + (drv2 (call-with-input-file (derivation-file-name drv1) + read-derivation))) + (and (not (eq? drv1 drv2)) ;ensure memoization doesn't kick in + (equal? drv1 drv2)))) + (test-assert "multiple-output derivation, derivation-path->output-path" (let* ((builder (add-text-to-store %store "builder.sh" "echo one > $out ; echo two > $second" |