aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-07-01 00:21:16 +0200
committerLudovic Courtès <ludo@gnu.org>2012-07-01 00:27:27 +0200
commit31ef99a8a590cc52cea0cfda3d45651504bf1cb9 (patch)
tree0d34bf028b1898594ce29b9df2689118232e0f3f
parente036c31bc607ec1be8037294bdfd90723f3458a8 (diff)
downloadguix-31ef99a8a590cc52cea0cfda3d45651504bf1cb9.tar
guix-31ef99a8a590cc52cea0cfda3d45651504bf1cb9.tar.gz
Add the `valid-path?' RPC.
* guix/store.scm (valid-path?): New procedure. * tests/builders.scm ("http-fetch", "gnu-build"): Use it. * tests/derivations.scm ("add-to-store, flat", "add-to-store, recursive", "derivation with no inputs", "build derivation with 1 source", "build derivation with coreutils", "build-expression->derivation with expression returning #f"): Likewise.
-rw-r--r--guix/store.scm5
-rw-r--r--tests/builders.scm13
-rw-r--r--tests/derivations.scm30
3 files changed, 32 insertions, 16 deletions
diff --git a/guix/store.scm b/guix/store.scm
index 1ecb2cc359..b525994672 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -42,6 +42,7 @@
open-connection
set-build-options
+ valid-path?
add-text-to-store
add-to-store
build-derivations
@@ -374,6 +375,10 @@ again until #t is returned or an error is raised."
(or done? (loop (process-stderr server))))
(read-arg return s))))))
+(define-operation (valid-path? (string path))
+ "Return #t when PATH is a valid store path."
+ boolean)
+
(define-operation (add-text-to-store (string name) (string text)
(string-list references))
"Add TEXT under file NAME in the store."
diff --git a/tests/builders.scm b/tests/builders.scm
index 17bae2c754..762944ba73 100644
--- a/tests/builders.scm
+++ b/tests/builders.scm
@@ -38,9 +38,11 @@
(let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")
(hash (nix-base32-string->bytevector
"0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
- (drv-path (http-fetch %store url 'sha256 hash)))
+ (drv-path (http-fetch %store url 'sha256 hash))
+ (out-path (derivation-path->output-path drv-path)))
(and (build-derivations %store (list drv-path))
- (file-exists? (derivation-path->output-path drv-path)))))
+ (file-exists? out-path)
+ (valid-path? %store out-path))))
(test-assert "gnu-build-system"
(and (build-system? gnu-build-system)
@@ -52,10 +54,11 @@
"0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
(tarball (http-fetch %store url 'sha256 hash))
(build (gnu-build %store "hello-2.8" tarball
- `(("gawk" ,(nixpkgs-derivation "gawk"))))))
+ `(("gawk" ,(nixpkgs-derivation "gawk")))))
+ (out (derivation-path->output-path build)))
(and (build-derivations %store (list (pk 'hello-drv build)))
- (file-exists? (string-append (derivation-path->output-path build)
- "/bin/hello")))))
+ (valid-path? %store out)
+ (file-exists? (string-append out "/bin/hello")))))
(test-end "builders")
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 1e9a136d04..3fc7097a87 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -71,6 +71,7 @@
(let* ((file (search-path %load-path "language/tree-il/spec.scm"))
(drv (add-to-store %store "flat-test" #t #f "sha256" file)))
(and (eq? 'regular (stat:type (stat drv)))
+ (valid-path? %store drv)
(equal? (call-with-input-file file get-bytevector-all)
(call-with-input-file drv get-bytevector-all)))))
@@ -78,15 +79,18 @@
(let* ((dir (dirname (search-path %load-path "language/tree-il/spec.scm")))
(drv (add-to-store %store "dir-tree-test" #t #t "sha256" dir)))
(and (eq? 'directory (stat:type (stat drv)))
+ (valid-path? %store drv)
(equal? (directory-contents dir)
(directory-contents drv)))))
(test-assert "derivation with no inputs"
- (let ((builder (add-text-to-store %store "my-builder.sh"
- "#!/bin/sh\necho hello, world\n"
- '())))
- (store-path? (derivation %store "foo" (%current-system) builder
- '() '(("HOME" . "/homeless")) '()))))
+ (let* ((builder (add-text-to-store %store "my-builder.sh"
+ "#!/bin/sh\necho hello, world\n"
+ '()))
+ (drv-path (derivation %store "foo" (%current-system) builder
+ '() '(("HOME" . "/homeless")) '())))
+ (and (store-path? drv-path)
+ (valid-path? %store drv-path))))
(test-assert "build derivation with 1 source"
(let*-values (((builder)
@@ -105,8 +109,9 @@
(and succeeded?
(let ((path (derivation-output-path
(assoc-ref (derivation-outputs drv) "out"))))
- (string=? (call-with-input-file path read-line)
- "hello, world")))))
+ (and (valid-path? %store path)
+ (string=? (call-with-input-file path read-line)
+ "hello, world"))))))
(test-assert "fixed-output derivation"
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
@@ -164,7 +169,8 @@
(build-derivations %store (list drv-path))))
(and succeeded?
(let ((p (derivation-path->output-path drv-path)))
- (file-exists? (string-append p "/good"))))))
+ (and (valid-path? %store p)
+ (file-exists? (string-append p "/good")))))))
(test-skip (if (%guile-for-build) 0 4))
@@ -187,12 +193,14 @@
(mkdir %output)
#f)) ; fail!
(drv-path (build-expression->derivation %store "fail" (%current-system)
- builder '())))
+ builder '()))
+ (out-path (derivation-path->output-path drv-path)))
(guard (c ((nix-protocol-error? c)
;; Note that the output path may exist at this point, but it
;; is invalid.
- (not (not (string-match "build .* failed"
- (nix-protocol-error-message c))))))
+ (and (string-match "build .* failed"
+ (nix-protocol-error-message c))
+ (not (valid-path? %store out-path)))))
(build-derivations %store (list drv-path))
#f)))