diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/derivations.scm | 14 | ||||
| -rw-r--r-- | tests/gexp.scm | 23 | ||||
| -rw-r--r-- | tests/store.scm | 12 | ||||
| -rw-r--r-- | tests/substitute.scm (renamed from tests/substitute-binary.scm) | 58 |
4 files changed, 72 insertions, 35 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm index 72d253c465..a8cccac34a 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -499,6 +499,20 @@ (string=? path (derivation-file-name (%guile-for-build))))) (derivation-prerequisites drv)))) +(test-assert "derivation-prerequisites and derivation-input-is-valid?" + (let* ((a (build-expression->derivation %store "a" '(mkdir %output))) + (b (build-expression->derivation %store "b" `(list ,(random-text)))) + (c (build-expression->derivation %store "c" `(mkdir %output) + #:inputs `(("a" ,a) ("b" ,b))))) + (build-derivations %store (list a)) + (match (derivation-prerequisites c + (cut valid-derivation-input? %store + <>)) + ((($ <derivation-input> file ("out"))) + (string=? file (derivation-file-name b))) + (x + (pk 'fail x #f))))) + (test-assert "build-expression->derivation without inputs" (let* ((builder '(begin (mkdir %output) diff --git a/tests/gexp.scm b/tests/gexp.scm index 4c31e22f15..0540969503 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -160,6 +160,12 @@ (equal? `(list ,guile ,cu ,libc ,bu) (gexp->sexp* exp target))))) +(test-equal "ungexp + ungexp-native, nested" + (list `((,%bootstrap-guile "out")) '<> `((,coreutils "out"))) + (let* ((exp (gexp (list (ungexp-native (gexp (ungexp coreutils))) + (ungexp %bootstrap-guile))))) + (list (gexp-inputs exp) '<> (gexp-native-inputs exp)))) + (test-assert "input list" (let ((exp (gexp (display '(ungexp (list %bootstrap-guile coreutils))))) @@ -497,6 +503,23 @@ (list "out" %bootstrap-guile)))) (built-derivations (list drv)))) +(test-assertm "gexp->derivation #:allowed-references, specific output" + (mlet* %store-monad ((in (gexp->derivation "thing" + #~(begin + (mkdir #$output:ok) + (mkdir #$output:not-ok)))) + (drv (gexp->derivation "allowed-refs" + #~(begin + (pk #$in:not-ok) + (mkdir #$output) + (chdir #$output) + (symlink #$output "self") + (symlink #$in:ok "ok")) + #:allowed-references + (list "out" + (gexp-input in "ok"))))) + (built-derivations (list drv)))) + (test-assert "gexp->derivation #:allowed-references, disallowed" (let ((drv (run-with-store %store (gexp->derivation "allowed-refs" diff --git a/tests/store.scm b/tests/store.scm index 9ed78be085..f778c2086d 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -367,15 +367,15 @@ (with-store s (let* ((d (package-derivation s %bootstrap-guile (%current-system))) (o (derivation->output-path d))) - ;; Create fake substituter data, to be read by `substitute-binary'. + ;; Create fake substituter data, to be read by 'guix substitute'. (with-derivation-narinfo d ;; Remove entry from the local cache. (false-if-exception (delete-file (string-append (getenv "XDG_CACHE_HOME") - "/guix/substitute-binary/" + "/guix/substitute/" (store-path-hash-part o)))) - ;; Make sure `substitute-binary' correctly communicates the above + ;; Make sure 'guix substitute' correctly communicates the above ;; data. (set-build-options s #:use-substitutes? #t) (and (has-substitutes? s o) @@ -439,7 +439,7 @@ (with-derivation-substitute d c (sha256 => (make-bytevector 32 0)) ;select a hash that doesn't match C - ;; Make sure we use `substitute-binary'. + ;; Make sure we use 'guix substitute'. (set-build-options s #:use-substitutes? #t #:fallback? #f) @@ -464,9 +464,9 @@ #:guile-for-build (package-derivation s %bootstrap-guile (%current-system)))) (o (derivation->output-path d))) - ;; Create fake substituter data, to be read by `substitute-binary'. + ;; Create fake substituter data, to be read by 'guix substitute'. (with-derivation-narinfo d - ;; Make sure we use `substitute-binary'. + ;; Make sure we use 'guix substitute'. (set-build-options s #:use-substitutes? #t) (and (has-substitutes? s o) (guard (c ((nix-protocol-error? c) diff --git a/tests/substitute-binary.scm b/tests/substitute.scm index 7c1204c1ab..85698127fa 100644 --- a/tests/substitute-binary.scm +++ b/tests/substitute.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,8 +17,8 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. -(define-module (test-substitute-binary) - #:use-module (guix scripts substitute-binary) +(define-module (test-substitute) + #:use-module (guix scripts substitute) #:use-module (guix base64) #:use-module (guix hash) #:use-module (guix serialization) @@ -95,7 +95,7 @@ version identifier.." -(test-begin "substitute-binary") +(test-begin "substitute") (test-quit "not a number" "signature version" @@ -132,7 +132,7 @@ a file for NARINFO." "GUIX_BINARY_SUBSTITUTE_URL")) uri-path)) (cache-directory (string-append (getenv "XDG_CACHE_HOME") - "/guix/substitute-binary/"))) + "/guix/substitute/"))) (dynamic-wind (lambda () (when (file-exists? cache-directory) @@ -156,7 +156,7 @@ a file for NARINFO." (cute write-file (string-append narinfo-directory "/example.out") <>)) - (set! (@@ (guix scripts substitute-binary) + (set! (@@ (guix scripts substitute) %allow-unauthenticated-substitutes?) #f)) thunk @@ -166,8 +166,8 @@ a file for NARINFO." (define-syntax-rule (with-narinfo narinfo body ...) (call-with-narinfo narinfo (lambda () body ...))) -;; Transmit these options to 'guix substitute-binary'. -(set! (@@ (guix scripts substitute-binary) %cache-url) +;; Transmit these options to 'guix substitute'. +(set! (@@ (guix scripts substitute) %cache-url) (getenv "GUIX_BINARY_SUBSTITUTE_URL")) (test-equal "query narinfo without signature" @@ -180,7 +180,7 @@ a file for NARINFO." (with-input-from-string (string-append "have " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (lambda () - (guix-substitute-binary "--query")))))))) + (guix-substitute "--query")))))))) (test-equal "query narinfo with invalid hash" ;; The hash in the signature differs from the hash of %NARINFO. @@ -195,7 +195,7 @@ a file for NARINFO." (with-input-from-string (string-append "have " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (lambda () - (guix-substitute-binary "--query")))))))) + (guix-substitute "--query")))))))) (test-equal "query narinfo signed with authorized key" (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") @@ -209,7 +209,7 @@ a file for NARINFO." (with-input-from-string (string-append "have " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (lambda () - (guix-substitute-binary "--query")))))))) + (guix-substitute "--query")))))))) (test-equal "query narinfo signed with unauthorized key" "" ; not substitutable @@ -225,15 +225,15 @@ a file for NARINFO." (with-input-from-string (string-append "have " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (lambda () - (guix-substitute-binary "--query")))))))) + (guix-substitute "--query")))))))) (test-quit "substitute, no signature" "lacks a signature" (with-narinfo %narinfo - (guix-substitute-binary "--substitute" - (string-append (%store-prefix) - "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") - "foo"))) + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "foo"))) (test-quit "substitute, invalid hash" "hash" @@ -241,10 +241,10 @@ a file for NARINFO." (with-narinfo (string-append %narinfo "Signature: " (signature-field "different body") "\n") - (guix-substitute-binary "--substitute" - (string-append (%store-prefix) - "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") - "foo"))) + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "foo"))) (test-quit "substitute, unauthorized key" "unauthorized" @@ -253,10 +253,10 @@ a file for NARINFO." %narinfo #:public-key %wrong-public-key) "\n") - (guix-substitute-binary "--substitute" - (string-append (%store-prefix) - "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") - "foo"))) + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "foo"))) (test-equal "substitute, authorized key" "Substitutable data." @@ -265,15 +265,15 @@ a file for NARINFO." (dynamic-wind (const #t) (lambda () - (guix-substitute-binary "--substitute" - (string-append (%store-prefix) - "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") - "substitute-retrieved") + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "substitute-retrieved") (call-with-input-file "substitute-retrieved" get-string-all)) (lambda () (false-if-exception (delete-file "substitute-retrieved")))))) -(test-end "substitute-binary") +(test-end "substitute") (exit (= (test-runner-fail-count (test-runner-current)) 0)) |