Merge branch 'master' into core-updates

8 files changed, 183 insertions, 16 deletions

diff --git a/tests/challenge.scm b/tests/challenge.scm
index 9505042a45..387d205a64 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -69,8 +69,15 @@
         (built-derivations (list drv))
         (mlet %store-monad ((hash (query-path-hash* out)))
           (with-derivation-narinfo* drv (sha256 => hash)
-            (>>= (discrepancies (list out) (%test-substitute-urls))
-                 (lift1 null? %store-monad))))))))
+            (>>= (compare-contents (list out) (%test-substitute-urls))
+                 (match-lambda
+                   ((report)
+                    (return
+                     (and (string=? out (comparison-report-item report))
+                          (bytevector=?
+                           (comparison-report-local-sha256 report)
+                           hash)
+                          (comparison-report-match? report))))))))))))
 
 (test-assertm "one discrepancy"
   (let ((text (random-text)))
@@ -90,20 +97,57 @@
                                                        (modulo (+ b 1) 128))
                                    w)))
           (with-derivation-narinfo* drv (sha256 => wrong-hash)
-            (>>= (discrepancies (list out) (%test-substitute-urls))
+            (>>= (compare-contents (list out) (%test-substitute-urls))
                  (match-lambda
-                   ((discrepancy)
+                   ((report)
                     (return
-                     (and (string=? out (discrepancy-item discrepancy))
+                     (and (string=? out (comparison-report-item (pk report)))
+                          (eq? 'mismatch (comparison-report-result report))
                           (bytevector=? hash
-                                        (discrepancy-local-sha256
-                                         discrepancy))
-                          (match (discrepancy-narinfos discrepancy)
+                                        (comparison-report-local-sha256
+                                         report))
+                          (match (comparison-report-narinfos report)
                             ((bad)
                              (bytevector=? wrong-hash
                                            (narinfo-hash->sha256
                                             (narinfo-hash bad))))))))))))))))
 
+(test-assertm "inconclusive: no substitutes"
+  (mlet* %store-monad ((drv  (gexp->derivation "foo" #~(mkdir #$output)))
+                       (out -> (derivation->output-path drv))
+                       (_    (built-derivations (list drv)))
+                       (hash (query-path-hash* out)))
+    (>>= (compare-contents (list out) (%test-substitute-urls))
+         (match-lambda
+           ((report)
+            (return
+             (and (string=? out (comparison-report-item report))
+                  (comparison-report-inconclusive? report)
+                  (null? (comparison-report-narinfos report))
+                  (bytevector=? (comparison-report-local-sha256 report)
+                                hash))))))))
+
+(test-assertm "inconclusive: no local build"
+  (let ((text (random-text)))
+    (mlet* %store-monad ((drv (gexp->derivation "something"
+                                                #~(list #$output #$text)))
+                         (out -> (derivation->output-path drv))
+                         (hash -> (sha256 #vu8())))
+      (with-derivation-narinfo* drv (sha256 => hash)
+        (>>= (compare-contents (list out) (%test-substitute-urls))
+             (match-lambda
+               ((report)
+                (return
+                 (and (string=? out (comparison-report-item report))
+                      (comparison-report-inconclusive? report)
+                      (not (comparison-report-local-sha256 report))
+                      (match (comparison-report-narinfos report)
+                        ((narinfo)
+                         (bytevector=? (narinfo-hash->sha256
+                                        (narinfo-hash narinfo))
+                                       hash))))))))))))
+
+
 (test-end)
 
 ;;; Local Variables:
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 2b5aa796d4..3fbfec3793 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -279,6 +279,27 @@
       (build-derivations %store (list drv))
       #f)))
 
+(unless (force %http-server-socket)
+  (test-skip 1))
+(test-assert "'download' built-in builder, check mode"
+  ;; Make sure rebuilding the 'builtin:download' derivation in check mode
+  ;; works.  See <http://bugs.gnu.org/25089>.
+  (let* ((text (random-text))
+         (drv (derivation %store "world"
+                          "builtin:download" '()
+                          #:env-vars `(("url"
+                                        . ,(object->string (%local-url))))
+                          #:hash-algo 'sha256
+                          #:hash (sha256 (string->utf8 text)))))
+    (and (with-http-server 200 text
+           (build-derivations %store (list drv)))
+         (with-http-server 200 text
+           (build-derivations %store (list drv)
+                              (build-mode check)))
+         (string=? (call-with-input-file (derivation->output-path drv)
+                     get-string-all)
+                   text))))
+
 (test-equal "derivation-name"
   "foo-0.0"
   (let ((drv (derivation %store "foo-0.0" %bash '())))
@@ -1109,3 +1130,7 @@
          (call-with-input-file out get-string-all))))
 
 (test-end)
+
+;; Local Variables:
+;; eval: (put 'with-http-server 'scheme-indent-function 2)
+;; End:
diff --git a/tests/file-systems.scm b/tests/file-systems.scm
index aed27e89c2..fd1599e132 100644
--- a/tests/file-systems.scm
+++ b/tests/file-systems.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,6 +17,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (test-file-systems)
+  #:use-module (guix store)
   #:use-module (gnu system file-systems)
   #:use-module (srfi srfi-64)
   #:use-module (rnrs bytevectors))
@@ -50,4 +51,25 @@
            (string-contains message "invalid UUID")
            (equal? form '(uuid "foobar"))))))
 
+(test-assert "file-system-needed-for-boot?"
+  (let-syntax ((dummy-fs (syntax-rules ()
+                           ((_ directory)
+                            (file-system
+                              (device "foo")
+                              (mount-point directory)
+                              (type "ext4"))))))
+    (parameterize ((%store-prefix "/gnu/guix/store"))
+      (and (file-system-needed-for-boot? (dummy-fs "/"))
+           (file-system-needed-for-boot? (dummy-fs "/gnu"))
+           (file-system-needed-for-boot? (dummy-fs "/gnu/guix"))
+           (file-system-needed-for-boot? (dummy-fs "/gnu/guix/store"))
+           (not (file-system-needed-for-boot?
+                 (dummy-fs "/gnu/guix/store/foo")))
+           (not (file-system-needed-for-boot? (dummy-fs "/gn")))
+           (not (file-system-needed-for-boot?
+                 (file-system
+                   (inherit (dummy-fs (%store-prefix)))
+                   (device "/foo")
+                   (flags '(bind-mount read-only)))))))))
+
 (test-end)
diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh
index 7122eed0e6..fde49e25a2 100644
--- a/tests/guix-daemon.sh
+++ b/tests/guix-daemon.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -118,3 +118,30 @@ guile -c "
                            (clear-failed-paths store (list out))
                            (null? (query-failed-paths store)))))))
     #:guile-for-build (%guile-for-build)) "
+
+kill "$daemon_pid"
+
+
+# Make sure the daemon's default 'build-cores' setting is honored.
+
+guix-daemon --listen="$socket" --disable-chroot --cores=42 &
+daemon_pid=$!
+
+GUIX_DAEMON_SOCKET="$socket" \
+guile -c '
+  (use-modules (guix) (gnu packages) (guix tests))
+
+  (with-store store
+    (let* ((build  (add-text-to-store store "build.sh"
+                                      "echo $NIX_BUILD_CORES > $out"))
+           (bash   (add-to-store store "bash" #t "sha256"
+                                 (search-bootstrap-binary "bash"
+                                                          (%current-system))))
+           (drv    (derivation store "the-thing" bash
+                               `("-e" ,build)
+                               #:inputs `((,bash) (,build))
+                               #:env-vars `(("x" . ,(random-text))))))
+      (and (build-derivations store (list drv))
+           (exit
+            (= 42 (pk (call-with-input-file (derivation->output-path drv)
+                        read)))))))'
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index 2b3bbfe036..9115949123 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -74,7 +74,12 @@ test `readlink "$gcroot"` = "$expected"
 guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
      -- guile -c 1
 test `readlink "$gcroot"` = "$expected"
+rm "$gcroot"
 
+# Same with an absolute file name.
+guix environment --bootstrap -r "$PWD/$gcroot" --ad-hoc guile-bootstrap \
+     -- guile -c 1
+test `readlink "$gcroot"` = "$expected"
 
 case "`uname -m`" in
     x86_64)
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 68a1946aa0..5ecb33193f 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 #
 # This file is part of GNU Guix.
@@ -39,6 +39,14 @@ trap 'rm -f "$profile" "$profile-"[0-9]* "$tmpfile"; rm -rf "$module_dir" t-home
 if guix package --bootstrap -e +;
 then false; else true; fi
 
+# Install a store item and make sure the version and output in the manifest
+# are correct.
+guix package --bootstrap -p "$profile" -i `guix build guile-bootstrap`
+test "`guix package -A guile-bootstrap | cut -f 1-2`" \
+     = "`guix package -p "$profile" -I | cut -f 1-2`"
+test "`guix package -p "$profile" -I | cut -f 3`" = "out"
+rm "$profile"
+
 guix package --bootstrap -p "$profile" -i guile-bootstrap
 test -L "$profile" && test -L "$profile-1-link"
 test -f "$profile/bin/guile"
diff --git a/tests/store.scm b/tests/store.scm
index 123ea8a787..983766d862 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, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -948,4 +948,29 @@
          (string=? (derivation-file-name d)
                    (path-info-deriver (query-path-info %store o))))))
 
+(test-equal "build-cores"
+  (list 0 42)
+  (with-store store
+    (let* ((build  (add-text-to-store store "build.sh"
+                                      "echo $NIX_BUILD_CORES > $out"))
+           (bash   (add-to-store store "bash" #t "sha256"
+                                 (search-bootstrap-binary "bash"
+                                                          (%current-system))))
+           (drv1   (derivation store "the-thing" bash
+                               `("-e" ,build)
+                               #:inputs `((,bash) (,build))
+                               #:env-vars `(("x" . ,(random-text)))))
+           (drv2   (derivation store "the-thing" bash
+                               `("-e" ,build)
+                               #:inputs `((,bash) (,build))
+                               #:env-vars `(("x" . ,(random-text))))))
+      (and (build-derivations store (list drv1))
+           (begin
+             (set-build-options store #:build-cores 42)
+             (build-derivations store (list drv2)))
+           (list (call-with-input-file (derivation->output-path drv1)
+                   read)
+                 (call-with-input-file (derivation->output-path drv2)
+                   read))))))
+
 (test-end "store")
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index e4ef32c522..fb2c8e7100 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -441,6 +441,17 @@
   (> (terminal-columns (open-input-string "Join us now, share the software!"))
      0))
 
+(test-assert "utmpx-entries"
+  (match (utmpx-entries)
+    (((? utmpx? entries) ...)
+     (every (lambda (entry)
+              (match (utmpx-user entry)
+                ((? string?)
+                 (> (utmpx-pid entry) 0))
+                (#f                               ;might be DEAD_PROCESS
+                 #t)))
+            entries))))
+
 (test-end)
 
 (false-if-exception (delete-file temp-file))