Merge branch 'master' into core-updates

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))