Merge branch 'master' into core-updates

8 files changed, 113 insertions, 43 deletions

diff --git a/tests/builders.scm b/tests/builders.scm
index e5acc3e038..a7c3e42830 100644
--- a/tests/builders.scm
+++ b/tests/builders.scm
@@ -56,16 +56,13 @@
                 (package-native-search-paths package)))
               (@@ (gnu packages commencement) %boot0-inputs)))
 
-(define network-reachable?
-  (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)))
-
 (define url-fetch*
   (store-lower url-fetch))
 
 
 (test-begin "builders")
 
-(unless network-reachable? (test-skip 1))
+(unless (network-reachable?) (test-skip 1))
 (test-assert "url-fetch"
   (let* ((url      '("http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz"
                      "ftp://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz"))
@@ -97,7 +94,8 @@
 (test-assert "gnu-build-system"
   (build-system? gnu-build-system))
 
-(unless network-reachable? (test-skip 1))
+(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
diff --git a/tests/cpan.scm b/tests/cpan.scm
index af7b36e684..2f9513519e 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -28,15 +28,8 @@
   "{
   \"metadata\" : {
     \"prereqs\" : {
-      \"configure\" : {
-        \"requires\" : {
-          \"ExtUtils::MakeMaker\" : \"0\",
-          \"Module::Build\" : \"0.28\"
-        }
-      },
       \"runtime\" : {
         \"requires\" : {
-          \"Getopt::Std\" : \"0\",
           \"Test::Script\" : \"1.05\",
         }
       }
@@ -70,6 +63,8 @@
                 (match url
                   ("http://api.metacpan.org/release/Foo-Bar"
                    test-json)
+                  ("http://api.metacpan.org/module/Test::Script"
+                   "{ \"distribution\" : \"Test-Script\" }")
                   ("http://example.com/Foo-Bar-0.1.tar.gz"
                    test-source)
                   (_ (error "Unexpected URL: " url))))))))
@@ -85,16 +80,13 @@
                      ('base32
                       (? string? hash)))))
          ('build-system 'perl-build-system)
-         ('native-inputs
-          ('quasiquote
-           (("perl-module-build" ('unquote 'perl-module-build)))))
          ('inputs
           ('quasiquote
            (("perl-test-script" ('unquote 'perl-test-script)))))
          ('home-page "http://search.cpan.org/dist/Foo-Bar")
          ('synopsis "Fizzle Fuzz")
          ('description 'fill-in-yourself!)
-         ('license 'gpl1+))
+         ('license (package-license perl)))
        (string=? (bytevector->nix-base32-string
                   (call-with-input-string test-source port-sha256))
                  hash))
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 80aabad3a8..72d253c465 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -463,7 +463,7 @@
 
 (define %coreutils
   (false-if-exception
-   (and (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)
+   (and (network-reachable?)
         (or (package-derivation %store %bootstrap-coreutils&co)
             (nixpkgs-derivation "coreutils")))))
 
@@ -670,23 +670,6 @@
          (let ((p (derivation->output-path drv)))
            (string-contains (call-with-input-file p read-line) "GNU")))))
 
-(test-assert "imported-files"
-  (let* ((files    `(("x"     . ,(search-path %load-path "ice-9/q.scm"))
-                     ("a/b/c" . ,(search-path %load-path
-                                              "guix/derivations.scm"))
-                     ("p/q"   . ,(search-path %load-path "guix.scm"))
-                     ("p/z"   . ,(search-path %load-path "guix/store.scm"))))
-         (drv      (imported-files %store files)))
-    (and (build-derivations %store (list drv))
-         (let ((dir (derivation->output-path drv)))
-           (every (match-lambda
-                   ((path . source)
-                    (equal? (call-with-input-file (string-append dir "/" path)
-                              get-bytevector-all)
-                            (call-with-input-file source
-                              get-bytevector-all))))
-                  files)))))
-
 (test-assert "build-expression->derivation with modules"
   (let* ((builder  `(begin
                       (use-modules (guix build utils))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 03722e4669..0b189b570b 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -249,6 +249,23 @@
                  (equal? refs (list (dirname (dirname guile))))
                  (equal? refs2 (list file))))))
 
+(test-assertm "gexp->derivation vs. grafts"
+  (mlet* %store-monad ((p0 ->   (dummy-package "dummy"
+                                               (arguments
+                                                '(#:implicit-inputs? #f))))
+                       (r  ->   (package (inherit p0) (name "DuMMY")))
+                       (p1 ->   (package (inherit p0) (replacement r)))
+                       (exp0 -> (gexp (frob (ungexp p0) (ungexp output))))
+                       (exp1 -> (gexp (frob (ungexp p1) (ungexp output))))
+                       (void    (set-guile-for-build %bootstrap-guile))
+                       (drv0    (gexp->derivation "t" exp0))
+                       (drv1    (gexp->derivation "t" exp1))
+                       (drv1*   (gexp->derivation "t" exp1 #:graft? #f)))
+    (return (and (not (string=? (derivation->output-path drv0)
+                                (derivation->output-path drv1)))
+                 (string=? (derivation->output-path drv0)
+                           (derivation->output-path drv1*))))))
+
 (test-assertm "gexp->derivation, composed gexps"
   (mlet* %store-monad ((exp0 -> (gexp (begin
                                         (mkdir (ungexp output))
@@ -360,6 +377,40 @@
                      (string=? (readlink (string-append out "/" two "/one"))
                                one)))))))
 
+(test-assertm "imported-files"
+  (mlet* %store-monad
+      ((files -> `(("x"     . ,(search-path %load-path "ice-9/q.scm"))
+                   ("a/b/c" . ,(search-path %load-path
+                                            "guix/derivations.scm"))
+                   ("p/q"   . ,(search-path %load-path "guix.scm"))
+                   ("p/z"   . ,(search-path %load-path "guix/store.scm"))))
+       (drv (imported-files files)))
+    (mbegin %store-monad
+      (built-derivations (list drv))
+      (let ((dir (derivation->output-path drv)))
+        (return
+         (every (match-lambda
+                 ((path . source)
+                  (equal? (call-with-input-file (string-append dir "/" path)
+                            get-bytevector-all)
+                          (call-with-input-file source
+                            get-bytevector-all))))
+                files))))))
+
+(test-assertm "gexp->derivation #:modules"
+  (mlet* %store-monad
+      ((build ->  #~(begin
+                      (use-modules (guix build utils))
+                      (mkdir-p (string-append #$output "/guile/guix/nix"))
+                      #t))
+       (drv       (gexp->derivation "test-with-modules" build
+                                    #:modules '((guix build utils)))))
+    (mbegin %store-monad
+      (built-derivations (list drv))
+      (let* ((p (derivation->output-path drv))
+             (s (stat (string-append p "/guile/guix/nix"))))
+        (return (eq? (stat:type s) 'directory))))))
+
 (test-assertm "gexp->derivation #:references-graphs"
   (mlet* %store-monad
       ((one (text-file "one" "hello, world"))
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index d4917bbf90..94cf927420 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -28,6 +28,14 @@ readlink_base ()
     basename `readlink "$1"`
 }
 
+# Return true if a typical shebang in the store would not exceed Linux's
+# default static limit.
+shebang_not_too_long ()
+{
+    test `echo $NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bootstrap-binaries-0/bin/bash | wc -c` \
+	 -lt 128
+}
+
 module_dir="t-guix-package-$$"
 profile="t-profile-$$"
 rm -f "$profile"
@@ -55,8 +63,9 @@ test -f "$profile/bin/guile"
 guix package --search-paths -p "$profile"
 test "`guix package --search-paths -p "$profile" | wc -l`" = 0
 
-# Check whether we have network access.
-if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
+# Check whether we have network access and an acceptable shebang length.
+if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null \
+	 && shebang_not_too_long
 then
     boot_make="(@@ (gnu packages commencement) gnu-make-boot0)"
     boot_make_drv="`guix build -e "$boot_make" | grep -v -e -debug`"
diff --git a/tests/packages.scm b/tests/packages.scm
index 851520b343..d6371b3b49 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -176,8 +176,7 @@
     (and (direct-store-path? source)
          (string-suffix? "utils.scm" source))))
 
-(unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))
-  (test-skip 1))
+(unless (network-reachable?) (test-skip 1))
 (test-equal "package-source-derivation, snippet"
   "OK"
   (let* ((file   (search-bootstrap-binary "guile-2.0.9.tar.xz"
@@ -532,7 +531,7 @@
                      (%current-target-system "foo64-linux-gnu"))
         (equal? drv (bag->derivation %store bag))))))
 
-(unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))
+(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
diff --git a/tests/ui.scm b/tests/ui.scm
index 25fc709431..1478fe213e 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -22,6 +22,8 @@
   #:use-module (guix profiles)
   #:use-module (guix store)
   #:use-module (guix derivations)
+  #:use-module ((guix scripts build)
+                #:select (%standard-build-options))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
@@ -52,9 +54,43 @@ interface, and powerful string processing.")
     (item "/gnu/store/...")
     (output "out")))
 
+(define-syntax-rule (with-environment-variable variable value body ...)
+  "Run BODY with VARIABLE set to VALUE."
+  (let ((orig (getenv variable)))
+    (dynamic-wind
+      (lambda ()
+        (setenv variable value))
+      (lambda ()
+        body ...)
+      (lambda ()
+        (if orig
+            (setenv variable orig)
+            (unsetenv variable))))))
+
 
 (test-begin "ui")
 
+(test-equal "parse-command-line"
+  '((argument . "bar") (argument . "foo")
+    (cores . 10)                                  ;takes precedence
+    (substitutes? . #f) (keep-failed? . #t)
+    (max-jobs . 77) (cores . 42))
+
+  (with-environment-variable "GUIX_BUILD_OPTIONS" "-c 42 -M 77"
+    (parse-command-line '("--keep-failed" "--no-substitutes"
+                          "--cores=10" "foo" "bar")
+                        %standard-build-options
+                        (list '()))))
+
+(test-equal "parse-command-line and --no options"
+  '((argument . "foo")
+    (substitutes? . #f))                          ;takes precedence
+
+  (with-environment-variable "GUIX_BUILD_OPTIONS" "--no-substitutes"
+    (parse-command-line '("foo")
+                        %standard-build-options
+                        (list '((substitutes? . #t))))))
+
 (test-assert "fill-paragraph"
   (every (lambda (column)
            (every (lambda (width)
@@ -246,3 +282,7 @@ Second line" 24))
 
 
 (exit (= (test-runner-fail-count (test-runner-current)) 0))
+
+;;; Local Variables:
+;;; eval: (put 'with-environment-variable 'scheme-indent-function 2)
+;;; End:
diff --git a/tests/union.scm b/tests/union.scm
index 7e55670b86..22ba67ce99 100644
--- a/tests/union.scm
+++ b/tests/union.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -84,9 +84,7 @@
                           (call-with-input-file "bar/two" get-string-all))
                 (not (file-exists? "bar/one")))))))
 
-(test-skip (if (and %store
-                    (false-if-exception
-                     (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)))
+(test-skip (if (and %store (network-reachable?))
                0
                1))