summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-03-25 10:52:52 +0100
committerLudovic Courtès <ludo@gnu.org>2015-03-25 10:52:52 +0100
commit25d5b708a636ecf779035f75ad110574fc0262b9 (patch)
tree7d8429a59b7523d79790c5f4cdb5b96fabe8494e /tests
parent17287d7d47567aa1649250182e0f7ab11d5d55d1 (diff)
parent614c2188420a266ec512c9c04af3bb2ea46c4dc4 (diff)
downloadpatches-25d5b708a636ecf779035f75ad110574fc0262b9.tar
patches-25d5b708a636ecf779035f75ad110574fc0262b9.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/derivations.scm14
-rw-r--r--tests/gexp.scm23
-rw-r--r--tests/store.scm12
-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))