Merge branch 'master' into python-tests

13 files changed, 343 insertions, 25 deletions

diff --git a/tests/bournish.scm b/tests/bournish.scm
index 0f529ce42f..3b40ce2643 100644
--- a/tests/bournish.scm
+++ b/tests/bournish.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,5 +39,16 @@
   (read-and-compile (open-input-string "cd /foo\npwd\nls")
                     #:from %bournish-language #:to 'scheme))
 
+(test-equal "rm"
+  '(for-each delete-file (list "foo" "bar"))
+  (read-and-compile (open-input-string "rm foo bar\n")
+                    #:from %bournish-language #:to 'scheme))
+
+(test-equal "rm -r"
+  '(for-each (@ (guix build utils) delete-file-recursively)
+             (list "/foo" "/bar"))
+  (read-and-compile (open-input-string "rm -r /foo /bar\n")
+                    #:from %bournish-language #:to 'scheme))
+
 (test-end "bournish")
 
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/containers.scm b/tests/containers.scm
index 745b56b710..0b3a4be12b 100644
--- a/tests/containers.scm
+++ b/tests/containers.scm
@@ -180,4 +180,31 @@
     (lambda ()
       (primitive-exit 42))))
 
+(skip-if-unsupported)
+(test-assert "container-excursion*"
+  (call-with-temporary-directory
+   (lambda (root)
+     (define (namespaces pid)
+       (let ((pid (number->string pid)))
+         (map (lambda (ns)
+                (readlink (string-append "/proc/" pid "/ns/" ns)))
+              '("user" "ipc" "uts" "net" "pid" "mnt"))))
+
+     (let* ((pid    (run-container root '()
+                                   %namespaces 1
+                                   (lambda ()
+                                     (sleep 100))))
+            (result (container-excursion* pid
+                      (lambda ()
+                        (namespaces 1)))))
+       (kill pid SIGKILL)
+       (equal? result (namespaces pid))))))
+
+(skip-if-unsupported)
+(test-equal "container-excursion*, same namespaces"
+  42
+  (container-excursion* (getpid)
+    (lambda ()
+      (* 6 7))))
+
 (test-end)
diff --git a/tests/cpan.scm b/tests/cpan.scm
index 0c28a74d3e..8b588517c9 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -72,7 +72,7 @@
                    test-source)
                   (_ (error "Unexpected URL: " url))))))))
         (mock ((guix http-client) http-fetch
-               (lambda (url)
+               (lambda (url . rest)
                  (match url
                    ("https://api.metacpan.org/release/Foo-Bar"
                     (values (open-input-string test-json)
diff --git a/tests/crate.scm b/tests/crate.scm
index 0bb344bb8a..eb93822bbb 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -65,7 +65,7 @@
 (test-assert "crate->guix-package"
   ;; Replace network resources with sample data.
   (mock ((guix http-client) http-fetch
-         (lambda (url)
+         (lambda (url . rest)
            (match url
              ("https://crates.io/api/v1/crates/foo"
               (open-input-string test-crate))
diff --git a/tests/file-systems.scm b/tests/file-systems.scm
index aed27e89c2..467ee8ca5d 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,8 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (test-file-systems)
+  #:use-module (guix store)
+  #:use-module (guix modules)
   #:use-module (gnu system file-systems)
   #:use-module (srfi srfi-64)
   #:use-module (rnrs bytevectors))
@@ -50,4 +52,32 @@
            (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-assert "does not pull (guix config)"
+  ;; This module is meant both for the host side and "build side", so make
+  ;; sure it doesn't pull in (guix config), which depends on the user's
+  ;; config.
+  (not (member '(guix config)
+               (source-module-closure '((gnu system file-systems))))))
+
 (test-end)
diff --git a/tests/gem.scm b/tests/gem.scm
index 669cd8ee60..a39e8ba514 100644
--- a/tests/gem.scm
+++ b/tests/gem.scm
@@ -47,7 +47,7 @@
 (test-assert "gem->guix-package"
   ;; Replace network resources with sample data.
   (mock ((guix http-client) http-fetch
-         (lambda (url)
+         (lambda (url . rest)
            (match url
              ("https://rubygems.org/api/v1/gems/foo.json"
               (values (open-input-string test-json)
diff --git a/tests/grafts.scm b/tests/grafts.scm
index 6454a03b1f..08f05c0f75 100644
--- a/tests/grafts.scm
+++ b/tests/grafts.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>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -43,6 +43,9 @@
 (define %mkdir
   (bootstrap-binary "mkdir"))
 
+(define make-derivation-input
+  (@@ (guix derivations) make-derivation-input))
+
 
 (test-begin "grafts")
 
@@ -241,7 +244,18 @@
                 (replacement p1r)
                 (replacement-output "ONE")))
          (p3d (graft-derivation %store p3 (list p1g))))
-    (and (build-derivations %store (list p3d))
+
+    (and (not (find (lambda (input)
+                      ;; INPUT should not be P2:zzz since the result of P3
+                      ;; does not depend on it.  See
+                      ;; <http://bugs.gnu.org/24886>.
+                      (and (string=? (derivation-input-path input)
+                                     (derivation-file-name p2))
+                           (member "zzz"
+                                   (derivation-input-sub-derivations input))))
+                    (derivation-inputs p3d)))
+
+         (build-derivations %store (list p3d))
          (let ((out (derivation->output-path (pk 'p2d p3d))))
            (and (not (string=? (readlink out)
                                (derivation->output-path p2 "aaa")))
@@ -249,6 +263,106 @@
                           (readlink (string-append out "/two")))
                 (file-exists? (string-append out "/one/replacement")))))))
 
+(test-assert "graft-derivation with #:outputs"
+  ;; Call 'graft-derivation' with a narrowed set of outputs passed as
+  ;; #:outputs.
+  (let* ((p1  (build-expression->derivation
+               %store "p1"
+               `(let ((one (assoc-ref %outputs "one"))
+                      (two (assoc-ref %outputs "two")))
+                  (mkdir one)
+                  (mkdir two))
+               #:outputs '("one" "two")))
+         (p1r (build-expression->derivation
+               %store "P1"
+               `(let ((other (assoc-ref %outputs "ONE")))
+                  (mkdir other)
+                  (call-with-output-file (string-append other "/replacement")
+                    (const #t)))
+               #:outputs '("ONE")))
+         (p2  (build-expression->derivation
+               %store "p2"
+               `(let ((aaa (assoc-ref %outputs "aaa"))
+                      (zzz (assoc-ref %outputs "zzz")))
+                  (mkdir zzz) (chdir zzz)
+                  (mkdir aaa) (chdir aaa)
+                  (symlink (assoc-ref %build-inputs "p1:two") "two"))
+               #:outputs '("aaa" "zzz")
+               #:inputs `(("p1:one" ,p1 "one")
+                          ("p1:two" ,p1 "two"))))
+         (p1g (graft
+                (origin p1)
+                (origin-output "one")
+                (replacement p1r)
+                (replacement-output "ONE")))
+         (p2g (graft-derivation %store p2 (list p1g)
+                                #:outputs '("aaa"))))
+    ;; P2:aaa depends on P1:two, but not on P1:one, so nothing to graft.
+    (eq? p2g p2)))
+
+(test-equal "graft-derivation, unused outputs not depended on"
+  '("aaa")
+
+  ;; Make sure that the result of 'graft-derivation' does not pull outputs
+  ;; that are irrelevant to the grafting process.  See
+  ;; <http://bugs.gnu.org/24886>.
+  (let* ((p1  (build-expression->derivation
+               %store "p1"
+               `(let ((one (assoc-ref %outputs "one"))
+                      (two (assoc-ref %outputs "two")))
+                  (mkdir one)
+                  (mkdir two))
+               #:outputs '("one" "two")))
+         (p1r (build-expression->derivation
+               %store "P1"
+               `(let ((other (assoc-ref %outputs "ONE")))
+                  (mkdir other)
+                  (call-with-output-file (string-append other "/replacement")
+                    (const #t)))
+               #:outputs '("ONE")))
+         (p2  (build-expression->derivation
+               %store "p2"
+               `(let ((aaa (assoc-ref %outputs "aaa"))
+                      (zzz (assoc-ref %outputs "zzz")))
+                  (mkdir zzz) (chdir zzz)
+                  (symlink (assoc-ref %build-inputs "p1:two") "two")
+                  (mkdir aaa) (chdir aaa)
+                  (symlink (assoc-ref %build-inputs "p1:one") "one"))
+               #:outputs '("aaa" "zzz")
+               #:inputs `(("p1:one" ,p1 "one")
+                          ("p1:two" ,p1 "two"))))
+         (p1g (graft
+                (origin p1)
+                (origin-output "one")
+                (replacement p1r)
+                (replacement-output "ONE")))
+         (p2g (graft-derivation %store p2 (list p1g)
+                                #:outputs '("aaa"))))
+
+    ;; Here P2G should only depend on P1:one and P1R:one; it must not depend
+    ;; on P1:two or P1R:two since these are unused in the grafting process.
+    (and (not (eq? p2g p2))
+         (let* ((inputs      (derivation-inputs p2g))
+                (match-input (lambda (drv)
+                               (lambda (input)
+                                 (string=? (derivation-input-path input)
+                                           (derivation-file-name drv)))))
+                (p1-inputs   (filter (match-input p1) inputs))
+                (p1r-inputs  (filter (match-input p1r) inputs))
+                (p2-inputs   (filter (match-input p2) inputs)))
+           (and (equal? p1-inputs
+                        (list (make-derivation-input (derivation-file-name p1)
+                                                     '("one"))))
+                (equal? p1r-inputs
+                        (list
+                         (make-derivation-input (derivation-file-name p1r)
+                                                '("ONE"))))
+                (equal? p2-inputs
+                        (list
+                         (make-derivation-input (derivation-file-name p2)
+                                                '("aaa"))))
+                (derivation-output-names p2g))))))
+
 (test-assert "graft-derivation, renaming"         ;<http://bugs.gnu.org/23132>
   (let* ((build `(begin
                    (use-modules (guix build utils))
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/pypi.scm b/tests/pypi.scm
index f26e7fea13..28cc115a9d 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -22,6 +22,7 @@
   #:use-module (guix base32)
   #:use-module (guix hash)
   #:use-module (guix tests)
+  #:use-module (guix build-system python)
   #:use-module ((guix build utils) #:select (delete-file-recursively which))
   #:use-module (srfi srfi-64)
   #:use-module (ice-9 match))
@@ -90,6 +91,15 @@ baz > 13.37")
                            (uri
                             "https://pypi.python.org/packages/a2/3b/4756e6a0ceb14e084042a2a65c615d68d25621c6fd446d0fc10d14c4ce7d/certbot-0.8.1.tar.gz"))))))
 
+(test-equal "guix-package->pypi-name, several URLs"
+  "cram"
+  (guix-package->pypi-name
+   (dummy-package "foo"
+                  (source
+                   (dummy-origin
+                    (uri (list "https://bitheap.org/cram/cram-0.7.tar.gz"
+                               (pypi-uri "cram" "0.7"))))))))
+
 (test-assert "pypi->guix-package"
   ;; Replace network resources with sample data.
     (mock ((guix import utils) url-fetch
@@ -108,7 +118,7 @@ baz > 13.37")
                ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f)
                (_ (error "Unexpected URL: " url)))))
           (mock ((guix http-client) http-fetch
-                 (lambda (url)
+                 (lambda (url . rest)
                    (match url
                      ("https://pypi.python.org/pypi/foo/json"
                       (values (open-input-string test-json)
@@ -130,8 +140,7 @@ baz > 13.37")
                      ('propagated-inputs
                       ('quasiquote
                        (("python-bar" ('unquote 'python-bar))
-                        ("python-baz" ('unquote 'python-baz))
-                        ("python-setuptools" ('unquote 'python-setuptools)))))
+                        ("python-baz" ('unquote 'python-baz)))))
                      ('home-page "http://example.com")
                      ('synopsis "summary")
                      ('description "summary")
@@ -172,7 +181,7 @@ baz > 13.37")
                  (delete-file-recursively "foo-1.0.0.dist-info")))
              (_ (error "Unexpected URL: " url)))))
         (mock ((guix http-client) http-fetch
-               (lambda (url)
+               (lambda (url . rest)
                  (match url
                    ("https://pypi.python.org/pypi/foo/json"
                     (values (open-input-string test-json)
@@ -194,8 +203,7 @@ baz > 13.37")
                    ('propagated-inputs
                     ('quasiquote
                      (("python-bar" ('unquote 'python-bar))
-                      ("python-baz" ('unquote 'python-baz))
-                      ("python-setuptools" ('unquote 'python-setuptools)))))
+                      ("python-baz" ('unquote 'python-baz)))))
                    ('home-page "http://example.com")
                    ('synopsis "summary")
                    ('description "summary")
diff --git a/tests/store.scm b/tests/store.scm
index 123ea8a787..64d3553f25 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.
 ;;;
@@ -92,6 +92,11 @@
 
 (test-skip (if %store 0 13))
 
+(test-equal "add-data-to-store"
+  #vu8(1 2 3 4 5)
+  (call-with-input-file (add-data-to-store %store "data" #vu8(1 2 3 4 5))
+    get-bytevector-all))
+
 (test-assert "valid-path? live"
   (let ((p (add-text-to-store %store "hello" "hello, world")))
     (valid-path? %store p)))
@@ -948,4 +953,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..8db45b41b6 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,27 @@
   (> (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?)
+                 (or (eqv? (login-type BOOT_TIME) (utmpx-login-type entry))
+                     (> (utmpx-pid entry) 0)))
+                (#f                               ;might be DEAD_PROCESS
+                 #t)))
+            entries))))
+
+(test-assert "read-utmpx, EOF"
+  (eof-object? (read-utmpx (%make-void-port "r"))))
+
+(unless (access? "/var/run/utmpx" O_RDONLY)
+  (test-skip 1))
+(test-assert "read-utmpx"
+  (let ((result (call-with-input-file "/var/run/utmpx" read-utmpx)))
+    (or (utmpx? result) (eof-object? result))))
+
 (test-end)
 
 (false-if-exception (delete-file temp-file))