Merge branch 'master' into staging

4 files changed, 74 insertions, 4 deletions

diff --git a/tests/derivations.scm b/tests/derivations.scm
index 36afd42d05..5d83529183 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -96,7 +96,10 @@
 (test-skip (if %store 0 12))
 
 (test-assert "add-to-store, flat"
-  (let* ((file (search-path %load-path "language/tree-il/spec.scm"))
+  ;; Use 'readlink*' in case spec.scm is a symlink, as is the case when Guile
+  ;; was installed with Stow.
+  (let* ((file (readlink*
+                (search-path %load-path "language/tree-il/spec.scm")))
          (drv  (add-to-store %store "flat-test" #f "sha256" file)))
     (and (eq? 'regular (stat:type (stat drv)))
          (valid-path? %store drv)
@@ -104,7 +107,9 @@
                  (call-with-input-file drv get-bytevector-all)))))
 
 (test-assert "add-to-store, recursive"
-  (let* ((dir (dirname (search-path %load-path "language/tree-il/spec.scm")))
+  (let* ((dir (dirname
+               (readlink* (search-path %load-path
+                                       "language/tree-il/spec.scm"))))
          (drv (add-to-store %store "dir-tree-test" #t "sha256" dir)))
     (and (eq? 'directory (stat:type (stat drv)))
          (valid-path? %store drv)
diff --git a/tests/import-utils.scm b/tests/import-utils.scm
index f4bbd335b9..5c0c041360 100644
--- a/tests/import-utils.scm
+++ b/tests/import-utils.scm
@@ -79,4 +79,23 @@
          (equal? (origin-sha256 (package-source pkg))
                  (base32 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
 
+(test-equal "alist->package with false license"  ;<https://bugs.gnu.org/30470>
+  'license-is-false
+  (let* ((meta '(("name" . "hello")
+                 ("version" . "2.10")
+                 ("source" . (("method" . "url-fetch")
+                              ("uri"    . "mirror://gnu/hello/hello-2.10.tar.gz")
+                              ("sha256" .
+                               (("base32" .
+                                 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
+                 ("build-system" . "gnu")
+                 ("home-page" . "https://gnu.org")
+                 ("synopsis" . "Say hi")
+                 ("description" . "This package says hi.")
+                 ("license" . #f))))
+    ;; Note: Use 'or' because comparing with #f otherwise succeeds when
+    ;; there's an exception instead of an actual #f.
+    (or (package-license (alist->package meta))
+        'license-is-false)))
+
 (test-end "import-utils")
diff --git a/tests/publish.scm b/tests/publish.scm
index bd1a75cf00..8c88a8c93d 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -111,6 +111,10 @@
            (sleep 1)
            (loop (- i 1))))))
 
+(define %gzip-magic-bytes
+  ;; Magic bytes of gzip file.
+  #vu8(#x1f #x8b))
+
 ;; Wait until the two servers are ready.
 (wait-until-ready 6789)
 
@@ -215,6 +219,18 @@ FileSize: ~a~%"
 
 (unless (zlib-available?)
   (test-skip 1))
+(test-equal "/nar/gzip/* is really gzip"
+  %gzip-magic-bytes
+  ;; Since 'gzdopen' (aka. 'call-with-gzip-input-port') transparently reads
+  ;; uncompressed gzip, the test above doesn't check whether it's actually
+  ;; gzip.  This is what this test does.  See <https://bugs.gnu.org/30184>.
+  (let ((nar (http-get-port
+              (publish-uri
+               (string-append "/nar/gzip/" (basename %item))))))
+    (get-bytevector-n nar (bytevector-length %gzip-magic-bytes))))
+
+(unless (zlib-available?)
+  (test-skip 1))
 (test-equal "/*.narinfo with compression"
   `(("StorePath" . ,%item)
     ("URL" . ,(string-append "nar/gzip/" (basename %item)))
diff --git a/tests/services.scm b/tests/services.scm
index ca32b565c4..b146a0dec2 100644
--- a/tests/services.scm
+++ b/tests/services.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -122,6 +122,36 @@
       (fold-services (list s) #:target-type t1)
       #f)))
 
+(test-assert "instantiate-missing-services"
+  (let* ((t1 (service-type (name 't1) (extensions '())
+                           (default-value 'dflt)
+                           (compose concatenate)
+                           (extend cons)))
+         (t2 (service-type (name 't2)
+                           (extensions
+                            (list (service-extension t1 list)))))
+         (s1 (service t1 'hey!))
+         (s2 (service t2 42)))
+    (and (lset= equal?
+                (list (service t1) s2)
+                (instantiate-missing-services (list s2)))
+         (equal? (list s1 s2)
+                 (instantiate-missing-services (list s1 s2))))))
+
+(test-assert "instantiate-missing-services, no default value"
+  (let* ((t1 (service-type (name 't1) (extensions '())))
+         (t2 (service-type (name 't2)
+                           (extensions
+                            (list (service-extension t1 list)))))
+         (s  (service t2 42)))
+    (guard (c ((missing-target-service-error? c)
+               (and (eq? (missing-target-service-error-target-type c)
+                         t1)
+                    (eq? (missing-target-service-error-service c)
+                         s))))
+      (instantiate-missing-services (list s))
+      #f)))
+
 (test-assert "shepherd-service-lookup-procedure"
   (let* ((s1 (shepherd-service (provision '(s1 s1b)) (start #f)))
          (s2 (shepherd-service (provision '(s2 s2b)) (start #f)))