summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2018-01-23 17:01:07 -0500
committerMark H Weaver <mhw@netris.org>2018-01-23 17:01:07 -0500
commita102d359a68ce7219a1880e47dd6f9332cbbce3a (patch)
treed879e718f08d776ad84c456c91a349e59941d1f2 /tests
parent07b8ea841e1e2eda5b367f35cf68d23d0520cc4d (diff)
parentf3a13a21e50fa3751fc39e5768ea6843bfc19df2 (diff)
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/publish.scm16
-rw-r--r--tests/services.scm32
2 files changed, 47 insertions, 1 deletions
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)))