aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/build-utils.scm102
-rw-r--r--tests/builders.scm23
-rw-r--r--tests/graph.scm4
-rw-r--r--tests/packages.scm19
-rw-r--r--tests/union.scm9
5 files changed, 143 insertions, 14 deletions
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 46fe8ea2c0..5678bb6a22 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.
;;;
@@ -144,4 +145,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..b2d8a7c6b2 100644
--- a/tests/builders.scm
+++ b/tests/builders.scm
@@ -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,7 +40,7 @@
(define %store
(open-connection-for-tests))
-(define %bootstrap-inputs
+(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.
@@ -47,14 +48,18 @@
(map (match-lambda
((name package)
(list name (package-derivation %store package))))
- (@@ (gnu packages commencement) %boot0-inputs))))
+ (filter
+ (compose package? cadr)
+ ((@@ (gnu packages commencement) %boot0-inputs))))))
-(define %bootstrap-search-paths
+(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)))
+ ((name package _ ...)
+ (package-native-search-paths package)))
+ (filter
+ (compose package? cadr)
+ ((@@ (gnu packages commencement) %boot0-inputs)))))
(define url-fetch*
(store-lower url-fetch))
@@ -104,9 +109,9 @@
#:guile %bootstrap-guile))
(build (gnu-build %store "hello-2.8"
`(("source" ,tarball)
- ,@%bootstrap-inputs)
+ ,@(%bootstrap-inputs))
#:guile %bootstrap-guile
- #:search-paths %bootstrap-search-paths))
+ #:search-paths (%bootstrap-search-paths)))
(out (derivation->output-path build)))
(and (build-derivations %store (list (pk 'hello-drv build)))
(valid-path? %store out)
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/packages.scm b/tests/packages.scm
index 613b2f1221..af1f76e36d 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"
diff --git a/tests/union.scm b/tests/union.scm
index 5a6a4033fc..091895ff8e 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 © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -31,6 +32,9 @@
#:use-module (rnrs io ports)
#:use-module (ice-9 match))
+(define %bootstrap-inputs
+ (@@ (gnu packages commencement) %bootstrap-inputs+toolchain))
+
;; Exercise the (guix build union) module.
(define %store
@@ -94,8 +98,9 @@
`(,name ,(package-derivation %store package))))
;; Purposefully leave duplicate entries.
- (append %bootstrap-inputs
- (take %bootstrap-inputs 3))))
+ (filter (compose package? cadr)
+ (append (%bootstrap-inputs)
+ (take (%bootstrap-inputs) 3)))))
(builder `(begin
(use-modules (guix build union))
(union-build (assoc-ref %outputs "out")