diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-09-23 00:35:17 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-09-23 00:35:17 +0200 |
commit | 5608847c6f4131e8f30321fdf25289efd73f8689 (patch) | |
tree | 5a5910165d29455b249fd4d6612078ff5cf6ced5 /tests | |
parent | 0c456db45bf03df61cdb71db7742a44f4328fb3d (diff) | |
parent | f59e9eaac87b4365c646a475d44b431e43949649 (diff) | |
download | guix-5608847c6f4131e8f30321fdf25289efd73f8689.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r-- | tests/builders.scm | 8 | ||||
-rw-r--r-- | tests/derivations.scm | 218 | ||||
-rw-r--r-- | tests/guix-package.sh | 6 | ||||
-rw-r--r-- | tests/guix-register.sh | 74 | ||||
-rw-r--r-- | tests/packages.scm | 38 | ||||
-rw-r--r-- | tests/store.scm | 36 | ||||
-rw-r--r-- | tests/ui.scm | 85 | ||||
-rw-r--r-- | tests/union.scm | 2 |
8 files changed, 307 insertions, 160 deletions
diff --git a/tests/builders.scm b/tests/builders.scm index 1e6b62ee6a..0ed5d74a22 100644 --- a/tests/builders.scm +++ b/tests/builders.scm @@ -70,10 +70,10 @@ "ftp://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")) (hash (nix-base32-string->bytevector "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")) - (drv-path (url-fetch %store url 'sha256 hash + (drv (url-fetch %store url 'sha256 hash #:guile %bootstrap-guile)) - (out-path (derivation-path->output-path drv-path))) - (and (build-derivations %store (list drv-path)) + (out-path (derivation->output-path drv))) + (and (build-derivations %store (list drv)) (file-exists? out-path) (valid-path? %store out-path)))) @@ -93,7 +93,7 @@ #:implicit-inputs? #f #:guile %bootstrap-guile #:search-paths %bootstrap-search-paths)) - (out (derivation-path->output-path build))) + (out (derivation->output-path build))) (and (build-derivations %store (list (pk 'hello-drv build))) (valid-path? %store out) (file-exists? (string-append out "/bin/hello"))))) diff --git a/tests/derivations.scm b/tests/derivations.scm index 9092e3acd6..4756fb9cba 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -110,29 +110,26 @@ (let* ((builder (add-text-to-store %store "my-builder.sh" "echo hello, world\n" '())) - (drv-path (derivation %store "foo" + (drv (derivation %store "foo" %bash `("-e" ,builder) #:env-vars '(("HOME" . "/homeless"))))) - (and (store-path? drv-path) - (valid-path? %store drv-path)))) + (and (store-path? (derivation-file-name drv)) + (valid-path? %store (derivation-file-name drv))))) (test-assert "build derivation with 1 source" - (let*-values (((builder) - (add-text-to-store %store "my-builder.sh" - "echo hello, world > \"$out\"\n" - '())) - ((drv-path drv) - (derivation %store "foo" - %bash `(,builder) - #:env-vars '(("HOME" . "/homeless") - ("zzz" . "Z!") - ("AAA" . "A!")) - #:inputs `((,builder)))) - ((succeeded?) - (build-derivations %store (list drv-path)))) + (let* ((builder (add-text-to-store %store "my-builder.sh" + "echo hello, world > \"$out\"\n" + '())) + (drv (derivation %store "foo" + %bash `(,builder) + #:env-vars '(("HOME" . "/homeless") + ("zzz" . "Z!") + ("AAA" . "A!")) + #:inputs `((,builder)))) + (succeeded? + (build-derivations %store (list drv)))) (and succeeded? - (let ((path (derivation-output-path - (assoc-ref (derivation-outputs drv) "out")))) + (let ((path (derivation->output-path drv))) (and (valid-path? %store path) (string=? (call-with-input-file path read-line) "hello, world")))))) @@ -145,7 +142,7 @@ (input (search-path %load-path "ice-9/boot-9.scm")) (input* (add-to-store %store (basename input) #t "sha256" input)) - (drv-path (derivation %store "derivation-with-input-file" + (drv (derivation %store "derivation-with-input-file" %bash `(,builder) ;; Cheat to pass the actual file name to the @@ -154,22 +151,22 @@ #:inputs `((,builder) (,input))))) ; ← local file name - (and (build-derivations %store (list drv-path)) + (and (build-derivations %store (list drv)) ;; Note: we can't compare the files because the above trick alters ;; the contents. - (valid-path? %store (derivation-path->output-path drv-path))))) + (valid-path? %store (derivation->output-path drv))))) (test-assert "fixed-output derivation" (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo -n hello > $out" '())) (hash (sha256 (string->utf8 "hello"))) - (drv-path (derivation %store "fixed" + (drv (derivation %store "fixed" %bash `(,builder) #:inputs `((,builder)) ; optional #:hash hash #:hash-algo 'sha256)) - (succeeded? (build-derivations %store (list drv-path)))) + (succeeded? (build-derivations %store (list drv)))) (and succeeded? - (let ((p (derivation-path->output-path drv-path))) + (let ((p (derivation->output-path drv))) (and (equal? (string->utf8 "hello") (call-with-input-file p get-bytevector-all)) (bytevector? (query-path-hash %store p))))))) @@ -180,17 +177,16 @@ (builder2 (add-text-to-store %store "fixed-builder2.sh" "echo hey; echo -n hello > $out" '())) (hash (sha256 (string->utf8 "hello"))) - (drv-path1 (derivation %store "fixed" + (drv1 (derivation %store "fixed" %bash `(,builder1) #:hash hash #:hash-algo 'sha256)) - (drv-path2 (derivation %store "fixed" + (drv2 (derivation %store "fixed" %bash `(,builder2) #:hash hash #:hash-algo 'sha256)) - (succeeded? (build-derivations %store - (list drv-path1 drv-path2)))) + (succeeded? (build-derivations %store (list drv1 drv2)))) (and succeeded? - (equal? (derivation-path->output-path drv-path1) - (derivation-path->output-path drv-path2))))) + (equal? (derivation->output-path drv1) + (derivation->output-path drv2))))) (test-assert "derivation with a fixed-output input" ;; A derivation D using a fixed-output derivation F doesn't has the same @@ -207,7 +203,7 @@ (fixed2 (derivation %store "fixed" %bash `(,builder2) #:hash hash #:hash-algo 'sha256)) - (fixed-out (derivation-path->output-path fixed1)) + (fixed-out (derivation->output-path fixed1)) (builder3 (add-text-to-store %store "final-builder.sh" ;; Use Bash hackery to avoid Coreutils. @@ -223,26 +219,26 @@ (succeeded? (build-derivations %store (list final1 final2)))) (and succeeded? - (equal? (derivation-path->output-path final1) - (derivation-path->output-path final2))))) + (equal? (derivation->output-path final1) + (derivation->output-path final2))))) (test-assert "multiple-output derivation" (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo one > $out ; echo two > $second" '())) - (drv-path (derivation %store "fixed" + (drv (derivation %store "fixed" %bash `(,builder) #:env-vars '(("HOME" . "/homeless") ("zzz" . "Z!") ("AAA" . "A!")) #:inputs `((,builder)) #:outputs '("out" "second"))) - (succeeded? (build-derivations %store (list drv-path)))) + (succeeded? (build-derivations %store (list drv)))) (and succeeded? - (let ((one (derivation-path->output-path drv-path "out")) - (two (derivation-path->output-path drv-path "second"))) + (let ((one (derivation->output-path drv "out")) + (two (derivation->output-path drv "second"))) (and (lset= equal? - (derivation-path->output-paths drv-path) + (derivation->output-paths drv) `(("out" . ,one) ("second" . ,two))) (eq? 'one (call-with-input-file one read)) (eq? 'two (call-with-input-file two read))))))) @@ -253,14 +249,14 @@ (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo one > $out ; echo two > $AAA" '())) - (drv-path (derivation %store "fixed" + (drv (derivation %store "fixed" %bash `(,builder) #:inputs `((,builder)) #:outputs '("out" "AAA"))) - (succeeded? (build-derivations %store (list drv-path)))) + (succeeded? (build-derivations %store (list drv)))) (and succeeded? - (let ((one (derivation-path->output-path drv-path "out")) - (two (derivation-path->output-path drv-path "AAA"))) + (let ((one (derivation->output-path drv "out")) + (two (derivation->output-path drv "AAA"))) (and (eq? 'one (call-with-input-file one read)) (eq? 'two (call-with-input-file two read))))))) @@ -282,17 +278,17 @@ (udrv (derivation %store "multiple-output-user" %bash `(,builder2) #:env-vars `(("one" - . ,(derivation-path->output-path + . ,(derivation->output-path mdrv "out")) ("two" - . ,(derivation-path->output-path + . ,(derivation->output-path mdrv "two"))) #:inputs `((,builder2) ;; two occurrences of MDRV: (,mdrv) (,mdrv "two"))))) (and (build-derivations %store (list (pk 'udrv udrv))) - (let ((p (derivation-path->output-path udrv))) + (let ((p (derivation->output-path udrv))) (and (valid-path? %store p) (equal? '(one two) (call-with-input-file p read))))))) @@ -317,7 +313,7 @@ ("input1" . ,input1) ("input2" . ,input2)) #:inputs `((,%bash) (,builder)))) - (out (derivation-path->output-path drv))) + (out (derivation->output-path drv))) (define (deps path . deps) (let ((count (length deps))) (string-append path "\n\n" (number->string count) "\n" @@ -360,31 +356,30 @@ (add-text-to-store %store "build-with-coreutils.sh" "echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good" '())) - (drv-path + (drv (derivation %store "foo" %bash `(,builder) #:env-vars `(("PATH" . ,(string-append - (derivation-path->output-path %coreutils) + (derivation->output-path %coreutils) "/bin"))) #:inputs `((,builder) (,%coreutils)))) (succeeded? - (build-derivations %store (list drv-path)))) + (build-derivations %store (list drv)))) (and succeeded? - (let ((p (derivation-path->output-path drv-path))) + (let ((p (derivation->output-path drv))) (and (valid-path? %store p) (file-exists? (string-append p "/good"))))))) (test-skip (if (%guile-for-build) 0 8)) (test-assert "build-expression->derivation and derivation-prerequisites" - (let-values (((drv-path drv) - (build-expression->derivation %store "fail" (%current-system) - #f '()))) + (let ((drv (build-expression->derivation %store "fail" (%current-system) + #f '()))) (any (match-lambda (($ <derivation-input> path) - (string=? path (%guile-for-build)))) + (string=? path (derivation-file-name (%guile-for-build))))) (derivation-prerequisites drv)))) (test-assert "build-expression->derivation without inputs" @@ -393,11 +388,11 @@ (call-with-output-file (string-append %output "/test") (lambda (p) (display '(hello guix) p))))) - (drv-path (build-expression->derivation %store "goo" (%current-system) + (drv (build-expression->derivation %store "goo" (%current-system) builder '())) - (succeeded? (build-derivations %store (list drv-path)))) + (succeeded? (build-derivations %store (list drv)))) (and succeeded? - (let ((p (derivation-path->output-path drv-path))) + (let ((p (derivation->output-path drv))) (equal? '(hello guix) (call-with-input-file (string-append p "/test") read)))))) @@ -406,43 +401,35 @@ (set-build-options s #:max-silent-time 1) s)) (builder '(sleep 100)) - (drv-path (build-expression->derivation %store "silent" + (drv (build-expression->derivation %store "silent" (%current-system) builder '())) - (out-path (derivation-path->output-path drv-path))) + (out-path (derivation->output-path drv))) (guard (c ((nix-protocol-error? c) (and (string-contains (nix-protocol-error-message c) "failed") (not (valid-path? store out-path))))) - (build-derivations %store (list drv-path))))) + (build-derivations %store (list drv))))) (test-assert "build-expression->derivation and derivation-prerequisites-to-build" - (let-values (((drv-path drv) - (build-expression->derivation %store "fail" (%current-system) - #f '()))) + (let ((drv (build-expression->derivation %store "fail" (%current-system) + #f '()))) ;; The only direct dependency is (%guile-for-build) and it's already ;; built. (null? (derivation-prerequisites-to-build %store drv)))) (test-assert "derivation-prerequisites-to-build when outputs already present" - (let*-values (((builder) - '(begin (mkdir %output) #t)) - ((input-drv-path input-drv) - (build-expression->derivation %store "input" - (%current-system) - builder '())) - ((input-path) - (derivation-output-path - (assoc-ref (derivation-outputs input-drv) - "out"))) - ((drv-path drv) - (build-expression->derivation %store "something" - (%current-system) - builder - `(("i" ,input-drv-path)))) - ((output) - (derivation-output-path - (assoc-ref (derivation-outputs drv) "out")))) + (let* ((builder '(begin (mkdir %output) #t)) + (input-drv (build-expression->derivation %store "input" + (%current-system) + builder '())) + (input-path (derivation-output-path + (assoc-ref (derivation-outputs input-drv) + "out"))) + (drv (build-expression->derivation %store "something" + (%current-system) builder + `(("i" ,input-drv)))) + (output (derivation->output-path drv))) ;; Make sure these things are not already built. (when (valid-path? %store input-path) (delete-paths %store (list input-path))) @@ -451,10 +438,10 @@ (and (equal? (map derivation-input-path (derivation-prerequisites-to-build %store drv)) - (list input-drv-path)) + (list (derivation-file-name input-drv))) ;; Build DRV and delete its input. - (build-derivations %store (list drv-path)) + (build-derivations %store (list drv)) (delete-paths %store (list input-path)) (not (valid-path? %store input-path)) @@ -464,17 +451,12 @@ (test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1)) (test-assert "derivation-prerequisites-to-build and substitutes" - (let*-values (((store) - (open-connection)) - ((drv-path drv) - (build-expression->derivation store "prereq-subst" + (let* ((store (open-connection)) + (drv (build-expression->derivation store "prereq-subst" (%current-system) (random 1000) '())) - ((output) - (derivation-output-path - (assoc-ref (derivation-outputs drv) "out"))) - ((dir) - (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") + (output (derivation->output-path drv)) + (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) ;; Create fake substituter data, to be read by `substitute-binary'. (call-with-output-file (string-append dir "/nix-cache-info") @@ -494,7 +476,8 @@ Deriver: ~a~%" output ; StorePath (string-append dir "/example.nar") ; URL (%current-system) ; System - (basename drv-path)))) ; Deriver + (basename + (derivation-file-name drv))))) ; Deriver (let-values (((build download) (derivation-prerequisites-to-build store drv)) @@ -511,16 +494,16 @@ Deriver: ~a~%" (let* ((builder '(begin (mkdir %output) #f)) ; fail! - (drv-path (build-expression->derivation %store "fail" (%current-system) + (drv (build-expression->derivation %store "fail" (%current-system) builder '())) - (out-path (derivation-path->output-path drv-path))) + (out-path (derivation->output-path drv))) (guard (c ((nix-protocol-error? c) ;; Note that the output path may exist at this point, but it ;; is invalid. (and (string-match "build .* failed" (nix-protocol-error-message c)) (not (valid-path? %store out-path))))) - (build-derivations %store (list drv-path)) + (build-derivations %store (list drv)) #f))) (test-assert "build-expression->derivation with two outputs" @@ -531,15 +514,15 @@ Deriver: ~a~%" (call-with-output-file (assoc-ref %outputs "second") (lambda (p) (display '(world) p))))) - (drv-path (build-expression->derivation %store "double" + (drv (build-expression->derivation %store "double" (%current-system) builder '() #:outputs '("out" "second"))) - (succeeded? (build-derivations %store (list drv-path)))) + (succeeded? (build-derivations %store (list drv)))) (and succeeded? - (let ((one (derivation-path->output-path drv-path)) - (two (derivation-path->output-path drv-path "second"))) + (let ((one (derivation->output-path drv)) + (two (derivation->output-path drv "second"))) (and (equal? '(hello) (call-with-input-file one read)) (equal? '(world) (call-with-input-file two read))))))) @@ -552,12 +535,12 @@ Deriver: ~a~%" (dup2 (port->fdes p) 1) (execl (string-append cu "/bin/uname") "uname" "-a"))))) - (drv-path (build-expression->derivation %store "uname" (%current-system) + (drv (build-expression->derivation %store "uname" (%current-system) builder `(("cu" ,%coreutils)))) - (succeeded? (build-derivations %store (list drv-path)))) + (succeeded? (build-derivations %store (list drv)))) (and succeeded? - (let ((p (derivation-path->output-path drv-path))) + (let ((p (derivation->output-path drv))) (string-contains (call-with-input-file p read-line) "GNU"))))) (test-assert "imported-files" @@ -566,9 +549,9 @@ Deriver: ~a~%" "guix/derivations.scm")) ("p/q" . ,(search-path %load-path "guix.scm")) ("p/z" . ,(search-path %load-path "guix/store.scm")))) - (drv-path (imported-files %store files))) - (and (build-derivations %store (list drv-path)) - (let ((dir (derivation-path->output-path drv-path))) + (drv (imported-files %store files))) + (and (build-derivations %store (list drv)) + (let ((dir (derivation->output-path drv))) (every (match-lambda ((path . source) (equal? (call-with-input-file (string-append dir "/" path) @@ -583,14 +566,13 @@ Deriver: ~a~%" (let ((out (assoc-ref %outputs "out"))) (mkdir-p (string-append out "/guile/guix/nix")) #t))) - (drv-path (build-expression->derivation %store - "test-with-modules" + (drv (build-expression->derivation %store "test-with-modules" (%current-system) builder '() #:modules '((guix build utils))))) - (and (build-derivations %store (list drv-path)) - (let* ((p (derivation-path->output-path drv-path)) + (and (build-derivations %store (list drv)) + (let* ((p (derivation->output-path drv)) (s (stat (string-append p "/guile/guix/nix")))) (eq? (stat:type s) 'directory))))) @@ -614,9 +596,10 @@ Deriver: ~a~%" #:hash-algo 'sha256)) (succeeded? (build-derivations %store (list input1 input2)))) (and succeeded? - (not (string=? input1 input2)) - (string=? (derivation-path->output-path input1) - (derivation-path->output-path input2))))) + (not (string=? (derivation-file-name input1) + (derivation-file-name input2))) + (string=? (derivation->output-path input1) + (derivation->output-path input2))))) (test-assert "build-expression->derivation with a fixed-output input" (let* ((builder1 '(call-with-output-file %output @@ -648,8 +631,11 @@ Deriver: ~a~%" (%current-system) builder3 `(("input" ,input2))))) - (and (string=? (derivation-path->output-path final1) - (derivation-path->output-path final2)) + (and (string=? (derivation->output-path final1) + (derivation->output-path final2)) + (string=? (derivation->output-path final1) + (derivation-path->output-path + (derivation-file-name final1))) (build-derivations %store (list final1 final2))))) (test-assert "build-expression->derivation with #:references-graphs" @@ -661,7 +647,7 @@ Deriver: ~a~%" builder '() #:references-graphs `(("input" . ,input)))) - (out (derivation-path->output-path drv))) + (out (derivation->output-path drv))) (define (deps path . deps) (let ((count (length deps))) (string-append path "\n\n" (number->string count) "\n" diff --git a/tests/guix-package.sh b/tests/guix-package.sh index ee186ead83..b09a9c0173 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -55,7 +55,7 @@ test "`guix package --search-paths -p "$profile" | wc -l`" = 0 if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null then boot_make="(@@ (gnu packages base) gnu-make-boot0)" - boot_make_drv="`guix build -e "$boot_make" | tail -1`" + boot_make_drv="`guix build -e "$boot_make" | grep -v -e -debug`" guix package --bootstrap -p "$profile" -i "$boot_make_drv" test -L "$profile-2-link" test -f "$profile/bin/make" && test -f "$profile/bin/guile" @@ -81,6 +81,10 @@ then "name: hello" test "`guix package -s "n0t4r341p4ck4g3"`" = "" + # List generations. + test "`guix package -p "$profile" -l | cut -f1 | grep guile | head -n1`" \ + = " guile-bootstrap" + # Remove a package. guix package --bootstrap -p "$profile" -r "guile-bootstrap" test -L "$profile-3-link" diff --git a/tests/guix-register.sh b/tests/guix-register.sh new file mode 100644 index 0000000000..b76a1af54f --- /dev/null +++ b/tests/guix-register.sh @@ -0,0 +1,74 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +# +# This file is part of GNU Guix. +# +# GNU Guix is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or (at +# your option) any later version. +# +# GNU Guix is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +# +# Test the 'guix-register' command-line utility. +# + +guix-register --version + +new_store="t-register-$$" +closure="t-register-closure-$$" +rm -rf "$new_store" + +exit_hook=":" +trap "chmod -R +w $new_store ; rm -rf $new_store $closure ; \$exit_hook" EXIT + +mkdir -p "$new_store/$storedir" +new_store_dir="`cd "$new_store/$storedir" ; pwd`" +new_store="`cd "$new_store" ; pwd`" + +to_copy="`guix build guile-bootstrap`" +cp -r "$to_copy" "$new_store_dir" +copied="$new_store_dir/`basename $to_copy`" + +# Create a file representing a closure with zero references, and with an empty +# "deriver" field. +cat >> "$closure" <<EOF +$copied + +0 +EOF + +# Register it. +guix-register -p "$new_store" < "$closure" + +# Doing it a second time shouldn't hurt. +guix-register -p "$new_store" "$closure" + +# Now make sure this is recognized as valid. + +NIX_IGNORE_SYMLINK_STORE=1 +NIX_STORE_DIR="$new_store_dir" +NIX_LOCALSTATE_DIR="$new_store$localstatedir" +NIX_LOG_DIR="$new_store$localstatedir/log/nix" +NIX_DB_DIR="$new_store$localstatedir/nix/db" + +export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR NIX_LOCALSTATE_DIR \ + NIX_LOG_DIR NIX_DB_DIR + +guix-daemon --disable-chroot & +subdaemon_pid=$! +exit_hook="kill $subdaemon_pid" + +# At this point the copy in $new_store must be valid, and unreferenced. +guile -c " + (use-modules (guix store)) + (define s (open-connection)) + (exit (and (valid-path? s \"$copied\") + (equal? (list \"$copied\") (dead-paths s))))" diff --git a/tests/packages.scm b/tests/packages.scm index 8619011f59..706739fb70 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -121,17 +121,16 @@ (package-source package)))) (string=? file source))) -(test-assert "return values" - (let-values (((drv-path drv) - (package-derivation %store (dummy-package "p")))) - (and (derivation-path? drv-path) - (derivation? drv)))) +(test-assert "return value" + (let ((drv (package-derivation %store (dummy-package "p")))) + (and (derivation? drv) + (file-exists? (derivation-file-name drv))))) (test-assert "package-output" (let* ((package (dummy-package "p")) - (drv-path (package-derivation %store package))) - (and (derivation-path? drv-path) - (string=? (derivation-path->output-path drv-path) + (drv (package-derivation %store package))) + (and (derivation? drv) + (string=? (derivation->output-path drv) (package-output %store package "out"))))) (test-assert "trivial" @@ -148,7 +147,7 @@ (display '(hello guix) p)))))))) (d (package-derivation %store p))) (and (build-derivations %store (list d)) - (let ((p (pk 'drv d (derivation-path->output-path d)))) + (let ((p (pk 'drv d (derivation->output-path d)))) (equal? '(hello guix) (call-with-input-file (string-append p "/test") read)))))) @@ -164,7 +163,7 @@ (inputs `(("input" ,i))))) (d (package-derivation %store p))) (and (build-derivations %store (list d)) - (let ((p (pk 'drv d (derivation-path->output-path d)))) + (let ((p (pk 'drv d (derivation->output-path d)))) (equal? (call-with-input-file p get-bytevector-all) (call-with-input-file i get-bytevector-all)))))) @@ -183,7 +182,7 @@ (%current-system))))))) (d (package-derivation %store p))) (and (build-derivations %store (list d)) - (let ((p (pk 'drv d (derivation-path->output-path d)))) + (let ((p (pk 'drv d (derivation->output-path d)))) (eq? 'hello (call-with-input-file p read)))))) (test-assert "search paths" @@ -222,20 +221,17 @@ (equal? x (collect (package-derivation %store c))))))) (test-assert "package-cross-derivation" - (let-values (((drv-path drv) - (package-cross-derivation %store (dummy-package "p") - "mips64el-linux-gnu"))) - (and (derivation-path? drv-path) - (derivation? drv)))) + (let ((drv (package-cross-derivation %store (dummy-package "p") + "mips64el-linux-gnu"))) + (and (derivation? drv) + (file-exists? (derivation-file-name drv))))) (test-assert "package-cross-derivation, trivial-build-system" (let ((p (package (inherit (dummy-package "p")) (build-system trivial-build-system) (arguments '(#:builder (exit 1)))))) - (let-values (((drv-path drv) - (package-cross-derivation %store p "mips64el-linux-gnu"))) - (and (derivation-path? drv-path) - (derivation? drv))))) + (let ((drv (package-cross-derivation %store p "mips64el-linux-gnu"))) + (derivation? drv)))) (test-assert "package-cross-derivation, no cross builder" (let* ((b (build-system (inherit trivial-build-system) @@ -257,7 +253,7 @@ (or (location? (package-location gnu-make)) (not (package-location gnu-make))) (let* ((drv (package-derivation %store gnu-make)) - (out (derivation-path->output-path drv))) + (out (derivation->output-path drv))) (and (build-derivations %store (list drv)) (file-exists? (string-append out "/bin/make"))))))) diff --git a/tests/store.scm b/tests/store.scm index 9625a6b308..b5e0cb0eab 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -68,8 +68,7 @@ (test-skip (if %store 0 10)) (test-assert "dead-paths" - (let ((p (add-text-to-store %store "random-text" - (random-text) '()))) + (let ((p (add-text-to-store %store "random-text" (random-text)))) (member p (dead-paths %store)))) ;; FIXME: Find a test for `live-paths'. @@ -83,7 +82,7 @@ ;; (d1 (derivation %store "link" ;; "/bin/sh" `("-e" ,b) ;; #:inputs `((,b) (,p1)))) -;; (p2 (derivation-path->output-path d1))) +;; (p2 (derivation->output-path d1))) ;; (and (add-temp-root %store p2) ;; (build-derivations %store (list d1)) ;; (valid-path? %store p1) @@ -99,7 +98,7 @@ (test-assert "references" (let* ((t1 (add-text-to-store %store "random1" - (random-text) '())) + (random-text))) (t2 (add-text-to-store %store "random2" (random-text) (list t1)))) (and (equal? (list t1) (references %store t2)) @@ -134,21 +133,21 @@ s `("-e" ,b) #:env-vars `(("foo" . ,(random-text))) #:inputs `((,b) (,s)))) - (o (derivation-path->output-path d))) + (o (derivation->output-path d))) (and (build-derivations %store (list d)) - (equal? (query-derivation-outputs %store d) + (equal? (query-derivation-outputs %store (derivation-file-name d)) (list o)) (equal? (valid-derivers %store o) - (list d))))) + (list (derivation-file-name d)))))) (test-assert "no substitutes" (let* ((s (open-connection)) (d1 (package-derivation s %bootstrap-guile (%current-system))) (d2 (package-derivation s %bootstrap-glibc (%current-system))) - (o (map derivation-path->output-path (list d1 d2)))) + (o (map derivation->output-path (list d1 d2)))) (set-build-options s #:use-substitutes? #f) - (and (not (has-substitutes? s d1)) - (not (has-substitutes? s d2)) + (and (not (has-substitutes? s (derivation-file-name d1))) + (not (has-substitutes? s (derivation-file-name d2))) (null? (substitutable-paths s o)) (null? (substitutable-path-info s o))))) @@ -157,7 +156,7 @@ (test-assert "substitute query" (let* ((s (open-connection)) (d (package-derivation s %bootstrap-guile (%current-system))) - (o (derivation-path->output-path d)) + (o (derivation->output-path d)) (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) ;; Create fake substituter data, to be read by `substitute-binary'. @@ -178,7 +177,8 @@ Deriver: ~a~%" o ; StorePath (string-append dir "/example.nar") ; URL (%current-system) ; System - (basename d)))) ; Deriver + (basename + (derivation-file-name d))))) ; Deriver ;; Remove entry from the local cache. (false-if-exception @@ -192,7 +192,7 @@ Deriver: ~a~%" (equal? (list o) (substitutable-paths s (list o))) (match (pk 'spi (substitutable-path-info s (list o))) (((? substitutable? s)) - (and (equal? (substitutable-deriver s) d) + (and (string=? (substitutable-deriver s) (derivation-file-name d)) (null? (substitutable-references s)) (equal? (substitutable-nar-size s) 1234))))))) @@ -208,7 +208,7 @@ Deriver: ~a~%" '() #:guile-for-build (package-derivation s %bootstrap-guile (%current-system)))) - (o (derivation-path->output-path d)) + (o (derivation->output-path d)) (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) ;; Create fake substituter data, to be read by `substitute-binary'. @@ -239,7 +239,8 @@ Deriver: ~a~%" (compose bytevector->nix-base32-string sha256 get-bytevector-all)) (%current-system) ; System - (basename d)))) ; Deriver + (basename + (derivation-file-name d))))) ; Deriver ;; Make sure we use `substitute-binary'. (set-build-options s #:use-substitutes? #t) @@ -258,7 +259,7 @@ Deriver: ~a~%" '() #:guile-for-build (package-derivation s %bootstrap-guile (%current-system)))) - (o (derivation-path->output-path d)) + (o (derivation->output-path d)) (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) ;; Create fake substituter data, to be read by `substitute-binary'. @@ -280,7 +281,8 @@ Deriver: ~a~%" o ; StorePath "does-not-exist.nar" ; relative URL (%current-system) ; System - (basename d)))) ; Deriver + (basename + (derivation-file-name d))))) ; Deriver ;; Make sure we use `substitute-binary'. (set-build-options s #:use-substitutes? #t) diff --git a/tests/ui.scm b/tests/ui.scm index 0b6f3c5815..3d5c3e7969 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -20,6 +20,7 @@ (define-module (test-ui) #:use-module (guix ui) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) #:use-module (srfi srfi-64)) ;; Test the (guix ui) module. @@ -64,6 +65,90 @@ interface, and powerful string processing.") 10) #\newline)) +(test-equal "integer" + '(1) + (string->generations "1")) + +(test-equal "comma-separated integers" + '(3 7 1 4 6) + (string->generations "3,7,1,4,6")) + +(test-equal "closed range" + '(4 5 6 7 8 9 10 11 12) + (string->generations "4..12")) + +(test-equal "closed range, equal endpoints" + '(3) + (string->generations "3..3")) + +(test-equal "indefinite end range" + '(>= 7) + (string->generations "7..")) + +(test-equal "indefinite start range" + '(<= 42) + (string->generations "..42")) + +(test-equal "integer, char" + #f + (string->generations "a")) + +(test-equal "comma-separated integers, consecutive comma" + #f + (string->generations "1,,2")) + +(test-equal "comma-separated integers, trailing comma" + #f + (string->generations "1,2,")) + +(test-equal "comma-separated integers, chars" + #f + (string->generations "a,b")) + +(test-equal "closed range, start > end" + #f + (string->generations "9..2")) + +(test-equal "closed range, chars" + #f + (string->generations "a..b")) + +(test-equal "indefinite end range, char" + #f + (string->generations "a..")) + +(test-equal "indefinite start range, char" + #f + (string->generations "..a")) + +(test-equal "duration, 1 day" + (make-time time-duration 0 (* 3600 24)) + (string->duration "1d")) + +(test-equal "duration, 1 week" + (make-time time-duration 0 (* 3600 24 7)) + (string->duration "1w")) + +(test-equal "duration, 1 month" + (make-time time-duration 0 (* 3600 24 30)) + (string->duration "1m")) + +(test-equal "duration, 1 week == 7 days" + (string->duration "1w") + (string->duration "7d")) + +(test-equal "duration, 1 month == 30 days" + (string->duration "1m") + (string->duration "30d")) + +(test-equal "duration, integer" + #f + (string->duration "1")) + +(test-equal "duration, char" + #f + (string->duration "d")) + (test-end "ui") diff --git a/tests/union.scm b/tests/union.scm index 6287cffc38..cb110c3b1e 100644 --- a/tests/union.scm +++ b/tests/union.scm @@ -108,7 +108,7 @@ builder inputs #:modules '((guix build union))))) (and (build-derivations %store (list (pk 'drv drv))) - (with-directory-excursion (derivation-path->output-path drv) + (with-directory-excursion (derivation->output-path drv) (and (file-exists? "bin/touch") (file-exists? "bin/gcc") (file-exists? "bin/ld") |