diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/challenge.scm | 6 | ||||
| -rw-r--r-- | tests/derivations.scm | 32 | ||||
| -rw-r--r-- | tests/graph.scm | 6 | ||||
| -rw-r--r-- | tests/packages.scm | 28 | ||||
| -rw-r--r-- | tests/store.scm | 8 |
5 files changed, 55 insertions, 25 deletions
diff --git a/tests/challenge.scm b/tests/challenge.scm index bb5633a3eb..9c6d6e0d58 100644 --- a/tests/challenge.scm +++ b/tests/challenge.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2017, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,7 +19,7 @@ (define-module (test-challenge) #:use-module (guix tests) #:use-module (guix tests http) - #:use-module (gcrypt hash) + #:use-module ((gcrypt hash) #:prefix gcrypt:) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix derivations) @@ -135,7 +135,7 @@ (mlet* %store-monad ((drv (gexp->derivation "something" #~(list #$output #$text))) (out -> (derivation->output-path drv)) - (hash -> (sha256 #vu8()))) + (hash -> (gcrypt:sha256 #vu8()))) (with-derivation-narinfo* drv (sha256 => hash) (>>= (compare-contents (list out) (%test-substitute-urls)) (match-lambda diff --git a/tests/derivations.scm b/tests/derivations.scm index a409fa99f0..9f1104a887 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -23,7 +23,7 @@ #:use-module (guix grafts) #:use-module (guix store) #:use-module (guix utils) - #:use-module (gcrypt hash) + #:use-module ((gcrypt hash) #:prefix gcrypt:) #:use-module (guix base32) #:use-module (guix tests) #:use-module (guix tests http) @@ -215,7 +215,7 @@ #:env-vars `(("url" . ,(object->string (%local-url)))) #:hash-algo 'sha256 - #:hash (sha256 (string->utf8 text))))) + #:hash (gcrypt:sha256 (string->utf8 text))))) (and (build-derivations %store (list drv)) (string=? (call-with-input-file (derivation->output-path drv) get-string-all) @@ -230,7 +230,7 @@ #:env-vars `(("url" . ,(object->string (%local-url)))) #:hash-algo 'sha256 - #:hash (sha256 (random-bytevector 100))))) ;wrong + #:hash (gcrypt:sha256 (random-bytevector 100))))) ;wrong (guard (c ((store-protocol-error? c) (string-contains (store-protocol-error-message c) "failed"))) (build-derivations %store (list drv)) @@ -245,7 +245,7 @@ #:env-vars `(("url" . ,(object->string (%local-url)))) #:hash-algo 'sha256 - #:hash (sha256 (random-bytevector 100))))) + #:hash (gcrypt:sha256 (random-bytevector 100))))) (guard (c ((store-protocol-error? c) (string-contains (store-protocol-error-message (pk c)) "failed"))) (build-derivations %store (list drv)) @@ -273,7 +273,7 @@ #:env-vars `(("url" . ,(object->string (%local-url)))) #:hash-algo 'sha256 - #:hash (sha256 (string->utf8 text))))) + #:hash (gcrypt:sha256 (string->utf8 text))))) (and (with-http-server `((200 ,text)) (build-derivations %store (list drv))) (with-http-server `((200 ,text)) @@ -317,7 +317,7 @@ (test-assert "fixed-output-derivation?" (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo -n hello > $out" '())) - (hash (sha256 (string->utf8 "hello"))) + (hash (gcrypt:sha256 (string->utf8 "hello"))) (drv (derivation %store "fixed" %bash `(,builder) #:sources (list builder) @@ -329,10 +329,10 @@ (map (lambda (hash-algorithm) (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo -n hello > $out" '())) - (sha256 (sha256 (string->utf8 "hello"))) - (hash (bytevector-hash + (sha256 (gcrypt:sha256 (string->utf8 "hello"))) + (hash (gcrypt:bytevector-hash (string->utf8 "hello") - (lookup-hash-algorithm hash-algorithm))) + (gcrypt:lookup-hash-algorithm hash-algorithm))) (drv (derivation %store (string-append "fixed-" (symbol->string hash-algorithm)) @@ -353,7 +353,7 @@ "echo -n hello > $out" '())) (builder2 (add-text-to-store %store "fixed-builder2.sh" "echo hey; echo -n hello > $out" '())) - (hash (sha256 (string->utf8 "hello"))) + (hash (gcrypt:sha256 (string->utf8 "hello"))) (drv1 (derivation %store "fixed" %bash `(,builder1) #:hash hash #:hash-algo 'sha256)) @@ -368,7 +368,7 @@ (test-assert "fixed-output derivation, recursive" (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo -n hello > $out" '())) - (hash (sha256 (string->utf8 "hello"))) + (hash (gcrypt:sha256 (string->utf8 "hello"))) (drv (derivation %store "fixed-rec" %bash `(,builder) #:sources (list builder) @@ -390,7 +390,7 @@ "echo -n hello > $out" '())) (builder2 (add-text-to-store %store "fixed-builder2.sh" "echo hey; echo -n hello > $out" '())) - (hash (sha256 (string->utf8 "hello"))) + (hash (gcrypt:sha256 (string->utf8 "hello"))) (fixed1 (derivation %store "fixed" %bash `(,builder1) #:hash hash #:hash-algo 'sha256)) @@ -427,7 +427,7 @@ "echo -n hello > $out" '())) (builder2 (add-text-to-store %store "fixed-builder2.sh" "echo hey; echo -n hello > $out" '())) - (hash (sha256 (string->utf8 "hello"))) + (hash (gcrypt:sha256 (string->utf8 "hello"))) (fixed1 (derivation %store "fixed" %bash `(,builder1) #:hash hash #:hash-algo 'sha256)) @@ -680,7 +680,7 @@ (let* ((value (getenv "GUIX_STATE_DIRECTORY")) (drv (derivation %store "leaked-env-vars" %bash '("-c" "echo -n $GUIX_STATE_DIRECTORY > $out") - #:hash (sha256 (string->utf8 value)) + #:hash (gcrypt:sha256 (string->utf8 value)) #:hash-algo 'sha256 #:sources (list %bash) #:leaked-env-vars '("GUIX_STATE_DIRECTORY")))) @@ -1106,7 +1106,7 @@ (builder2 '(call-with-output-file (pk 'difference-here! %output) (lambda (p) (write "hello" p)))) - (hash (sha256 (string->utf8 "hello"))) + (hash (gcrypt:sha256 (string->utf8 "hello"))) (input1 (build-expression->derivation %store "fixed" builder1 #:hash hash #:hash-algo 'sha256)) @@ -1127,7 +1127,7 @@ (builder2 '(call-with-output-file (pk 'difference-here! %output) (lambda (p) (write "hello" p)))) - (hash (sha256 (string->utf8 "hello"))) + (hash (gcrypt:sha256 (string->utf8 "hello"))) (input1 (build-expression->derivation %store "fixed" builder1 #:hash hash #:hash-algo 'sha256)) diff --git a/tests/graph.scm b/tests/graph.scm index 136260c7d1..0663d13b49 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -162,7 +162,11 @@ edges." (let-values (((backend nodes+edges) (make-recording-backend))) (let* ((m (lambda* (uri hash-type hash name #:key system) (text-file "foo-1.2.3.tar.gz" "This is a fake!"))) - (o (origin (method m) (uri "the-uri") (sha256 #vu8(0 1 2)))) + (o (origin + (method m) (uri "the-uri") + (sha256 + (base32 + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))) (p (dummy-package "p" (source o)))) (run-with-store %store (export-graph (list p) 'port diff --git a/tests/packages.scm b/tests/packages.scm index c528d2080c..4935d4503e 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -29,7 +29,7 @@ #:renamer (lambda (name) (cond ((eq? name 'location) 'make-location) (else name)))) - #:use-module (gcrypt hash) + #:use-module ((gcrypt hash) #:hide (sha256)) #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix grafts) @@ -51,6 +51,7 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (srfi srfi-64) + #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (ice-9 vlist) #:use-module (ice-9 regex) @@ -497,6 +498,31 @@ (search-path %load-path "guix/base32.scm") get-bytevector-all))))) +(test-equal "package-source-derivation, origin, sha512" + "hello" + (let* ((bash (search-bootstrap-binary "bash" (%current-system))) + (builder (add-text-to-store %store "my-fixed-builder.sh" + "echo -n hello > $out" '())) + (method (lambda* (url hash-algo hash #:optional name + #:rest rest) + (and (eq? hash-algo 'sha512) + (raw-derivation name bash (list builder) + #:sources (list builder) + #:hash hash + #:hash-algo hash-algo)))) + (source (origin + (method method) + (uri "unused://") + (file-name "origin-sha512") + (hash (content-hash + (bytevector-hash (string->utf8 "hello") + (hash-algorithm sha512)) + sha512)))) + (drv (package-source-derivation %store source)) + (output (derivation->output-path drv))) + (build-derivations %store (list drv)) + (call-with-input-file output get-string-all))) + (unless (network-reachable?) (test-skip 1)) (test-equal "package-source-derivation, snippet" "OK" diff --git a/tests/store.scm b/tests/store.scm index f007846dc1..06f7939657 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -22,7 +22,7 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix monads) - #:use-module (gcrypt hash) + #:use-module ((gcrypt hash) #:prefix gcrypt:) #:use-module (guix base32) #:use-module (guix packages) #:use-module (guix derivations) @@ -321,7 +321,7 @@ #:env-vars `(("t2" . ,t2)))) (o (derivation->output-path d))) (with-derivation-narinfo d - (sha256 => (sha256 (string->utf8 t2))) + (sha256 => (gcrypt:sha256 (string->utf8 t2))) (references => (list t2)) (equal? (references/substitutes s (list o t3 t2 t1)) @@ -940,7 +940,7 @@ (foldm %store-monad (lambda (item result) (define ref-hash - (let-values (((port get) (open-sha256-port))) + (let-values (((port get) (gcrypt:open-sha256-port))) (write-file item port) (close-port port) (get))) @@ -1144,7 +1144,7 @@ (info (query-path-info %store item))) (and (equal? (path-info-references info) (list ref)) (equal? (path-info-hash info) - (sha256 + (gcrypt:sha256 (string->utf8 (call-with-output-string (cut write-file item <>)))))))) |