summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-09-23 00:35:17 +0200
committerLudovic Courtès <ludo@gnu.org>2013-09-23 00:35:17 +0200
commit5608847c6f4131e8f30321fdf25289efd73f8689 (patch)
tree5a5910165d29455b249fd4d6612078ff5cf6ced5 /tests
parent0c456db45bf03df61cdb71db7742a44f4328fb3d (diff)
parentf59e9eaac87b4365c646a475d44b431e43949649 (diff)
downloadpatches-5608847c6f4131e8f30321fdf25289efd73f8689.tar
patches-5608847c6f4131e8f30321fdf25289efd73f8689.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/builders.scm8
-rw-r--r--tests/derivations.scm218
-rw-r--r--tests/guix-package.sh6
-rw-r--r--tests/guix-register.sh74
-rw-r--r--tests/packages.scm38
-rw-r--r--tests/store.scm36
-rw-r--r--tests/ui.scm85
-rw-r--r--tests/union.scm2
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")