diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/build-utils.scm | 104 | ||||
| -rw-r--r-- | tests/builders.scm | 40 | ||||
| -rw-r--r-- | tests/derivations.scm | 1 | ||||
| -rw-r--r-- | tests/grafts.scm | 1 | ||||
| -rw-r--r-- | tests/graph.scm | 4 | ||||
| -rw-r--r-- | tests/guix-daemon.sh | 4 | ||||
| -rw-r--r-- | tests/guix-environment.sh | 27 | ||||
| -rw-r--r-- | tests/guix-package-net.sh | 2 | ||||
| -rw-r--r-- | tests/packages.scm | 57 | ||||
| -rw-r--r-- | tests/profiles.scm | 7 | ||||
| -rw-r--r-- | tests/search-paths.scm | 8 | ||||
| -rw-r--r-- | tests/syscalls.scm | 13 | ||||
| -rw-r--r-- | tests/union.scm | 8 |
13 files changed, 189 insertions, 87 deletions
diff --git a/tests/build-utils.scm b/tests/build-utils.scm index 46fe8ea2c0..61e6c44e63 100644 --- a/tests/build-utils.scm +++ b/tests/build-utils.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,8 +21,6 @@ (define-module (test-build-utils) #:use-module (guix tests) #:use-module (guix build utils) - #:use-module ((gnu build bootloader) - #:select (invoke/quiet)) #:use-module ((guix utils) #:select (%current-system call-with-temporary-directory)) #:use-module (gnu packages) @@ -144,4 +143,105 @@ (invoke/quiet "sh" "-c" "echo This is another error. >&2 ; false") #f)) +(let ((script-contents "\ +#!/anything/cabbage-bash-1.2.3/bin/sh + +echo hello world")) + + (test-equal "wrap-script, simple case" + (string-append + (format #f "\ +#!GUILE --no-auto-compile +#!#; Guix wrapper +#\\-~s +#\\-~s +" + '(begin (let ((current (getenv "GUIX_FOO"))) + (setenv "GUIX_FOO" + (if current + (string-append "/some/path:/some/other/path" + ":" current) + "/some/path:/some/other/path")))) + '(let ((cl (command-line))) + (apply execl "/anything/cabbage-bash-1.2.3/bin/sh" + (car cl) + (cons (car cl) + (append '("") cl))))) + script-contents) + (call-with-temporary-directory + (lambda (directory) + (let ((script-file-name (string-append directory "/foo"))) + (call-with-output-file script-file-name + (lambda (port) + (format port script-contents))) + (chmod script-file-name #o777) + + (mock ((guix build utils) which (const "GUILE")) + (wrap-script script-file-name + `("GUIX_FOO" prefix ("/some/path" + "/some/other/path")))) + (let ((str (call-with-input-file script-file-name get-string-all))) + (with-directory-excursion directory + (delete-file "foo")) + str)))))) + +(let ((script-contents "\ +#!/anything/cabbage-bash-1.2.3/bin/python3 -and -args +# vim:fileencoding=utf-8 +print('hello world')")) + + (test-equal "wrap-script, with encoding declaration" + (string-append + (format #f "\ +#!MYGUILE --no-auto-compile +#!#; # vim:fileencoding=utf-8 +#\\-~s +#\\-~s +" + '(begin (let ((current (getenv "GUIX_FOO"))) + (setenv "GUIX_FOO" + (if current + (string-append "/some/path:/some/other/path" + ":" current) + "/some/path:/some/other/path")))) + `(let ((cl (command-line))) + (apply execl "/anything/cabbage-bash-1.2.3/bin/python3" + (car cl) + (cons (car cl) + (append '("" "-and" "-args") cl))))) + script-contents) + (call-with-temporary-directory + (lambda (directory) + (let ((script-file-name (string-append directory "/foo"))) + (call-with-output-file script-file-name + (lambda (port) + (format port script-contents))) + (chmod script-file-name #o777) + + (wrap-script script-file-name + #:guile "MYGUILE" + `("GUIX_FOO" prefix ("/some/path" + "/some/other/path"))) + (let ((str (call-with-input-file script-file-name get-string-all))) + (with-directory-excursion directory + (delete-file "foo")) + str)))))) + +(test-assert "wrap-script, raises condition" + (call-with-temporary-directory + (lambda (directory) + (let ((script-file-name (string-append directory "/foo"))) + (call-with-output-file script-file-name + (lambda (port) + (format port "This is not a script"))) + (chmod script-file-name #o777) + (catch 'srfi-34 + (lambda () + (wrap-script script-file-name + #:guile "MYGUILE" + `("GUIX_FOO" prefix ("/some/path" + "/some/other/path")))) + (lambda (type obj) + (wrap-error? obj))))))) + (test-end) diff --git a/tests/builders.scm b/tests/builders.scm index 8b8ef013e7..fdcf38ded3 100644 --- a/tests/builders.scm +++ b/tests/builders.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,7 +28,8 @@ #:use-module (gcrypt hash) #:use-module (guix tests) #:use-module ((guix packages) - #:select (package-derivation package-native-search-paths)) + #:select (package? + package-derivation package-native-search-paths)) #:use-module (gnu packages bootstrap) #:use-module (ice-9 match) #:use-module (srfi srfi-1) @@ -39,23 +40,6 @@ (define %store (open-connection-for-tests)) -(define %bootstrap-inputs - ;; Use the bootstrap inputs so it doesn't take ages to run these tests. - ;; This still involves building Make, Diffutils, and Findutils. - ;; XXX: We're relying on the higher-level `package-derivations' here. - (and %store - (map (match-lambda - ((name package) - (list name (package-derivation %store package)))) - (@@ (gnu packages commencement) %boot0-inputs)))) - -(define %bootstrap-search-paths - ;; Search path specifications that go with %BOOTSTRAP-INPUTS. - (append-map (match-lambda - ((name package _ ...) - (package-native-search-paths package))) - (@@ (gnu packages commencement) %boot0-inputs))) - (define url-fetch* (store-lower url-fetch)) @@ -94,22 +78,4 @@ (test-assert "gnu-build-system" (build-system? gnu-build-system)) -(when (or (not (network-reachable?)) (shebang-too-long?)) - (test-skip 1)) -(test-assert "gnu-build" - (let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz") - (hash (nix-base32-string->bytevector - "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")) - (tarball (url-fetch* %store url 'sha256 hash - #:guile %bootstrap-guile)) - (build (gnu-build %store "hello-2.8" - `(("source" ,tarball) - ,@%bootstrap-inputs) - #:guile %bootstrap-guile - #:search-paths %bootstrap-search-paths)) - (out (derivation->output-path build))) - (and (build-derivations %store (list (pk 'hello-drv build))) - (valid-path? %store out) - (file-exists? (string-append out "/bin/hello"))))) - (test-end "builders") diff --git a/tests/derivations.scm b/tests/derivations.scm index 00cedef32c..6a7fad85b5 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -29,7 +29,6 @@ #:use-module (guix tests http) #:use-module ((guix packages) #:select (package-derivation base32)) #:use-module ((guix build utils) #:select (executable-file?)) - #:use-module ((gnu packages) #:select (search-bootstrap-binary)) #:use-module (gnu packages bootstrap) #:use-module ((gnu packages guile) #:select (guile-1.8)) #:use-module (srfi srfi-1) diff --git a/tests/grafts.scm b/tests/grafts.scm index 6fd3d5e171..a12c6a5911 100644 --- a/tests/grafts.scm +++ b/tests/grafts.scm @@ -24,7 +24,6 @@ #:use-module (guix utils) #:use-module (guix grafts) #:use-module (guix tests) - #:use-module ((gnu packages) #:select (search-bootstrap-binary)) #:use-module (gnu packages bootstrap) #:use-module (srfi srfi-1) #:use-module (srfi srfi-64) diff --git a/tests/graph.scm b/tests/graph.scm index c4c5096226..b7732ec709 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -153,9 +153,9 @@ edges." (match nodes (((labels names) ...) names)))) - (match %bootstrap-inputs + (match (%bootstrap-inputs) (((labels packages) ...) - (map package-full-name packages)))))))) + (map package-full-name (filter package? packages))))))))) (test-assert "bag DAG, including origins" (let-values (((backend nodes+edges) (make-recording-backend))) diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh index 78f82eafe2..758f18cc36 100644 --- a/tests/guix-daemon.sh +++ b/tests/guix-daemon.sh @@ -141,7 +141,7 @@ daemon_pid=$! GUIX_DAEMON_SOCKET="$socket" \ guile -c ' - (use-modules (guix) (gnu packages) (guix tests)) + (use-modules (guix) (guix tests)) (with-store store (let* ((build (add-text-to-store store "build.sh" @@ -165,7 +165,7 @@ kill "$daemon_pid" # honored. client_code=' - (use-modules (guix) (gnu packages) (guix tests) (srfi srfi-34)) + (use-modules (guix) (guix tests) (srfi srfi-34)) (with-store store (let* ((build (add-text-to-store store "build.sh" diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh index a670db36be..fb1c1a022d 100644 --- a/tests/guix-environment.sh +++ b/tests/guix-environment.sh @@ -156,7 +156,7 @@ if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null then # Compute the build environment for the initial GNU Make. guix environment --bootstrap --no-substitutes --search-paths --pure \ - -e '(@@ (gnu packages commencement) gnu-make-boot0)' > "$tmpdir/a" + -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|'` @@ -177,30 +177,15 @@ then # Make sure that the shell spawned with '--exec' sees the same environment # as returned by '--search-paths'. guix environment --bootstrap --no-substitutes --pure \ - -e '(@@ (gnu packages commencement) gnu-make-boot0)' \ + -e '(@ (guix tests) gnu-make-for-tests)' \ -- /bin/sh -c 'echo $PATH $CPATH $LIBRARY_PATH' > "$tmpdir/b" ( . "$tmpdir/a" ; echo $PATH $CPATH $LIBRARY_PATH ) > "$tmpdir/c" cmp "$tmpdir/b" "$tmpdir/c" rm "$tmpdir"/* - # Compute the build environment for the initial GNU Findutils. - guix environment --bootstrap --no-substitutes --search-paths --pure \ - -e '(@@ (gnu packages commencement) findutils-boot0)' > "$tmpdir/a" - 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 \ - make-boot0 - do - guix gc --references "$profile" | grep "$dep" - done - # The following test assumes 'make-boot0' has a "debug" output. - make_boot0_debug="`guix build -e '(@@ (gnu packages commencement) gnu-make-boot0)' | grep -e -debug`" + make_boot0_debug="`guix build -e '(@ (guix tests) gnu-make-for-tests)' | grep -e -debug`" test "x$make_boot0_debug" != "x" # Make sure the "debug" output is not listed. @@ -210,7 +195,7 @@ then # Compute the build environment for the initial GNU Make, but add in the # bootstrap Guile as an ad-hoc addition. guix environment --bootstrap --no-substitutes --search-paths --pure \ - -e '(@@ (gnu packages commencement) gnu-make-boot0)' \ + -e '(@ (guix tests) gnu-make-for-tests)' \ --ad-hoc guile-bootstrap > "$tmpdir/a" profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'` @@ -227,14 +212,14 @@ then # Make sure a package list with plain package objects and package+output # tuples can be used with -e. expr_list_test_code=" -(list (@@ (gnu packages commencement) gnu-make-boot0) +(list (@ (guix tests) gnu-make-for-tests) (list (@ (gnu packages bootstrap) %bootstrap-guile) \"out\"))" guix environment --bootstrap --ad-hoc --no-substitutes --search-paths \ --pure -e "$expr_list_test_code" > "$tmpdir/a" profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'` - for dep in make-boot0 guile-bootstrap + for dep in make-test-boot0 guile-bootstrap do guix gc --references "$profile" | grep "$dep" done diff --git a/tests/guix-package-net.sh b/tests/guix-package-net.sh index 82c346dd4c..48a94865e1 100644 --- a/tests/guix-package-net.sh +++ b/tests/guix-package-net.sh @@ -57,7 +57,7 @@ test -L "$profile" && test -L "$profile-1-link" ! test -f "$profile-2-link" test -f "$profile/bin/guile" -boot_make="(@@ (gnu packages commencement) gnu-make-boot0)" +boot_make="(@ (guix tests) gnu-make-for-tests)" boot_make_drv="`guix build -e "$boot_make" | grep -v -e -debug`" guix package --bootstrap -p "$profile" -i "$boot_make_drv" test -L "$profile-2-link" diff --git a/tests/packages.scm b/tests/packages.scm index 836d446657..423c5061aa 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,6 +37,7 @@ #:use-module (guix build-system) #:use-module (guix build-system trivial) #:use-module (guix build-system gnu) + #:use-module (guix memoization) #:use-module (guix profiles) #:use-module (guix scripts package) #:use-module (gnu packages) @@ -336,18 +338,55 @@ ;; Here GNU-BUILD-SYSTEM adds implicit inputs that build only on ;; %SUPPORTED-SYSTEMS. Thus the others must be ignored. (let ((p (dummy-package "foo" + (build-system gnu-build-system) + (supported-systems + `("does-not-exist" "foobar" ,@%supported-systems))))) + (parameterize ((%current-system "armhf-linux")) ; a traditionally-bootstrapped architecture + (package-transitive-supported-systems p)))) + +(test-equal "package-transitive-supported-systems: reduced binary seed, implicit inputs" + '("x86_64-linux" "i686-linux") + + ;; Here GNU-BUILD-SYSTEM adds implicit inputs that build only on + ;; %SUPPORTED-SYSTEMS. Thus the others must be ignored. + (let ((p (dummy-package "foo" (build-system gnu-build-system) (supported-systems `("does-not-exist" "foobar" ,@%supported-systems))))) - (package-transitive-supported-systems p))) + (parameterize ((%current-system "x86_64-linux")) + (package-transitive-supported-systems p)))) (test-assert "supported-package?" - (let ((p (dummy-package "foo" - (build-system gnu-build-system) - (supported-systems '("x86_64-linux" "does-not-exist"))))) + (let* ((d (dummy-package "dep" + (build-system trivial-build-system) + (supported-systems '("x86_64-linux")))) + (p (dummy-package "foo" + (build-system gnu-build-system) + (inputs `(("d" ,d))) + (supported-systems '("x86_64-linux" "armhf-linux"))))) + (and (supported-package? p "x86_64-linux") + (not (supported-package? p "i686-linux")) + (not (supported-package? p "armhf-linux"))))) + +(test-assert "supported-package? vs. system-dependent graph" + ;; The inputs of a package can depend on (%current-system). Thus, + ;; 'supported-package?' must make sure that it binds (%current-system) + ;; appropriately before traversing the dependency graph. In the example + ;; below, 'supported-package?' must thus return true for both systems. + (let* ((p0a (dummy-package "foo-arm" + (build-system trivial-build-system) + (supported-systems '("armhf-linux")))) + (p0b (dummy-package "foo-x86_64" + (build-system trivial-build-system) + (supported-systems '("x86_64-linux")))) + (p (dummy-package "bar" + (build-system trivial-build-system) + (inputs + (if (string=? (%current-system) "armhf-linux") + `(("foo" ,p0a)) + `(("foo" ,p0b))))))) (and (supported-package? p "x86_64-linux") - (not (supported-package? p "does-not-exist")) - (not (supported-package? p "i686-linux"))))) + (supported-package? p "armhf-linux")))) (test-skip (if (not %store) 8 0)) @@ -918,9 +957,9 @@ (when (or (not (network-reachable?)) (shebang-too-long?)) (test-skip 1)) (test-assert "GNU Make, bootstrap" - ;; GNU Make is the first program built during bootstrap; we choose it - ;; here so that the test doesn't last for too long. - (let ((gnu-make (@@ (gnu packages commencement) gnu-make-boot0))) + ;; GNU-MAKE-FOR-TESTS can be built cheaply; we choose it here so that the + ;; test doesn't last for too long. + (let ((gnu-make gnu-make-for-tests)) (and (package? gnu-make) (or (location? (package-location gnu-make)) (not (package-location gnu-make))) diff --git a/tests/profiles.scm b/tests/profiles.scm index eef93e24cf..a4e28672b5 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -239,11 +239,10 @@ (unless (network-reachable?) (test-skip 1)) (test-assertm "profile-derivation relative symlinks, two entries" (mlet* %store-monad - ((gnu-make-boot0 -> (@@ (gnu packages commencement) gnu-make-boot0)) - (manifest -> (packages->manifest - (list %bootstrap-guile gnu-make-boot0))) + ((manifest -> (packages->manifest + (list %bootstrap-guile gnu-make-for-tests))) (guile (package->derivation %bootstrap-guile)) - (make (package->derivation gnu-make-boot0)) + (make (package->derivation gnu-make-for-tests)) (drv (profile-derivation manifest #:relative-symlinks? #t #:hooks '() diff --git a/tests/search-paths.scm b/tests/search-paths.scm index 8dad424415..767a80b76c 100644 --- a/tests/search-paths.scm +++ b/tests/search-paths.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,17 +29,17 @@ (test-equal "evaluate-search-paths, separator is #f" (string-append %top-srcdir - "/gnu/packages/bootstrap/aarch64-linux") + "/gnu/packages/aux-files/linux-libre") ;; The following search path spec should evaluate to a single item: the ;; first directory that matches the "-linux$" pattern in ;; gnu/packages/bootstrap. (let ((spec (search-path-specification (variable "CHBOUIB") - (files '("gnu/packages/bootstrap")) + (files '("gnu/packages/aux-files")) (file-type 'directory) (separator #f) - (file-pattern "-linux$")))) + (file-pattern "^linux")))) (match (evaluate-search-paths (list spec) (list %top-srcdir)) (((spec* . value)) diff --git a/tests/syscalls.scm b/tests/syscalls.scm index eeb223b950..1b3121e503 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -567,6 +567,19 @@ (let ((result (call-with-input-file "/var/run/utmpx" read-utmpx))) (or (utmpx? result) (eof-object? result)))) +(when (zero? (getuid)) + (test-skip 1)) +(test-equal "add-to-entropy-count" + EPERM + (call-with-output-file "/dev/urandom" + (lambda (port) + (catch 'system-error + (lambda () + (add-to-entropy-count port 77) + #f) + (lambda args + (system-error-errno args)))))) + (test-end) (false-if-exception (delete-file temp-file)) diff --git a/tests/union.scm b/tests/union.scm index 5a6a4033fc..a8387edf42 100644 --- a/tests/union.scm +++ b/tests/union.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -94,8 +95,9 @@ `(,name ,(package-derivation %store package)))) ;; Purposefully leave duplicate entries. - (append %bootstrap-inputs - (take %bootstrap-inputs 3)))) + (filter (compose package? cadr) + (append %bootstrap-inputs-for-tests + (take %bootstrap-inputs-for-tests 3))))) (builder `(begin (use-modules (guix build union)) (union-build (assoc-ref %outputs "out") |