Browse Source

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.
version-0.8.3
Ludovic Courtès 10 years ago
parent
commit
31ef99a8a5
  1. 5
      guix/store.scm
  2. 13
      tests/builders.scm
  3. 30
      tests/derivations.scm

5
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."

13
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")

30
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)))

Loading…
Cancel
Save