summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/build-utils.scm104
-rw-r--r--tests/builders.scm40
-rw-r--r--tests/derivations.scm1
-rw-r--r--tests/grafts.scm1
-rw-r--r--tests/graph.scm4
-rw-r--r--tests/guix-daemon.sh4
-rw-r--r--tests/guix-environment.sh27
-rw-r--r--tests/guix-package-net.sh2
-rw-r--r--tests/packages.scm25
-rw-r--r--tests/profiles.scm7
-rw-r--r--tests/search-paths.scm8
-rw-r--r--tests/union.scm8
12 files changed, 149 insertions, 82 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 368012d2b2..36558fe1dd 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 5a5a69d58c..067ae93822 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -164,7 +164,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|'`
@@ -185,30 +185,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.
@@ -218,7 +203,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|'`
@@ -235,14 +220,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..0478fff237 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,10 +338,25 @@
;; 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)))))
+ (invalidate-memoization! package-transitive-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)))
+ (invalidate-memoization! package-transitive-supported-systems)
+ (parameterize ((%current-system "x86_64-linux"))
+ (package-transitive-supported-systems p))))
(test-assert "supported-package?"
(let ((p (dummy-package "foo"
@@ -918,9 +935,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/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")