diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/accounts.scm | 4 | ||||
| -rw-r--r-- | tests/guix-environment-container.sh | 12 | ||||
| -rw-r--r-- | tests/pack.scm | 8 | ||||
| -rw-r--r-- | tests/records.scm | 58 | ||||
| -rw-r--r-- | tests/scripts.scm | 1 |
5 files changed, 77 insertions, 6 deletions
diff --git a/tests/accounts.scm b/tests/accounts.scm index 127861042d..923ba7dc83 100644 --- a/tests/accounts.scm +++ b/tests/accounts.scm @@ -199,12 +199,10 @@ nobody:!:0::::::\n")) (directory "/var/empty"))) (allocate-passwd (list (user-account (name "alice") (comment "Alice") - (home-directory "/home/alice") (shell "/bin/sh") (group "users")) (user-account (name "bob") (comment "Bob") - (home-directory "/home/bob") (shell "/bin/gash") (group "wheel")) (user-account (name "sshd") (system? #t) @@ -234,12 +232,10 @@ nobody:!:0::::::\n")) (directory "/home/charlie"))) (allocate-passwd (list (user-account (name "alice") (comment "Alice") - (home-directory "/home/alice") (shell "/bin/sh") ;ignored (group "users")) (user-account (name "charlie") (comment "Charlie") - (home-directory "/home/charlie") (shell "/bin/sh") (group "users"))) (list (group-entry (name "users") (gid 1000))) diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh index a2da9a0773..f2221af95b 100644 --- a/tests/guix-environment-container.sh +++ b/tests/guix-environment-container.sh @@ -44,6 +44,18 @@ else test $? = 42 fi +if test "x$USER" = "x"; then USER="`id -un`"; fi + +# Check whether /etc/passwd and /etc/group are valid. +guix environment -C --ad-hoc --bootstrap guile-bootstrap \ + -- guile -c "(exit (string=? \"$USER\" (passwd:name (getpwuid (getuid)))))" +guix environment -C --ad-hoc --bootstrap guile-bootstrap \ + -- guile -c '(exit (string? (group:name (getgrgid (getgid)))))' +guix environment -C --ad-hoc --bootstrap guile-bootstrap \ + -- guile -c '(use-modules (srfi srfi-1)) + (exit (every group:name + (map getgrgid (vector->list (getgroups)))))' + # Make sure file-not-found errors in mounts are reported. if guix environment --container --ad-hoc --bootstrap guile-bootstrap \ --expose=/does-not-exist -- guile -c 1 2> "$tmpdir/error" diff --git a/tests/pack.scm b/tests/pack.scm index 40473a9fe9..ea88cd89f2 100644 --- a/tests/pack.scm +++ b/tests/pack.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. @@ -206,7 +206,11 @@ (file-exists? "var/guix/db/db.sqlite") (string=? (string-append #$%bootstrap-guile "/bin") (pk 'binlink (readlink bin))) - (string=? (string-append #$profile "/bin") + + ;; This is a relative symlink target. + (string=? (string-drop + (string-append #$profile "/bin") + 1) (pk 'guilelink (readlink "bin")))) (mkdir #$output)))))))) (built-derivations (list check))))) diff --git a/tests/records.scm b/tests/records.scm index d9469a78bd..16b7a9c35e 100644 --- a/tests/records.scm +++ b/tests/records.scm @@ -170,6 +170,64 @@ (parameterize ((mark (cons 'a 'b))) (eq? (foo-bar y) (mark))))))) +(test-assert "define-record-type* & thunked & this-record" + (begin + (define-record-type* <foo> foo make-foo + foo? + (bar foo-bar) + (baz foo-baz (thunked))) + + (let ((x (foo (bar 40) + (baz (+ (foo-bar this-record) 2))))) + (and (= 40 (foo-bar x)) + (= 42 (foo-baz x)))))) + +(test-assert "define-record-type* & thunked & default & this-record" + (begin + (define-record-type* <foo> foo make-foo + foo? + (bar foo-bar) + (baz foo-baz (thunked) + (default (+ (foo-bar this-record) 2)))) + + (let ((x (foo (bar 40)))) + (and (= 40 (foo-bar x)) + (= 42 (foo-baz x)))))) + +(test-assert "define-record-type* & thunked & inherit & this-record" + (begin + (define-record-type* <foo> foo make-foo + foo? + (bar foo-bar) + (baz foo-baz (thunked) + (default (+ (foo-bar this-record) 2)))) + + (let* ((x (foo (bar 40))) + (y (foo (inherit x) (bar -2))) + (z (foo (inherit x) (baz -2)))) + (and (= -2 (foo-bar y)) + (= 0 (foo-baz y)) + (= 40 (foo-bar z)) + (= -2 (foo-baz z)))))) + +(test-assert "define-record-type* & thunked & inherit & custom this" + (let () + (define-record-type* <foo> foo make-foo + foo? this-foo + (thing foo-thing (thunked))) + (define-record-type* <bar> bar make-bar + bar? this-bar + (baz bar-baz (thunked))) + + ;; Nest records and test the two self references. + (let* ((x (foo (thing (bar (baz (list this-bar this-foo)))))) + (y (foo-thing x))) + (match (bar-baz y) + ((first second) + (and (eq? second x) + (bar? first) + (eq? first y))))))) + (test-assert "define-record-type* & delayed" (begin (define-record-type* <foo> foo make-foo diff --git a/tests/scripts.scm b/tests/scripts.scm index efee271197..0315642f38 100644 --- a/tests/scripts.scm +++ b/tests/scripts.scm @@ -19,6 +19,7 @@ (define-module (test-scripts) #:use-module (guix scripts) + #:use-module (guix tests) #:use-module ((guix scripts build) #:select (%standard-build-options)) #:use-module (srfi srfi-64)) |