Merge branch 'master' into core-updates

7 files changed, 183 insertions, 77 deletions

diff --git a/tests/derivations.scm b/tests/derivations.scm
index db96e26ab1..9b53019cc5 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -929,40 +929,6 @@
                                     ((p2 . _)
                                      (string<? p1 p2)))))))))))))
 
-
-(test-assert "graft-derivation"
-  (let* ((build `(begin
-                   (mkdir %output)
-                   (chdir %output)
-                   (symlink %output "self")
-                   (call-with-output-file "text"
-                     (lambda (output)
-                       (format output "foo/~a/bar" ,%mkdir)))
-                   (symlink ,%bash "sh")))
-         (orig  (build-expression->derivation %store "graft" build
-                                              #:inputs `(("a" ,%bash)
-                                                         ("b" ,%mkdir))))
-         (one   (add-text-to-store %store "bash" "fake bash"))
-         (two   (build-expression->derivation %store "mkdir"
-                                              '(call-with-output-file %output
-                                                 (lambda (port)
-                                                   (display "fake mkdir" port)))))
-         (graft (graft-derivation %store "graft" orig
-                                  (list (graft
-                                          (origin %bash)
-                                          (replacement one))
-                                        (graft
-                                          (origin %mkdir)
-                                          (replacement two))))))
-    (and (build-derivations %store (list graft))
-         (let ((two   (derivation->output-path two))
-               (graft (derivation->output-path graft)))
-           (and (string=? (format #f "foo/~a/bar" two)
-                          (call-with-input-file (string-append graft "/text")
-                            get-string-all))
-                (string=? (readlink (string-append graft "/sh")) one)
-                (string=? (readlink (string-append graft "/self")) graft))))))
-
 (test-equal "map-derivation"
   "hello"
   (let* ((joke (package-derivation %store guile-1.8))
diff --git a/tests/grafts.scm b/tests/grafts.scm
new file mode 100644
index 0000000000..4a4122a3e9
--- /dev/null
+++ b/tests/grafts.scm
@@ -0,0 +1,81 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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-grafts)
+  #:use-module (guix derivations)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (guix grafts)
+  #:use-module (guix tests)
+  #:use-module ((gnu packages) #:select (search-bootstrap-binary))
+  #:use-module (srfi srfi-64)
+  #:use-module (rnrs io ports))
+
+(define %store
+  (open-connection-for-tests))
+
+(define (bootstrap-binary name)
+  (let ((bin (search-bootstrap-binary name (%current-system))))
+    (and %store
+         (add-to-store %store name #t "sha256" bin))))
+
+(define %bash
+  (bootstrap-binary "bash"))
+(define %mkdir
+  (bootstrap-binary "mkdir"))
+
+
+(test-begin "grafts")
+
+(test-assert "graft-derivation"
+  (let* ((build `(begin
+                   (mkdir %output)
+                   (chdir %output)
+                   (symlink %output "self")
+                   (call-with-output-file "text"
+                     (lambda (output)
+                       (format output "foo/~a/bar" ,%mkdir)))
+                   (symlink ,%bash "sh")))
+         (orig  (build-expression->derivation %store "graft" build
+                                              #:inputs `(("a" ,%bash)
+                                                         ("b" ,%mkdir))))
+         (one   (add-text-to-store %store "bash" "fake bash"))
+         (two   (build-expression->derivation %store "mkdir"
+                                              '(call-with-output-file %output
+                                                 (lambda (port)
+                                                   (display "fake mkdir" port)))))
+         (graft (graft-derivation %store orig
+                                  (list (graft
+                                          (origin %bash)
+                                          (replacement one))
+                                        (graft
+                                          (origin %mkdir)
+                                          (replacement two))))))
+    (and (build-derivations %store (list graft))
+         (let ((two   (derivation->output-path two))
+               (graft (derivation->output-path graft)))
+           (and (string=? (format #f "foo/~a/bar" two)
+                          (call-with-input-file (string-append graft "/text")
+                            get-string-all))
+                (string=? (readlink (string-append graft "/sh")) one)
+                (string=? (readlink (string-append graft "/self")) graft))))))
+
+(test-end)
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh
index 703ab31d27..aba34a3bd0 100644
--- a/tests/guix-environment-container.sh
+++ b/tests/guix-environment-container.sh
@@ -73,7 +73,7 @@ guix environment --container --ad-hoc --bootstrap guile-bootstrap \
      -- guile -c "$mount_test_code" > $tmpdir/mounts
 
 cat "$tmpdir/mounts"
-test `wc -l < $tmpdir/mounts` -eq 3
+test `wc -l < $tmpdir/mounts` -eq 4
 
 current_dir="`cd $PWD; pwd -P`"
 grep -e "$current_dir$" $tmpdir/mounts # current directory
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index aed27c103c..5ad8dfa82a 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -34,17 +34,23 @@ mkdir "$tmpdir"
 export SHELL
 
 # Check the environment variables for the bootstrap Guile.
-guix environment --ad-hoc guile-bootstrap --pure --search-paths > "$tmpdir/a"
-guix environment --ad-hoc guile-bootstrap:out --pure --search-paths > "$tmpdir/b"
+guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
+     --search-paths > "$tmpdir/a"
+guix environment --bootstrap --ad-hoc guile-bootstrap:out --pure \
+     --search-paths > "$tmpdir/b"
 
 # $PATH must appear in the search paths, and nothing else.
-grep -E '^export PATH=.*guile-bootstrap-[0-9.]+/bin' "$tmpdir/a"
+grep -E '^export PATH=.*profile/bin' "$tmpdir/a"
 test "`wc -l < "$tmpdir/a"`" = 1
 
+# Guile must be on $PATH.
+test -x `sed -r 's/^export PATH="(.*)"/\1/' "$tmpdir/a"`/guile
+
 cmp "$tmpdir/a" "$tmpdir/b"
 
 # Make sure the exit value is preserved.
-if guix environment --ad-hoc guile-bootstrap --pure -- guile -c '(exit 42)'
+if guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
+        -- guile -c '(exit 42)'
 then
     false
 else
@@ -52,7 +58,8 @@ else
 fi
 
 # Same as above, but with deprecated -E flag.
-if guix environment --ad-hoc guile-bootstrap --pure -E "guile -c '(exit 42)'"
+if guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
+        -E "guile -c '(exit 42)'"
 then
     false
 else
@@ -62,22 +69,29 @@ fi
 if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
 then
     # Compute the build environment for the initial GNU Make.
-    guix environment -e '(@@ (gnu packages commencement) gnu-make-boot0)' \
-	 --no-substitutes --search-paths --pure > "$tmpdir/a"
+    guix environment --bootstrap --no-substitutes --search-paths --pure \
+         -e '(@@ (gnu packages commencement) gnu-make-boot0)' > "$tmpdir/a"
+
+    # Make sure bootstrap binaries are in the profile.
+    profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`
 
     # Make sure the bootstrap binaries are all listed where they belong.
-    grep -E '^export PATH=.*-bootstrap-binaries-0/bin'      "$tmpdir/a"
-    grep -E '^export CPATH=.*-gcc-bootstrap-0/include'      "$tmpdir/a"
-    grep -E '^export CPATH=.*-glibc-bootstrap-0/include'    "$tmpdir/a"
-    grep -E '^export LIBRARY_PATH=.*-glibc-bootstrap-0/lib' "$tmpdir/a"
+    grep -E "^export PATH=\"$profile/bin\""         "$tmpdir/a"
+    grep -E "^export CPATH=\"$profile/include\""    "$tmpdir/a"
+    grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a"
+    for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0
+    do
+	guix gc --references "$profile" | grep "$dep"
+    done
 
     # 'make-boot0' itself must not be listed.
-    if grep "make-boot0" "$tmpdir/a"; then false; else true; fi
+    if guix gc --references "$profile" | grep make-boot0
+    then false; else true; fi
 
     # Make sure that the shell spawned with '--exec' sees the same environment
     # as returned by '--search-paths'.
-    guix environment -e '(@@ (gnu packages commencement) gnu-make-boot0)'	\
-	 --no-substitutes --pure						\
+    guix environment --bootstrap --no-substitutes --pure \
+         -e '(@@ (gnu packages commencement) gnu-make-boot0)' \
          -- /bin/sh -c 'echo $PATH $CPATH $LIBRARY_PATH' > "$tmpdir/b"
     ( . "$tmpdir/a" ; echo $PATH $CPATH $LIBRARY_PATH ) > "$tmpdir/c"
     cmp "$tmpdir/b" "$tmpdir/c"
@@ -85,45 +99,57 @@ then
     rm "$tmpdir"/*
 
     # Compute the build environment for the initial GNU Findutils.
-    guix environment -e '(@@ (gnu packages commencement) findutils-boot0)' \
-	 --no-substitutes --search-paths --pure > "$tmpdir/a"
+    guix environment --bootstrap --no-substitutes --search-paths --pure \
+         -e '(@@ (gnu packages commencement) findutils-boot0)' > "$tmpdir/a"
+    profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`
 
     # Make sure the bootstrap binaries are all listed where they belong.
-    grep -E '^export PATH=.*-bootstrap-binaries-0/bin'      "$tmpdir/a"
-    grep -E '^export PATH=.*-make-boot0-[0-9.]+/bin'        "$tmpdir/a"
-    grep -E '^export CPATH=.*-gcc-bootstrap-0/include'      "$tmpdir/a"
-    grep -E '^export CPATH=.*-glibc-bootstrap-0/include'    "$tmpdir/a"
-    grep -E '^export LIBRARY_PATH=.*-glibc-bootstrap-0/lib' "$tmpdir/a"
+    grep -E "^export PATH=\"$profile/bin\""         "$tmpdir/a"
+    grep -E "^export CPATH=\"$profile/include\""    "$tmpdir/a"
+    grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a"
+    for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0 \
+				    make-boot0
+    do
+	guix gc --references "$profile" | grep "$dep"
+    done
 
     # The following test assumes 'make-boot0' has a "debug" output.
     make_boot0_debug="`guix build -e '(@@ (gnu packages commencement) gnu-make-boot0)' | grep -e -debug`"
     test "x$make_boot0_debug" != "x"
 
     # Make sure the "debug" output is not listed.
-    if grep -E "$make_boot0_debug" "$tmpdir/a"; then false; else true; fi
+    if guix gc --references "$profile" | grep "$make_boot0_debug"
+    then false; else true; fi
 
     # Compute the build environment for the initial GNU Make, but add in the
     # bootstrap Guile as an ad-hoc addition.
-    guix environment -e '(@@ (gnu packages commencement) gnu-make-boot0)' \
-         --ad-hoc guile-bootstrap --no-substitutes --search-paths \
-         --pure > "$tmpdir/a"
+    guix environment --bootstrap --no-substitutes --search-paths --pure	\
+         -e '(@@ (gnu packages commencement) gnu-make-boot0)'		\
+         --ad-hoc guile-bootstrap > "$tmpdir/a"
+    profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`
 
     # Make sure the bootstrap binaries are all listed where they belong.
-    cat $tmpdir/a
-    grep -E '^export PATH=.*-bootstrap-binaries-0/bin'      "$tmpdir/a"
-    grep -E '^export PATH=.*-guile-bootstrap-2.0/bin'       "$tmpdir/a"
-    grep -E '^export CPATH=.*-gcc-bootstrap-0/include'      "$tmpdir/a"
-    grep -E '^export CPATH=.*-glibc-bootstrap-0/include'    "$tmpdir/a"
-    grep -E '^export LIBRARY_PATH=.*-glibc-bootstrap-0/lib' "$tmpdir/a"
-
-    # Make sure a package list can be used with -e.
+    grep -E "^export PATH=\"$profile/bin\""         "$tmpdir/a"
+    grep -E "^export CPATH=\"$profile/include\""    "$tmpdir/a"
+    grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a"
+    for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0 \
+				    guile-bootstrap
+    do
+	guix gc --references "$profile" | grep "$dep"
+    done
+
+    # Make sure a package list with plain package objects and package+output
+    # tuples can be used with -e.
     expr_list_test_code="
 (list (@@ (gnu packages commencement) gnu-make-boot0)
-      (@ (gnu packages bootstrap) %bootstrap-guile))"
+      (list (@ (gnu packages bootstrap) %bootstrap-guile) \"out\"))"
 
-    guix environment --ad-hoc --no-substitutes --search-paths --pure \
-         -e "$expr_list_test_code" > "$tmpdir/a"
+    guix environment --bootstrap --ad-hoc --no-substitutes --search-paths \
+         --pure -e "$expr_list_test_code" > "$tmpdir/a"
+    profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`
 
-    grep -E '^export PATH=.*-make-boot0-4.1/bin'      "$tmpdir/a"
-    grep -E '^export PATH=.*-guile-bootstrap-2.0/bin' "$tmpdir/a"
+    for dep in make-boot0 guile-bootstrap
+    do
+	guix gc --references "$profile" | grep "$dep"
+    done
 fi
diff --git a/tests/packages.scm b/tests/packages.scm
index 9d37fb68d6..6315c2204f 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +29,7 @@
   #:use-module (guix hash)
   #:use-module (guix derivations)
   #:use-module (guix packages)
+  #:use-module (guix grafts)
   #:use-module (guix search-paths)
   #:use-module (guix build-system)
   #:use-module (guix build-system trivial)
@@ -615,7 +616,7 @@
          (guile (package-derivation %store (canonical-package guile-2.0)
                                     #:graft? #f)))
     (equal? (package-derivation %store dummy)
-            (graft-derivation %store "dummy-0"
+            (graft-derivation %store
                               (package-derivation %store dummy #:graft? #f)
                               (package-grafts %store dummy)
 
diff --git a/tests/publish.scm b/tests/publish.scm
index 0b92390900..6c710fe0a7 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -112,6 +112,14 @@ References: ~a~%"
        (call-with-input-string nar (cut restore-file <> temp)))
      (call-with-input-file temp read-string))))
 
+(test-equal "/nar/invalid"
+  404
+  (begin
+    (call-with-output-file (string-append (%store-prefix) "/invalid")
+      (lambda (port)
+        (display "This file is not a valid store item." port)))
+    (response-code (http-get (publish-uri (string-append "/nar/invalid"))))))
+
 (test-end "publish")
 
 
diff --git a/tests/store.scm b/tests/store.scm
index 394c06bc0f..de070eab23 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -837,6 +837,15 @@
          (file (add %store "foo" "Lowered.")))
     (call-with-input-file file get-string-all)))
 
+(test-equal "current-system"
+  "bar"
+  (parameterize ((%current-system "frob"))
+    (run-with-store %store
+      (mbegin %store-monad
+        (set-current-system "bar")
+        (current-system))
+      #:system "foo")))
+
 (test-assert "query-path-info"
   (let* ((ref (add-text-to-store %store "ref" "foo"))
          (item (add-text-to-store %store "item" "bar" (list ref)))
@@ -847,6 +856,21 @@
                   (string->utf8
                    (call-with-output-string (cut write-file item <>))))))))
 
+(test-assert "path-info-deriver"
+  (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
+         (s (add-to-store %store "bash" #t "sha256"
+                          (search-bootstrap-binary "bash"
+                                                   (%current-system))))
+         (d (derivation %store "the-thing"
+                        s `("-e" ,b)
+                        #:env-vars `(("foo" . ,(random-text)))
+                        #:inputs `((,b) (,s))))
+         (o (derivation->output-path d)))
+    (and (build-derivations %store (list d))
+         (not (path-info-deriver (query-path-info %store b)))
+         (string=? (derivation-file-name d)
+                   (path-info-deriver (query-path-info %store o))))))
+
 (test-end "store")