summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/bournish.scm12
-rw-r--r--tests/challenge.scm62
-rw-r--r--tests/containers.scm27
-rw-r--r--tests/cpan.scm2
-rw-r--r--tests/crate.scm2
-rw-r--r--tests/file-systems.scm32
-rw-r--r--tests/gem.scm2
-rw-r--r--tests/grafts.scm118
-rw-r--r--tests/guix-daemon.sh29
-rw-r--r--tests/guix-environment.sh7
-rw-r--r--tests/pypi.scm20
-rw-r--r--tests/store.scm32
-rw-r--r--tests/syscalls.scm23
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))