01/04: tests: Test 'wrap-program' without building a package.

[Ludovic Courtès]

civodul pushed a commit to branch core-updates
in repository guix.

commit 7370c021483e428a9da15cdf8693d42fe75ecc62
Author: Ludovic Courtès <address@hidden>
Date:   Fri Sep 2 10:22:13 2016 +0200

    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.
---
 tests/build-utils.scm |   89 ++++++++++++++++++++-----------------------------
 1 file changed, 36 insertions(+), 53 deletions(-)

diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index cc96738..cc59b2e 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 <address@hidden>
+;;; Copyright © 2012, 2015, 2016 Ludovic Courtès <address@hidden>
 ;;;
 ;;; 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)