summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorEfraim Flashner <efraim@flashner.co.il>2021-10-31 12:47:14 +0200
committerEfraim Flashner <efraim@flashner.co.il>2021-10-31 14:49:47 +0200
commitbc5155b952ae8bdbc56aded4d8d39768b4e2a7d4 (patch)
tree6b55475d86c522543384dea7d1ab66bba32af63e /tests
parentdac8d013bd1fc7f57b8ba3582eef6e0e01b23dfd (diff)
parent4e5000114ec01b5e92a87c52f2a10f9ba7a601c8 (diff)
Merge remote-tracking branch 'origin/master' into core-updates-frozen
Diffstat (limited to 'tests')
-rw-r--r--tests/guix-environment-container.sh8
-rw-r--r--tests/guix-environment.sh7
-rw-r--r--tests/guix-shell.sh102
-rw-r--r--tests/home-import.scm187
-rw-r--r--tests/lint.scm14
-rw-r--r--tests/packages.scm14
-rw-r--r--tests/profiles.scm7
-rw-r--r--tests/store.scm28
-rw-r--r--tests/syscalls.scm35
9 files changed, 402 insertions, 0 deletions
diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh
index f2d15c8d0c..2e238c501d 100644
--- a/tests/guix-environment-container.sh
+++ b/tests/guix-environment-container.sh
@@ -44,6 +44,14 @@ else
test $? = 42
fi
+# Try '--root' and '--profile'.
+root="$tmpdir/root"
+guix environment -C --ad-hoc --bootstrap guile-bootstrap -r "$root" -- guile --version
+guix environment -C -p "$root" --bootstrap -- guile --version
+path1=$(guix environment -C -p "$root" --bootstrap -- guile -c '(display (getenv "PATH"))')
+path2=$(guix environment -C --ad-hoc --bootstrap guile-bootstrap -- guile -c '(display (getenv "PATH"))')
+test "$path1" = "$path2"
+
# Make sure "localhost" resolves.
guix environment --container --ad-hoc --bootstrap guile-bootstrap \
-- guile -c '(exit (pair? (getaddrinfo "localhost" "80")))'
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index fe2430b658..95fe95b437 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -119,6 +119,13 @@ test `readlink "$gcroot"` = "$expected"
guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
-- guile -c 1
test `readlink "$gcroot"` = "$expected"
+
+# Make sure '-p' works as expected.
+test $(guix environment -p "$gcroot" -- "$SHELL" -c 'echo $GUIX_ENVIRONMENT') = "$expected"
+paths1="$(guix environment -p "$gcroot" --search-paths)"
+paths2="$(guix environment --bootstrap --ad-hoc guile-bootstrap --search-paths)"
+test "$paths1" = "$paths2"
+
rm "$gcroot"
# Try '-r' with a relative file name.
diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh
new file mode 100644
index 0000000000..3bdf625189
--- /dev/null
+++ b/tests/guix-shell.sh
@@ -0,0 +1,102 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2021 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 shell' alias.
+#
+
+guix shell --version
+
+configdir="t-guix-shell-config-$$"
+tmpdir="t-guix-shell-$$"
+trap 'rm -r "$tmpdir" "$configdir"' EXIT
+mkdir "$tmpdir" "$configdir" "$configdir/guix"
+
+XDG_CONFIG_HOME="$(realpath $configdir)"
+export XDG_CONFIG_HOME
+
+guix shell --bootstrap --pure guile-bootstrap -- guile --version
+
+# '--ad-hoc' is a thing of the past.
+! guix shell --ad-hoc guile-bootstrap
+
+# Ignoring unauthorized files.
+cat > "$tmpdir/guix.scm" <<EOF
+This is a broken guix.scm file.
+EOF
+! (cd "$tmpdir"; SHELL="$(type -P true)" guix shell --bootstrap 2> "stderr")
+grep "not authorized" "$tmpdir/stderr"
+rm "$tmpdir/stderr"
+
+# Authorize the directory.
+echo "$(realpath "$tmpdir")" > "$configdir/guix/shell-authorized-directories"
+
+# Ignoring 'manifest.scm' and 'guix.scm' in non-interactive use.
+(cd "$tmpdir"; guix shell --bootstrap -- true)
+mv "$tmpdir/guix.scm" "$tmpdir/manifest.scm"
+(cd "$tmpdir"; guix shell --bootstrap -- true)
+rm "$tmpdir/manifest.scm"
+
+# Honoring the local 'manifest.scm' file.
+cat > "$tmpdir/manifest.scm" <<EOF
+(specifications->manifest '("guile-bootstrap"))
+EOF
+cat > "$tmpdir/fake-shell.sh" <<EOF
+#!$SHELL
+# This fake shell allows us to test interactive use.
+exec echo "\$GUIX_ENVIRONMENT"
+EOF
+chmod +x "$tmpdir/fake-shell.sh"
+profile1="$(cd "$tmpdir"; SHELL="$(realpath fake-shell.sh)" guix shell --bootstrap)"
+profile2="$(guix shell --bootstrap guile-bootstrap -- "$SHELL" -c 'echo $GUIX_ENVIRONMENT')"
+test -n "$profile1"
+test "$profile1" = "$profile2"
+rm "$tmpdir/manifest.scm"
+
+# Do not read manifest when passed '-q'.
+echo "Broken manifest." > "$tmpdir/manifest.scm"
+(cd "$tmpdir"; SHELL="$(realpath fake-shell.sh)" guix shell --bootstrap -q)
+rm "$tmpdir/manifest.scm"
+
+if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
+then
+ # Compute the build environment for the initial GNU Make.
+ guix shell --bootstrap --no-substitutes --search-paths --pure \
+ -D -e '(@ (guix tests) gnu-make-for-tests)' > "$tmpdir/a"
+
+ # Make sure bootstrap binaries are in the profile.
+ profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`
+
+ # Make sure the bootstrap binaries are all listed where they belong.
+ grep -E "^export PATH=\"$profile/bin\"" "$tmpdir/a"
+ grep -E "^export CPATH=\"$profile/include\"" "$tmpdir/a"
+ grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a"
+ for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0
+ do
+ guix gc --references "$profile" | grep "$dep"
+ done
+
+ # 'make-boot0' itself must not be listed.
+ ! guix gc --references "$profile" | grep make-boot0
+
+ # Honoring the local 'guix.scm' file.
+ echo '(@ (guix tests) gnu-make-for-tests)' > "$tmpdir/guix.scm"
+ (cd "$tmpdir"; guix shell --bootstrap --search-paths --pure > "b")
+ cmp "$tmpdir/a" "$tmpdir/b"
+ rm "$tmpdir/guix.scm"
+fi
diff --git a/tests/home-import.scm b/tests/home-import.scm
new file mode 100644
index 0000000000..abd3cec43d
--- /dev/null
+++ b/tests/home-import.scm
@@ -0,0 +1,187 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;;
+;;; 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-home-import)
+ #:use-module (guix scripts home import)
+ #:use-module (guix utils)
+ #:use-module (guix build utils)
+ #:use-module (guix packages)
+ #:use-module (ice-9 match)
+ #:use-module ((guix profiles) #:hide (manifest->code))
+ #:use-module ((guix build syscalls) #:select (mkdtemp!))
+ #:use-module ((guix scripts package)
+ #:select (manifest-entry-version-prefix))
+ #:use-module (gnu packages)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-64))
+
+;; Test the (guix scripts home import) tools.
+
+(test-begin "home-import")
+
+;; Example manifest entries.
+
+(define guile-2.0.9
+ (manifest-entry
+ (name "guile")
+ (version "2.0.9")
+ (item "/gnu/store/...")))
+
+(define glibc
+ (manifest-entry
+ (name "glibc")
+ (version "2.19")
+ (item "/gnu/store/...")))
+
+(define gcc
+ (manifest-entry
+ (name "gcc")
+ (version "10.3.0")
+ (item "/gnu/store/...")))
+
+;; Helpers for checking and generating home environments.
+
+(define %destination-directory "/tmp/guix-config")
+(mkdir-p %destination-directory)
+
+(define %temporary-home-directory (mkdtemp! "/tmp/guix-home-import.XXXXXX"))
+
+(define-syntax-rule (define-home-environment-matcher name pattern)
+ (define (name obj)
+ (match obj
+ (pattern #t)
+ (x (pk 'fail x #f)))))
+
+(define (create-temporary-home files-alist)
+ "Create a temporary home directory in '%temporary-home-directory'.
+FILES-ALIST is an association list of files and the content of the
+corresponding file."
+ (define (create-file file content)
+ (let ((absolute-path (string-append %temporary-home-directory "/" file)))
+ (unless (file-exists? absolute-path)
+ (mkdir-p (dirname absolute-path)))
+ (call-with-output-file absolute-path
+ (cut display content <>))))
+
+ (for-each (match-lambda
+ ((file . content) (create-file file content)))
+ files-alist))
+
+(define (eval-test-with-home-environment files-alist manifest matcher)
+ (create-temporary-home files-alist)
+ (setenv "HOME" %temporary-home-directory)
+ (mkdir-p %temporary-home-directory)
+ (let* ((home-environment (manifest+configuration-files->code
+ manifest %destination-directory))
+ (result (matcher home-environment)))
+ (delete-file-recursively %temporary-home-directory)
+ result))
+
+(define-home-environment-matcher match-home-environment-no-services
+ ('begin
+ ('use-modules
+ ('gnu 'home)
+ ('gnu 'packages)
+ ('gnu 'services))
+ ('home-environment
+ ('packages
+ ('map 'specification->package
+ ('list "guile@2.0.9" "gcc" "glibc@2.19")))
+ ('services
+ ('list)))))
+
+(define-home-environment-matcher match-home-environment-transformations
+ ('begin
+ ('use-modules
+ ('gnu 'home)
+ ('gnu 'packages)
+ ('gnu 'services)
+ ('guix 'transformations))
+
+ ('define transform ('options->transformation _))
+ ('home-environment
+ ('packages
+ ('list (transform ('specification->package "guile@2.0.9"))
+ ('specification->package "gcc")
+ ('specification->package "glibc@2.19")))
+ ('services ('list)))))
+
+(define-home-environment-matcher match-home-environment-no-services-nor-packages
+ ('begin
+ ('use-modules
+ ('gnu 'home)
+ ('gnu 'packages)
+ ('gnu 'services))
+ ('home-environment
+ ('packages
+ ('map 'specification->package
+ ('list)))
+ ('services
+ ('list)))))
+
+(define-home-environment-matcher match-home-environment-bash-service
+ ('begin
+ ('use-modules
+ ('gnu 'home)
+ ('gnu 'packages)
+ ('gnu 'services)
+ ('guix 'gexp)
+ ('gnu 'home 'services 'shells))
+ ('home-environment
+ ('packages
+ ('map 'specification->package
+ ('list)))
+ ('services
+ ('list ('service
+ 'home-bash-service-type
+ ('home-bash-configuration
+ ('bashrc
+ ('list ('local-file "/tmp/guix-config/.bashrc"
+ "bashrc"))))))))))
+
+
+(test-assert "manifest->code: No services"
+ (eval-test-with-home-environment
+ '()
+ (make-manifest (list guile-2.0.9 gcc glibc))
+ match-home-environment-no-services))
+
+(test-assert "manifest->code: No services, package transformations"
+ (eval-test-with-home-environment
+ '()
+ (make-manifest (list (manifest-entry
+ (inherit guile-2.0.9)
+ (properties `((transformations
+ . ((foo . "bar"))))))
+ gcc glibc))
+ match-home-environment-transformations))
+
+(test-assert "manifest->code: No packages nor services"
+ (eval-test-with-home-environment
+ '()
+ (make-manifest '())
+ match-home-environment-no-services-nor-packages))
+
+(test-assert "manifest->code: Bash service"
+ (eval-test-with-home-environment
+ '((".bashrc" . "echo 'hello guix'"))
+ (make-manifest '())
+ match-home-environment-bash-service))
+
+(test-end "home-import")
diff --git a/tests/lint.scm b/tests/lint.scm
index ddef50b98b..a2e9699d5a 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -177,6 +177,20 @@
(description "Whitespace. "))))
(check-description-style pkg))))
+(test-equal "description: pluralized 'This package'"
+ "description contains typo 'This packages', should be 'This package'"
+ (single-lint-warning-message
+ (let ((pkg (dummy-package "x"
+ (description "This packages is a typo."))))
+ (check-description-style pkg))))
+
+(test-equal "description: grammar 'allows to'"
+ "description contains typo 'allows to'"
+ (single-lint-warning-message
+ (let ((pkg (dummy-package "x"
+ (description "This package allows to do stuff."))))
+ (check-description-style pkg))))
+
(test-equal "synopsis: not a string"
"invalid synopsis: #f"
(single-lint-warning-message
diff --git a/tests/packages.scm b/tests/packages.scm
index a9494b5c0e..3506f94f91 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -358,6 +358,20 @@
(package-transitive-supported-systems d)
(package-transitive-supported-systems e))))
+(test-assert "package-development-inputs"
+ ;; Note: Due to propagated inputs, 'package-development-inputs' returns a
+ ;; couple more inputs, such as 'linux-libre-headers'.
+ (lset<= equal?
+ `(("source" ,(package-source hello)) ,@(standard-packages))
+ (package-development-inputs hello)))
+
+(test-assert "package-development-inputs, cross-compilation"
+ (lset<= equal?
+ `(("source" ,(package-source hello))
+ ,@(standard-cross-packages "mips64el-linux-gnu" 'host)
+ ,@(standard-cross-packages "mips64el-linux-gnu" 'target))
+ (package-development-inputs hello #:target "mips64el-linux-gnu")))
+
(test-assert "package-closure"
(let-syntax ((dummy-package/no-implicit
(syntax-rules ()
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 06a0387221..cac5b73347 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -265,6 +265,13 @@
(manifest-transaction-removal-candidate? guile-2.0.9 t)
(null? install) (null? downgrade) (null? upgrade)))))
+(test-assert "package->development-manifest"
+ (let ((manifest (package->development-manifest packages:hello)))
+ (every (lambda (name)
+ (manifest-installed? manifest
+ (manifest-pattern (name name))))
+ '("gcc" "binutils" "glibc" "coreutils" "grep" "sed"))))
+
(test-assertm "profile-derivation"
(mlet* %store-monad
((entry -> (package->manifest-entry %bootstrap-guile))
diff --git a/tests/store.scm b/tests/store.scm
index d895a328a4..7fc2988476 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -490,6 +490,34 @@
(equal? (map derivation-file-name (drop d 16)) batch3)
lst)))))
+(test-equal "map/accumulate-builds and different store"
+ '(d2) ;see <https://issues.guix.gnu.org/46756>
+ (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
+ (s (add-to-store %store "bash" #t "sha256"
+ (search-bootstrap-binary "bash"
+ (%current-system))))
+ (d1 (derivation %store "first"
+ s `("-e" ,b)
+ #:env-vars `(("foo" . ,(random-text)))
+ #:sources (list b s)))
+ (d2 (derivation %store "second"
+ s `("-e" ,b)
+ #:env-vars `(("foo" . ,(random-text))
+ ("bar" . "baz"))
+ #:sources (list b s))))
+ (with-store alternate-store
+ (with-build-handler (lambda (continue store things mode)
+ ;; If this handler is called, it means that
+ ;; 'map/accumulate-builds' triggered a build,
+ ;; which it shouldn't since the inner
+ ;; 'build-derivations' call is for another store.
+ 'failed)
+ (map/accumulate-builds %store
+ (lambda (drv)
+ (build-derivations alternate-store (list d2))
+ 'd2)
+ (list d1))))))
+
(test-assert "mapm/accumulate-builds"
(let* ((d1 (run-with-store %store
(gexp->derivation "foo" #~(mkdir #$output))))
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 706dd4177f..c9e011f453 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -26,6 +26,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
+ #:use-module (srfi srfi-71)
#:use-module (system foreign)
#:use-module ((ice-9 ftw) #:select (scandir))
#:use-module (ice-9 match))
@@ -582,6 +583,40 @@
(test-assert "terminal-rows"
(> (terminal-rows) 0))
+(test-assert "openpty"
+ (let ((head inferior (openpty)))
+ (and (integer? head) (integer? inferior)
+ (let ((port (fdopen inferior "r+0")))
+ (and (isatty? port)
+ (begin
+ (close-port port)
+ (close-fdes head)
+ #t))))))
+
+(test-equal "openpty + login-tty"
+ '(hello world)
+ (let ((head inferior (openpty)))
+ (match (primitive-fork)
+ (0
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (setvbuf (current-input-port) 'none)
+ (close-fdes head)
+ (login-tty inferior)
+ (write (read))
+ (read)) ;this gets EIO when HEAD is closed
+ (lambda ()
+ (primitive-_exit 42))))
+ (pid
+ (close-fdes inferior)
+ (let ((head (fdopen head "r+0")))
+ (write '(hello world) head)
+ (let ((result (read head)))
+ (close-port head)
+ (waitpid pid)
+ result))))))
+
(test-assert "utmpx-entries"
(match (utmpx-entries)
(((? utmpx? entries) ...)