summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-11-13 00:34:16 +0100
committerLudovic Courtès <ludo@gnu.org>2016-11-13 00:34:16 +0100
commit2cab1dd58b9a8fb4db8f46a0b00e1358fc0de21b (patch)
treeb0f12de9371ebbd806214df841cf3a1c116d5431 /tests
parent15abcabe4e1d34416714eae66dba32ff96d05a6f (diff)
parentde7da4e5d14a1acace1a89d9c520d336eecc7e45 (diff)
downloadpatches-2cab1dd58b9a8fb4db8f46a0b00e1358fc0de21b.tar
patches-2cab1dd58b9a8fb4db8f46a0b00e1358fc0de21b.tar.gz
Merge branch 'core-updates'
Diffstat (limited to 'tests')
-rw-r--r--tests/build-utils.scm88
-rw-r--r--tests/packages.scm4
2 files changed, 37 insertions, 55 deletions
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index cc96738e36..7d49446f66 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,37 @@
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")))
+ (and (zero? (close-pipe pipe))
+ str))))))
(test-end)
diff --git a/tests/packages.scm b/tests/packages.scm
index 5f5fb5de87..47e76b53e9 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -909,7 +909,7 @@
(test-assert "fold-packages, hidden package"
;; There are two public variables providing "guile@2.0" ('guile-final' in
- ;; commencement.scm and 'guile-2.0/fixed' in guile.scm), but only the latter
+ ;; commencement.scm and 'guile-2.0' in guile.scm), but only the latter
;; should show up.
(match (fold-packages (lambda (p r)
(if (and (string=? (package-name p) "guile")
@@ -919,7 +919,7 @@
r))
'())
((one)
- (eq? one guile-2.0/fixed))))
+ (eq? one guile-2.0))))
(test-assert "find-packages-by-name"
(match (find-packages-by-name "hello")