Merge branch 'master' into core-updates

5 files changed, 127 insertions, 9 deletions

diff --git a/tests/gexp.scm b/tests/gexp.scm
index 783ca2cdbc..4c31e22f15 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -40,10 +40,14 @@
   (open-connection-for-tests))
 
 ;; For white-box testing.
-(define gexp-inputs (@@ (guix gexp) gexp-inputs))
-(define gexp-native-inputs (@@ (guix gexp) gexp-native-inputs))
-(define gexp-outputs (@@ (guix gexp) gexp-outputs))
-(define gexp->sexp  (@@ (guix gexp) gexp->sexp))
+(define (gexp-inputs x)
+  ((@@ (guix gexp) gexp-inputs) x))
+(define (gexp-native-inputs x)
+  ((@@ (guix gexp) gexp-native-inputs) x))
+(define (gexp-outputs x)
+  ((@@ (guix gexp) gexp-outputs) x))
+(define (gexp->sexp . x)
+  (apply (@@ (guix gexp) gexp->sexp) x))
 
 (define* (gexp->sexp* exp #:optional target)
   (run-with-store %store (gexp->sexp exp
@@ -192,7 +196,7 @@
                  (gexp->sexp* exp target)))))
 
 (test-assert "input list splicing"
-  (let* ((inputs  (list (list glibc "debug") %bootstrap-guile))
+  (let* ((inputs  (list (gexp-input glibc "debug") %bootstrap-guile))
          (outputs (list (derivation->output-path
                          (package-derivation %store glibc)
                          "debug")
@@ -206,7 +210,7 @@
                  `(list ,@(cons 5 outputs))))))
 
 (test-assert "input list splicing + ungexp-native-splicing"
-  (let* ((inputs (list (list glibc "debug") %bootstrap-guile))
+  (let* ((inputs (list (gexp-input glibc "debug") %bootstrap-guile))
          (exp    (gexp (list (ungexp-native-splicing (cons (+ 2 3) inputs))))))
     (and (lset= equal?
                 `((,glibc "debug") (,%bootstrap-guile "out"))
@@ -539,7 +543,7 @@
            (file (text-file "bar" "This is bar."))
            (text (text-file* "foo"
                              %bootstrap-guile "/bin/guile "
-                             `(,%bootstrap-guile "out") "/bin/guile "
+                             (gexp-input %bootstrap-guile "out") "/bin/guile "
                              drv "/bin/guile "
                              file))
            (done (built-derivations (list text)))
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index b5476476e1..76e722fbc1 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -28,6 +28,8 @@ tmpfile="t-guix-system-$$"
 errorfile="t-guix-system-error-$$"
 trap 'rm -f "$tmpfile" "$errorfile"' EXIT
 
+# Reporting of syntax errors.
+
 cat > "$tmpfile"<<EOF
 ;; This is line 1, and the next one is line 2.
    (operating-system)
@@ -41,3 +43,36 @@ then
 else
     grep "$tmpfile:2:3:.*missing.* initializers" "$errorfile"
 fi
+
+
+# Reporting of duplicate service identifiers.
+
+cat > "$tmpfile" <<EOF
+(use-modules (gnu))
+(use-service-modules networking)
+
+(operating-system
+  (host-name "antelope")
+  (timezone "Europe/Paris")
+  (locale "en_US.UTF-8")
+
+  (bootloader (grub-configuration (device "/dev/sdX")))
+  (file-systems (cons (file-system
+                        (device "root")
+                        (title 'label)
+                        (mount-point "/")
+                        (type "ext4"))
+                      %base-file-systems))
+
+  (services (cons* (dhcp-client-service)
+                   (dhcp-client-service) ;twice!
+                   %base-services)))
+EOF
+
+if guix system vm "$tmpfile" 2> "$errorfile"
+then
+    # This must not succeed.
+    exit 1
+else
+    grep "service 'networking'.*more than once" "$errorfile"
+fi
diff --git a/tests/lint.scm b/tests/lint.scm
index 27be5598de..c0599224b7 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -21,7 +21,7 @@
 
 (define-module (test-packages)
   #:use-module (guix tests)
-  #:use-module (guix build download)
+  #:use-module (guix download)
   #:use-module (guix build-system gnu)
   #:use-module (guix packages)
   #:use-module (guix scripts lint)
@@ -46,6 +46,11 @@
   (string-append "http://localhost:" (number->string %http-server-port)
                  "/foo/bar"))
 
+(define %null-sha256
+  ;; SHA256 of the empty string.
+  (base32
+   "0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73"))
+
 (define %http-server-socket
   ;; Socket used by the Web server.
   (catch 'system-error
@@ -363,6 +368,34 @@ requests."
           (check-home-page pkg))))
     "not reachable: 404")))
 
+(test-skip (if %http-server-socket 0 1))
+(test-equal "source: 200"
+  ""
+  (with-warnings
+   (with-http-server 200
+     (let ((pkg (package
+                  (inherit (dummy-package "x"))
+                  (source (origin
+                            (method url-fetch)
+                            (uri %local-url)
+                            (sha256 %null-sha256))))))
+       (check-source pkg)))))
+
+(test-skip (if %http-server-socket 0 1))
+(test-assert "source: 404"
+  (->bool
+   (string-contains
+    (with-warnings
+      (with-http-server 404
+        (let ((pkg (package
+                     (inherit (dummy-package "x"))
+                     (source (origin
+                               (method url-fetch)
+                               (uri %local-url)
+                               (sha256 %null-sha256))))))
+          (check-source pkg))))
+    "not reachable: 404")))
+
 (test-end "lint")
 
 
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 1bac9d94e6..7b942e35b0 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -25,6 +25,7 @@
   #:use-module (guix packages)
   #:use-module (guix derivations)
   #:use-module (gnu packages bootstrap)
+  #:use-module ((gnu packages base) #:prefix packages:)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (srfi srfi-11)
@@ -191,6 +192,14 @@
                  (string=? (dirname (readlink bindir))
                            (derivation->output-path guile))))))
 
+(test-assertm "profile-derivation, inputs"
+  (mlet* %store-monad
+      ((entry ->   (package->manifest-entry packages:glibc "debug"))
+       (drv        (profile-derivation (manifest (list entry))
+                                       #:info-dir? #f
+                                       #:ca-certificate-bundle? #f)))
+    (return (derivation-inputs drv))))
+
 (test-end "profiles")
 
 
diff --git a/tests/store.scm b/tests/store.scm
index ee783be846..9ed78be085 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -25,6 +25,7 @@
   #:use-module (guix packages)
   #:use-module (guix derivations)
   #:use-module (guix serialization)
+  #:use-module (guix gexp)
   #:use-module (gnu packages)
   #:use-module (gnu packages bootstrap)
   #:use-module (ice-9 match)
@@ -268,6 +269,42 @@
                        (list a b c d w x y)))
            (lset= string=? s1 s3)))))
 
+(test-assert "current-build-output-port, UTF-8"
+  ;; Are UTF-8 strings in the build log properly interpreted?
+  (string-contains
+   (with-fluids ((%default-port-encoding "UTF-8")) ;for the string port
+     (call-with-output-string
+      (lambda (port)
+        (parameterize ((current-build-output-port port))
+          (let* ((s "Here’s a Greek letter: λ.")
+                 (d (build-expression->derivation
+                     %store "foo" `(display ,s)
+                     #:guile-for-build
+                     (package-derivation s %bootstrap-guile (%current-system)))))
+            (guard (c ((nix-protocol-error? c) #t))
+              (build-derivations %store (list d))))))))
+   "Here’s a Greek letter: λ."))
+
+(test-assert "current-build-output-port, UTF-8 + garbage"
+  ;; What about a mixture of UTF-8 + garbage?
+  (string-contains
+   (with-fluids ((%default-port-encoding "UTF-8")) ;for the string port
+     (call-with-output-string
+      (lambda (port)
+        (parameterize ((current-build-output-port port))
+          (let ((d (build-expression->derivation
+                    %store "foo"
+                    `(begin
+                       (use-modules (rnrs io ports))
+                       (display "garbage: ")
+                       (put-bytevector (current-output-port) #vu8(128))
+                       (display "lambda: λ\n"))
+                     #:guile-for-build
+                     (package-derivation %store %bootstrap-guile))))
+            (guard (c ((nix-protocol-error? c) #t))
+              (build-derivations %store (list d))))))))
+   "garbage: ?lambda: λ"))
+
 (test-assert "log-file, derivation"
   (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
          (s (add-to-store %store "bash" #t "sha256"