summaryrefslogtreecommitdiff
path: root/tests/build-utils.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-09-02 10:22:13 +0200
committerLudovic Courtès <ludo@gnu.org>2016-09-02 15:39:10 +0200
commit7370c021483e428a9da15cdf8693d42fe75ecc62 (patch)
treee2a2036b7c3ff53688d7b95df17e32874ec24a88 /tests/build-utils.scm
parentc4c8cfddd5ba05b30d99c4aac573634d787b7695 (diff)
tests: Test 'wrap-program' without building a package.
* tests/build-utils.scm (%store): Remove. ("wrap-program, one input, multiple calls"): Rewrite without resorting to packages and derivations.
Diffstat (limited to 'tests/build-utils.scm')
-rw-r--r--tests/build-utils.scm89
1 files changed, 36 insertions, 53 deletions
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index cc96738e36..cc59b2eff7 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,12 +19,9 @@
(define-module (test-build-utils)
#:use-module (guix tests)
- #:use-module (guix store)
- #:use-module (guix derivations)
#:use-module (guix build utils)
- #:use-module (guix packages)
- #:use-module (guix build-system)
- #:use-module (guix build-system trivial)
+ #:use-module ((guix utils)
+ #:select (%current-system call-with-temporary-directory))
#:use-module (gnu packages)
#:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-34)
@@ -32,9 +29,6 @@
#:use-module (rnrs io ports)
#:use-module (ice-9 popen))
-(define %store
- (open-connection-for-tests))
-
(test-begin "build-utils")
@@ -95,49 +89,38 @@
port
cons)))))
-(test-assert "wrap-program, one input, multiple calls"
- (let* ((p (package
- (name "test-wrap-program") (version "0") (source #f)
- (synopsis #f) (description #f) (license #f) (home-page #f)
- (build-system trivial-build-system)
- (arguments
- `(#:guile ,%bootstrap-guile
- #:modules ((guix build utils))
- #:builder
- (let* ((out (assoc-ref %outputs "out"))
- (bash (assoc-ref %build-inputs "bash"))
- (foo (string-append out "/foo")))
- (begin
- (use-modules (guix build utils))
- (mkdir out)
- (call-with-output-file foo
- (lambda (p)
- (format p
- "#!~a~%echo \"${GUIX_FOO} ${GUIX_BAR}\"~%"
- bash)))
- (chmod foo #o777)
- ;; wrap-program uses `which' to find bash for the wrapper
- ;; shebang, but it can't know about the bootstrap bash in
- ;; the store, since it's not named "bash". Help it out a
- ;; bit by providing a symlink it this package's output.
- (symlink bash (string-append out "/bash"))
- (setenv "PATH" out)
- (wrap-program foo `("GUIX_FOO" prefix ("hello")))
- (wrap-program foo `("GUIX_BAR" prefix ("world")))
- #t))))
- (inputs `(("bash" ,(search-bootstrap-binary "bash"
- (%current-system)))))))
- (d (package-derivation %store p)))
-
- ;; The bootstrap Bash is linked against an old libc and would abort with
- ;; an assertion failure when trying to load incompatible locale data.
- (unsetenv "LOCPATH")
-
- (and (build-derivations %store (pk 'drv d (list d)))
- (let* ((p (derivation->output-path d))
- (foo (string-append p "/foo"))
- (pipe (open-input-pipe foo))
- (str (get-string-all pipe)))
- (equal? str "hello world\n")))))
+(test-equal "wrap-program, one input, multiple calls"
+ "hello world\n"
+ (call-with-temporary-directory
+ (lambda (directory)
+ (let ((bash (search-bootstrap-binary "bash" (%current-system)))
+ (foo (string-append directory "/foo")))
+
+ (call-with-output-file foo
+ (lambda (p)
+ (format p
+ "#!~a~%echo \"${GUIX_FOO} ${GUIX_BAR}\"~%"
+ bash)))
+ (chmod foo #o777)
+
+ ;; wrap-program uses `which' to find bash for the wrapper shebang, but
+ ;; it can't know about the bootstrap bash in the store, since it's not
+ ;; named "bash". Help it out a bit by providing a symlink it this
+ ;; package's output.
+ (setenv "PATH" (dirname bash))
+ (wrap-program foo `("GUIX_FOO" prefix ("hello")))
+ (wrap-program foo `("GUIX_BAR" prefix ("world")))
+
+ ;; The bootstrap Bash is linked against an old libc and would abort with
+ ;; an assertion failure when trying to load incompatible locale data.
+ (unsetenv "LOCPATH")
+
+ (let* ((pipe (open-input-pipe foo))
+ (str (get-string-all pipe)))
+ (with-directory-excursion directory
+ (for-each delete-file
+ '("foo" ".foo-real" ".foo-wrap-01" ".foo-wrap-02")))
+ (and (zero? (close-pipe pipe))
+ str))))))
(test-end)