diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/derivations.scm | 11 | ||||
| -rw-r--r-- | tests/import-utils.scm | 19 | ||||
| -rw-r--r-- | tests/publish.scm | 16 | ||||
| -rw-r--r-- | tests/services.scm | 32 |
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))) |