aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/accounts.scm10
-rw-r--r--tests/containers.scm11
-rw-r--r--tests/guix-build.sh14
-rw-r--r--tests/guix-environment-container.sh27
-rw-r--r--tests/guix-gc.sh6
-rw-r--r--tests/guix-package-aliases.sh60
-rw-r--r--tests/pack.scm8
-rw-r--r--tests/records.scm58
-rw-r--r--tests/scripts.scm1
-rw-r--r--tests/store-roots.scm53
-rw-r--r--tests/zlib.scm7
11 files changed, 239 insertions, 16 deletions
diff --git a/tests/accounts.scm b/tests/accounts.scm
index 127861042d..673dd42432 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)
@@ -227,25 +225,23 @@ nobody:!:0::::::\n"))
;; Make sure bits of state are preserved: UID, no reuse of previously-used
;; UIDs, and shell.
(list (password-entry (name "alice") (uid 1234) (gid 1000)
- (real-name "Alice Smith") (shell "/gnu/.../bin/gash")
+ (real-name "Alice Smith") (shell "/bin/sh")
(directory "/home/alice"))
(password-entry (name "charlie") (uid 1236) (gid 1000)
(real-name "Charlie") (shell "/bin/sh")
(directory "/home/charlie")))
(allocate-passwd (list (user-account (name "alice")
(comment "Alice")
- (home-directory "/home/alice")
- (shell "/bin/sh") ;ignored
+ (shell "/bin/sh") ;honored
(group "users"))
(user-account (name "charlie")
(comment "Charlie")
- (home-directory "/home/charlie")
(shell "/bin/sh")
(group "users")))
(list (group-entry (name "users") (gid 1000)))
(list (password-entry (name "alice") (uid 1234) (gid 9999)
(real-name "Alice Smith")
- (shell "/gnu/.../bin/gash")
+ (shell "/gnu/.../bin/gash") ;ignored
(directory "/home/alice"))
(password-entry (name "bob") (uid 1235) (gid 1001)
(real-name "Bob") (shell "/bin/sh")
diff --git a/tests/containers.scm b/tests/containers.scm
index 5323e5037d..37408f380d 100644
--- a/tests/containers.scm
+++ b/tests/containers.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -52,6 +53,16 @@
#:namespaces '(user))))
(skip-if-unsupported)
+(test-assert "call-with-container, user namespace, guest UID/GID"
+ (zero?
+ (call-with-container '()
+ (lambda ()
+ (assert-exit (and (= 42 (getuid)) (= 77 (getgid)))))
+ #:guest-uid 42
+ #:guest-gid 77
+ #:namespaces '(user))))
+
+(skip-if-unsupported)
(test-assert "call-with-container, uts namespace"
(zero?
(call-with-container '()
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 66bf6be8d0..63a9fe68da 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -44,6 +44,13 @@ guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'
guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'; \
then exit 1; fi )
+# Passing one '-s' flag.
+test `guix build sed -s x86_64-linux -d | wc -l` = 1
+
+# Passing multiple '-s' flags.
+all_systems="-s x86_64-linux -s i686-linux -s armhf-linux -s aarch64-linux"
+test `guix build sed $all_systems -d | sort -u | wc -l` = 4
+
# Check --sources option with its arguments
module_dir="t-guix-build-$$"
mkdir "$module_dir"
@@ -183,6 +190,13 @@ then false; else true; fi
rm -f "$result"
+# Check relative file name canonicalization: <https://bugs.gnu.org/35271>.
+mkdir "$result"
+guix build -r "$result/x" -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'
+test -x "$result/x/bin/guile"
+rm "$result/x"
+rmdir "$result"
+
# Cross building.
guix build coreutils --target=mips64el-linux-gnu --dry-run --no-substitutes
diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh
index a2da9a0773..78507f76c0 100644
--- a/tests/guix-environment-container.sh
+++ b/tests/guix-environment-container.sh
@@ -44,6 +44,31 @@ else
test $? = 42
fi
+# By default, the UID inside the container should be the same as outside.
+uid="`id -u`"
+inner_uid="`guix environment -C --ad-hoc --bootstrap guile-bootstrap \
+ -- guile -c '(display (getuid))'`"
+test $inner_uid = $uid
+
+# When '--user' is passed, the UID should be 1000. (Note: Use a separate HOME
+# so that we don't run into problems when the test directory is under /home.)
+export tmpdir
+inner_uid="`HOME=$tmpdir guix environment -C --ad-hoc --bootstrap guile-bootstrap \
+ --user=gnu-guix -- guile -c '(display (getuid))'`"
+test $inner_uid = 1000
+
+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"
@@ -111,7 +136,7 @@ rm $tmpdir/mounts
# Test that user can be mocked.
usertest='(exit (and (string=? (getenv "HOME") "/home/foognu")
- (string=? (passwd:name (getpwuid 0)) "foognu")
+ (string=? (passwd:name (getpwuid 1000)) "foognu")
(file-exists? "/home/foognu/umock")))'
touch "$tmpdir/umock"
HOME="$tmpdir" guix environment --bootstrap --container --user=foognu \
diff --git a/tests/guix-gc.sh b/tests/guix-gc.sh
index ef2d9543b7..8284287730 100644
--- a/tests/guix-gc.sh
+++ b/tests/guix-gc.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2013, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2013, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@@ -34,7 +34,7 @@ unset drv
unset out
# For some operations, passing extra arguments is an error.
-for option in "" "-C 500M" "--verify" "--optimize"
+for option in "" "-C 500M" "--verify" "--optimize" "--list-roots"
do
if guix gc $option whatever; then false; else true; fi
done
@@ -69,6 +69,8 @@ guix gc --delete "$drv"
drv="`guix build --root=guix-gc-root lsh -d`"
test -f "$drv" && test -L guix-gc-root
+guix gc --list-roots | grep "$PWD/guix-gc-root"
+
guix gc --list-live | grep "$drv"
if guix gc --delete "$drv";
then false; else true; fi
diff --git a/tests/guix-package-aliases.sh b/tests/guix-package-aliases.sh
new file mode 100644
index 0000000000..5c68664093
--- /dev/null
+++ b/tests/guix-package-aliases.sh
@@ -0,0 +1,60 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test the `guix package' aliases.
+#
+
+guix install --version
+
+readlink_base ()
+{
+ basename `readlink "$1"`
+}
+
+profile="t-profile-$$"
+rm -f "$profile"
+
+trap 'rm -f "$profile" "$profile-"[0-9]*' EXIT
+
+guix install --bootstrap guile-bootstrap -p "$profile"
+test -x "$profile/bin/guile"
+
+# Make sure '-r' isn't passed as-is to 'guix package'.
+if guix install -r guile-bootstrap -p "$profile" --bootstrap
+then false; else true; fi
+test -x "$profile/bin/guile"
+
+guix upgrade --version
+guix upgrade -n
+guix upgrade gui.e -n
+if guix upgrade foo bar -n;
+then false; else true; fi
+
+guix remove --version
+guix remove --bootstrap guile-bootstrap -p "$profile"
+! test -x "$profile/bin/guile"
+test `guix package -p "$profile" -I | wc -l` -eq 0
+
+if guix remove -p "$profile" this-is-not-installed --bootstrap
+then false; else true; fi
+
+if guix remove -i guile-bootstrap -p "$profile" --bootstrap
+then false; else true; fi
+
+guix search '\<board\>' game | grep '^name: gnubg'
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))
diff --git a/tests/store-roots.scm b/tests/store-roots.scm
new file mode 100644
index 0000000000..5bcf1bc87e
--- /dev/null
+++ b/tests/store-roots.scm
@@ -0,0 +1,53 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-store-deduplication)
+ #:use-module (guix tests)
+ #:use-module (guix store)
+ #:use-module (guix store roots)
+ #:use-module ((guix utils) #:select (call-with-temporary-directory))
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-64))
+
+(define %store
+ (open-connection))
+
+(test-begin "store-roots")
+
+(test-assert "gc-roots, regular root"
+ (let* ((item (add-text-to-store %store "something"
+ (random-text)))
+ (root (string-append %gc-roots-directory "/test-gc-root")))
+ (symlink item root)
+ (let ((result (member root (gc-roots))))
+ (delete-file root)
+ result)))
+
+(test-assert "gc-roots, indirect root"
+ (call-with-temporary-directory
+ (lambda (directory)
+ (let* ((item (add-text-to-store %store "something"
+ (random-text)))
+ (root (string-append directory "/gc-root")))
+ (symlink item root)
+ (add-indirect-root %store root)
+ (let ((result (member root (gc-roots))))
+ (delete-file root)
+ result)))))
+
+(test-end "store-roots")
diff --git a/tests/zlib.scm b/tests/zlib.scm
index 5455240a71..7c595a422c 100644
--- a/tests/zlib.scm
+++ b/tests/zlib.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -26,11 +26,10 @@
;; Test the (guix zlib) module.
-(unless (zlib-available?)
- (exit 77))
-
(test-begin "zlib")
+(unless (zlib-available?)
+ (test-skip 1))
(test-assert "compression/decompression pipe"
(let ((data (random-bytevector (+ (random 10000)
(* 20 1024)))))