diff options
author | Mark H Weaver <mhw@netris.org> | 2018-01-23 17:01:07 -0500 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2018-01-23 17:01:07 -0500 |
commit | a102d359a68ce7219a1880e47dd6f9332cbbce3a (patch) | |
tree | d879e718f08d776ad84c456c91a349e59941d1f2 /tests | |
parent | 07b8ea841e1e2eda5b367f35cf68d23d0520cc4d (diff) | |
parent | f3a13a21e50fa3751fc39e5768ea6843bfc19df2 (diff) | |
download | guix-a102d359a68ce7219a1880e47dd6f9332cbbce3a.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r-- | tests/publish.scm | 16 | ||||
-rw-r--r-- | tests/services.scm | 32 |
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))) |