Merge branch 'core-updates'

13 files changed, 189 insertions, 87 deletions

diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 46fe8ea2c0..61e6c44e63 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,8 +21,6 @@
 (define-module (test-build-utils)
   #:use-module (guix tests)
   #:use-module (guix build utils)
-  #:use-module ((gnu build bootloader)
-                #:select (invoke/quiet))
   #:use-module ((guix utils)
                 #:select (%current-system call-with-temporary-directory))
   #:use-module (gnu packages)
@@ -144,4 +143,105 @@
     (invoke/quiet "sh" "-c" "echo This is another error. >&2 ; false")
     #f))
 
+(let ((script-contents "\
+#!/anything/cabbage-bash-1.2.3/bin/sh
+
+echo hello world"))
+
+  (test-equal "wrap-script, simple case"
+    (string-append
+     (format #f "\
+#!GUILE --no-auto-compile
+#!#; Guix wrapper
+#\\-~s
+#\\-~s
+"
+             '(begin (let ((current (getenv "GUIX_FOO")))
+                       (setenv "GUIX_FOO"
+                               (if current
+                                   (string-append "/some/path:/some/other/path"
+                                                  ":" current)
+                                   "/some/path:/some/other/path"))))
+             '(let ((cl (command-line)))
+                (apply execl "/anything/cabbage-bash-1.2.3/bin/sh"
+                       (car cl)
+                       (cons (car cl)
+                             (append '("") cl)))))
+     script-contents)
+    (call-with-temporary-directory
+     (lambda (directory)
+       (let ((script-file-name (string-append directory "/foo")))
+         (call-with-output-file script-file-name
+           (lambda (port)
+             (format port script-contents)))
+         (chmod script-file-name #o777)
+
+         (mock ((guix build utils) which (const "GUILE"))
+               (wrap-script script-file-name
+                            `("GUIX_FOO" prefix ("/some/path"
+                                                 "/some/other/path"))))
+         (let ((str (call-with-input-file script-file-name get-string-all)))
+           (with-directory-excursion directory
+             (delete-file "foo"))
+           str))))))
+
+(let ((script-contents "\
+#!/anything/cabbage-bash-1.2.3/bin/python3 -and -args
+# vim:fileencoding=utf-8
+print('hello world')"))
+
+  (test-equal "wrap-script, with encoding declaration"
+    (string-append
+     (format #f "\
+#!MYGUILE --no-auto-compile
+#!#; # vim:fileencoding=utf-8
+#\\-~s
+#\\-~s
+"
+             '(begin (let ((current (getenv "GUIX_FOO")))
+                       (setenv "GUIX_FOO"
+                               (if current
+                                   (string-append "/some/path:/some/other/path"
+                                                  ":" current)
+                                   "/some/path:/some/other/path"))))
+             `(let ((cl (command-line)))
+                (apply execl "/anything/cabbage-bash-1.2.3/bin/python3"
+                       (car cl)
+                       (cons (car cl)
+                             (append '("" "-and" "-args") cl)))))
+     script-contents)
+    (call-with-temporary-directory
+     (lambda (directory)
+       (let ((script-file-name (string-append directory "/foo")))
+         (call-with-output-file script-file-name
+           (lambda (port)
+             (format port script-contents)))
+         (chmod script-file-name #o777)
+
+         (wrap-script script-file-name
+                      #:guile "MYGUILE"
+                      `("GUIX_FOO" prefix ("/some/path"
+                                           "/some/other/path")))
+         (let ((str (call-with-input-file script-file-name get-string-all)))
+           (with-directory-excursion directory
+             (delete-file "foo"))
+           str))))))
+
+(test-assert "wrap-script, raises condition"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (let ((script-file-name (string-append directory "/foo")))
+       (call-with-output-file script-file-name
+         (lambda (port)
+           (format port "This is not a script")))
+       (chmod script-file-name #o777)
+       (catch 'srfi-34
+         (lambda ()
+           (wrap-script script-file-name
+                        #:guile "MYGUILE"
+                        `("GUIX_FOO" prefix ("/some/path"
+                                             "/some/other/path"))))
+         (lambda (type obj)
+           (wrap-error? obj)))))))
+
 (test-end)
diff --git a/tests/builders.scm b/tests/builders.scm
index 8b8ef013e7..fdcf38ded3 100644
--- a/tests/builders.scm
+++ b/tests/builders.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, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,7 +28,8 @@
   #:use-module (gcrypt hash)
   #:use-module (guix tests)
   #:use-module ((guix packages)
-                #:select (package-derivation package-native-search-paths))
+                #:select (package?
+                          package-derivation package-native-search-paths))
   #:use-module (gnu packages bootstrap)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -39,23 +40,6 @@
 (define %store
   (open-connection-for-tests))
 
-(define %bootstrap-inputs
-  ;; Use the bootstrap inputs so it doesn't take ages to run these tests.
-  ;; This still involves building Make, Diffutils, and Findutils.
-  ;; XXX: We're relying on the higher-level `package-derivations' here.
-  (and %store
-       (map (match-lambda
-             ((name package)
-              (list name (package-derivation %store package))))
-            (@@ (gnu packages commencement) %boot0-inputs))))
-
-(define %bootstrap-search-paths
-  ;; Search path specifications that go with %BOOTSTRAP-INPUTS.
-  (append-map (match-lambda
-               ((name package _ ...)
-                (package-native-search-paths package)))
-              (@@ (gnu packages commencement) %boot0-inputs)))
-
 (define url-fetch*
   (store-lower url-fetch))
 
@@ -94,22 +78,4 @@
 (test-assert "gnu-build-system"
   (build-system? gnu-build-system))
 
-(when (or (not (network-reachable?)) (shebang-too-long?))
-  (test-skip 1))
-(test-assert "gnu-build"
-  (let* ((url      "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")
-         (hash     (nix-base32-string->bytevector
-                    "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
-         (tarball  (url-fetch* %store url 'sha256 hash
-                               #:guile %bootstrap-guile))
-         (build    (gnu-build %store "hello-2.8"
-                              `(("source" ,tarball)
-                                ,@%bootstrap-inputs)
-                              #:guile %bootstrap-guile
-                              #:search-paths %bootstrap-search-paths))
-         (out      (derivation->output-path build)))
-    (and (build-derivations %store (list (pk 'hello-drv build)))
-         (valid-path? %store out)
-         (file-exists? (string-append out "/bin/hello")))))
-
 (test-end "builders")
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 00cedef32c..6a7fad85b5 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -29,7 +29,6 @@
   #:use-module (guix tests http)
   #:use-module ((guix packages) #:select (package-derivation base32))
   #:use-module ((guix build utils) #:select (executable-file?))
-  #:use-module ((gnu packages) #:select (search-bootstrap-binary))
   #:use-module (gnu packages bootstrap)
   #:use-module ((gnu packages guile) #:select (guile-1.8))
   #:use-module (srfi srfi-1)
diff --git a/tests/grafts.scm b/tests/grafts.scm
index 6fd3d5e171..a12c6a5911 100644
--- a/tests/grafts.scm
+++ b/tests/grafts.scm
@@ -24,7 +24,6 @@
   #:use-module (guix utils)
   #:use-module (guix grafts)
   #:use-module (guix tests)
-  #:use-module ((gnu packages) #:select (search-bootstrap-binary))
   #:use-module (gnu packages bootstrap)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64)
diff --git a/tests/graph.scm b/tests/graph.scm
index c4c5096226..b7732ec709 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -153,9 +153,9 @@ edges."
                        (match nodes
                          (((labels names) ...)
                           names))))
-               (match %bootstrap-inputs
+               (match (%bootstrap-inputs)
                  (((labels packages) ...)
-                  (map package-full-name packages))))))))
+                  (map package-full-name (filter package? packages)))))))))
 
 (test-assert "bag DAG, including origins"
   (let-values (((backend nodes+edges) (make-recording-backend)))
diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh
index 78f82eafe2..758f18cc36 100644
--- a/tests/guix-daemon.sh
+++ b/tests/guix-daemon.sh
@@ -141,7 +141,7 @@ daemon_pid=$!
 
 GUIX_DAEMON_SOCKET="$socket" \
 guile -c '
-  (use-modules (guix) (gnu packages) (guix tests))
+  (use-modules (guix) (guix tests))
 
   (with-store store
     (let* ((build  (add-text-to-store store "build.sh"
@@ -165,7 +165,7 @@ kill "$daemon_pid"
 # honored.
 
 client_code='
-  (use-modules (guix) (gnu packages) (guix tests) (srfi srfi-34))
+  (use-modules (guix) (guix tests) (srfi srfi-34))
 
   (with-store store
     (let* ((build  (add-text-to-store store "build.sh"
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index a670db36be..fb1c1a022d 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -156,7 +156,7 @@ 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 --bootstrap --no-substitutes --search-paths --pure \
-         -e '(@@ (gnu packages commencement) gnu-make-boot0)' > "$tmpdir/a"
+         -e '(@ (guix tests) gnu-make-for-tests)' > "$tmpdir/a"
 
     # Make sure bootstrap binaries are in the profile.
     profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`
@@ -177,30 +177,15 @@ then
     # Make sure that the shell spawned with '--exec' sees the same environment
     # as returned by '--search-paths'.
     guix environment --bootstrap --no-substitutes --pure \
-         -e '(@@ (gnu packages commencement) gnu-make-boot0)' \
+         -e '(@ (guix tests) gnu-make-for-tests)' \
          -- /bin/sh -c 'echo $PATH $CPATH $LIBRARY_PATH' > "$tmpdir/b"
     ( . "$tmpdir/a" ; echo $PATH $CPATH $LIBRARY_PATH ) > "$tmpdir/c"
     cmp "$tmpdir/b" "$tmpdir/c"
 
     rm "$tmpdir"/*
 
-    # Compute the build environment for the initial GNU Findutils.
-    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=\"$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`"
+    make_boot0_debug="`guix build -e '(@ (guix tests) gnu-make-for-tests)' | grep -e -debug`"
     test "x$make_boot0_debug" != "x"
 
     # Make sure the "debug" output is not listed.
@@ -210,7 +195,7 @@ then
     # Compute the build environment for the initial GNU Make, but add in the
     # bootstrap Guile as an ad-hoc addition.
     guix environment --bootstrap --no-substitutes --search-paths --pure	\
-         -e '(@@ (gnu packages commencement) gnu-make-boot0)'		\
+         -e '(@ (guix tests) gnu-make-for-tests)'		\
          --ad-hoc guile-bootstrap > "$tmpdir/a"
     profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`
 
@@ -227,14 +212,14 @@ then
     # 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)
+(list (@ (guix tests) gnu-make-for-tests)
       (list (@ (gnu packages bootstrap) %bootstrap-guile) \"out\"))"
 
     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|'`
 
-    for dep in make-boot0 guile-bootstrap
+    for dep in make-test-boot0 guile-bootstrap
     do
 	guix gc --references "$profile" | grep "$dep"
     done
diff --git a/tests/guix-package-net.sh b/tests/guix-package-net.sh
index 82c346dd4c..48a94865e1 100644
--- a/tests/guix-package-net.sh
+++ b/tests/guix-package-net.sh
@@ -57,7 +57,7 @@ test -L "$profile" && test -L "$profile-1-link"
 ! test -f "$profile-2-link"
 test -f "$profile/bin/guile"
 
-boot_make="(@@ (gnu packages commencement) gnu-make-boot0)"
+boot_make="(@ (guix tests) gnu-make-for-tests)"
 boot_make_drv="`guix build -e "$boot_make" | grep -v -e -debug`"
 guix package --bootstrap -p "$profile" -i "$boot_make_drv"
 test -L "$profile-2-link"
diff --git a/tests/packages.scm b/tests/packages.scm
index 836d446657..423c5061aa 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,6 +37,7 @@
   #:use-module (guix build-system)
   #:use-module (guix build-system trivial)
   #:use-module (guix build-system gnu)
+  #:use-module (guix memoization)
   #:use-module (guix profiles)
   #:use-module (guix scripts package)
   #:use-module (gnu packages)
@@ -336,18 +338,55 @@
   ;; Here GNU-BUILD-SYSTEM adds implicit inputs that build only on
   ;; %SUPPORTED-SYSTEMS.  Thus the others must be ignored.
   (let ((p (dummy-package "foo"
+               (build-system gnu-build-system)
+               (supported-systems
+                `("does-not-exist" "foobar" ,@%supported-systems)))))
+    (parameterize ((%current-system "armhf-linux")) ; a traditionally-bootstrapped architecture
+      (package-transitive-supported-systems p))))
+
+(test-equal "package-transitive-supported-systems: reduced binary seed, implicit inputs"
+  '("x86_64-linux" "i686-linux")
+
+  ;; Here GNU-BUILD-SYSTEM adds implicit inputs that build only on
+  ;; %SUPPORTED-SYSTEMS.  Thus the others must be ignored.
+  (let ((p (dummy-package "foo"
              (build-system gnu-build-system)
              (supported-systems
               `("does-not-exist" "foobar" ,@%supported-systems)))))
-    (package-transitive-supported-systems p)))
+    (parameterize ((%current-system "x86_64-linux"))
+      (package-transitive-supported-systems p))))
 
 (test-assert "supported-package?"
-  (let ((p (dummy-package "foo"
-             (build-system gnu-build-system)
-             (supported-systems '("x86_64-linux" "does-not-exist")))))
+  (let* ((d (dummy-package "dep"
+              (build-system trivial-build-system)
+              (supported-systems '("x86_64-linux"))))
+         (p (dummy-package "foo"
+              (build-system gnu-build-system)
+              (inputs `(("d" ,d)))
+              (supported-systems '("x86_64-linux" "armhf-linux")))))
+    (and (supported-package? p "x86_64-linux")
+         (not (supported-package? p "i686-linux"))
+         (not (supported-package? p "armhf-linux")))))
+
+(test-assert "supported-package? vs. system-dependent graph"
+  ;; The inputs of a package can depend on (%current-system).  Thus,
+  ;; 'supported-package?' must make sure that it binds (%current-system)
+  ;; appropriately before traversing the dependency graph.  In the example
+  ;; below, 'supported-package?' must thus return true for both systems.
+  (let* ((p0a (dummy-package "foo-arm"
+                (build-system trivial-build-system)
+                (supported-systems '("armhf-linux"))))
+         (p0b (dummy-package "foo-x86_64"
+                (build-system trivial-build-system)
+                (supported-systems '("x86_64-linux"))))
+         (p   (dummy-package "bar"
+                (build-system trivial-build-system)
+                (inputs
+                 (if (string=? (%current-system) "armhf-linux")
+                     `(("foo" ,p0a))
+                     `(("foo" ,p0b)))))))
     (and (supported-package? p "x86_64-linux")
-         (not (supported-package? p "does-not-exist"))
-         (not (supported-package? p "i686-linux")))))
+         (supported-package? p "armhf-linux"))))
 
 (test-skip (if (not %store) 8 0))
 
@@ -918,9 +957,9 @@
 (when (or (not (network-reachable?)) (shebang-too-long?))
   (test-skip 1))
 (test-assert "GNU Make, bootstrap"
-  ;; GNU Make is the first program built during bootstrap; we choose it
-  ;; here so that the test doesn't last for too long.
-  (let ((gnu-make (@@ (gnu packages commencement) gnu-make-boot0)))
+  ;; GNU-MAKE-FOR-TESTS can be built cheaply; we choose it here so that the
+  ;; test doesn't last for too long.
+  (let ((gnu-make gnu-make-for-tests))
     (and (package? gnu-make)
          (or (location? (package-location gnu-make))
              (not (package-location gnu-make)))
diff --git a/tests/profiles.scm b/tests/profiles.scm
index eef93e24cf..a4e28672b5 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -239,11 +239,10 @@
 (unless (network-reachable?) (test-skip 1))
 (test-assertm "profile-derivation relative symlinks, two entries"
   (mlet* %store-monad
-      ((gnu-make-boot0 -> (@@ (gnu packages commencement) gnu-make-boot0))
-       (manifest -> (packages->manifest
-                     (list %bootstrap-guile gnu-make-boot0)))
+      ((manifest -> (packages->manifest
+                     (list %bootstrap-guile gnu-make-for-tests)))
        (guile       (package->derivation %bootstrap-guile))
-       (make        (package->derivation gnu-make-boot0))
+       (make        (package->derivation gnu-make-for-tests))
        (drv         (profile-derivation manifest
                                         #:relative-symlinks? #t
                                         #:hooks '()
diff --git a/tests/search-paths.scm b/tests/search-paths.scm
index 8dad424415..767a80b76c 100644
--- a/tests/search-paths.scm
+++ b/tests/search-paths.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,17 +29,17 @@
 
 (test-equal "evaluate-search-paths, separator is #f"
   (string-append %top-srcdir
-                 "/gnu/packages/bootstrap/aarch64-linux")
+                 "/gnu/packages/aux-files/linux-libre")
 
   ;; The following search path spec should evaluate to a single item: the
   ;; first directory that matches the "-linux$" pattern in
   ;; gnu/packages/bootstrap.
   (let ((spec (search-path-specification
                (variable "CHBOUIB")
-               (files '("gnu/packages/bootstrap"))
+               (files '("gnu/packages/aux-files"))
                (file-type 'directory)
                (separator #f)
-               (file-pattern "-linux$"))))
+               (file-pattern "^linux"))))
     (match (evaluate-search-paths (list spec)
                                   (list %top-srcdir))
       (((spec* . value))
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index eeb223b950..1b3121e503 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -567,6 +567,19 @@
   (let ((result (call-with-input-file "/var/run/utmpx" read-utmpx)))
     (or (utmpx? result) (eof-object? result))))
 
+(when (zero? (getuid))
+  (test-skip 1))
+(test-equal "add-to-entropy-count"
+  EPERM
+  (call-with-output-file "/dev/urandom"
+    (lambda (port)
+      (catch 'system-error
+        (lambda ()
+          (add-to-entropy-count port 77)
+          #f)
+        (lambda args
+          (system-error-errno args))))))
+
 (test-end)
 
 (false-if-exception (delete-file temp-file))
diff --git a/tests/union.scm b/tests/union.scm
index 5a6a4033fc..a8387edf42 100644
--- a/tests/union.scm
+++ b/tests/union.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -94,8 +95,9 @@
                          `(,name ,(package-derivation %store package))))
 
                        ;; Purposefully leave duplicate entries.
-                       (append %bootstrap-inputs
-                               (take %bootstrap-inputs 3))))
+                       (filter (compose package? cadr)
+                               (append %bootstrap-inputs-for-tests
+                                       (take %bootstrap-inputs-for-tests 3)))))
          (builder `(begin
                      (use-modules (guix build union))
                      (union-build (assoc-ref %outputs "out")