diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-09-04 23:05:12 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-09-04 23:24:54 +0200 |
commit | 6fd1a7967481037560d2ab25f31da182822ef889 (patch) | |
tree | 1813e15f7535d84ffb48e53b31ed141d3d9b0323 /tests | |
parent | b21a1c5a18e2e0f564812bd8a94a587d0234c68d (diff) | |
download | guix-6fd1a7967481037560d2ab25f31da182822ef889.tar.gz guix-6fd1a7967481037560d2ab25f31da182822ef889.zip |
vm: Move store copy handling to (guix build store-copy).
* gnu/build/vm.scm (read-reference-graph, populate-store): Move to...
* guix/build/store-copy.scm: ... here. New file.
* Makefile.am (MODULES): Add it.
* gnu/system/vm.scm (expression->derivation-in-linux-vm): Adjust default
#:modules values accordingly.
* tests/gexp.scm ("gexp->derivation, store copy"): New test.
Diffstat (limited to 'tests')
-rw-r--r-- | tests/gexp.scm | 38 |
1 files changed, 38 insertions, 0 deletions
diff --git a/tests/gexp.scm b/tests/gexp.scm index bf52401c66..a08164c484 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -324,6 +324,44 @@ (return (string=? (derivation-file-name drv) (derivation-file-name xdrv))))) +(test-assertm "gexp->derivation, store copy" + (let ((build-one #~(call-with-output-file #$output + (lambda (port) + (display "This is the one." port)))) + (build-two (lambda (one) + #~(begin + (mkdir #$output) + (symlink #$one (string-append #$output "/one")) + (call-with-output-file (string-append #$output "/two") + (lambda (port) + (display "This is the second one." port)))))) + (build-drv (lambda (two) + #~(begin + (use-modules (guix build store-copy)) + + (mkdir #$output) + '#$two ;make it an input + (populate-store '("graph") #$output))))) + (mlet* %store-monad ((one (gexp->derivation "one" build-one)) + (two (gexp->derivation "two" (build-two one))) + (dir -> (derivation->output-path two)) + (drv (gexp->derivation "store-copy" (build-drv two) + #:references-graphs + `(("graph" . ,dir)) + #:modules + '((guix build store-copy) + (guix build utils)))) + (ok? (built-derivations (list drv))) + (out -> (derivation->output-path drv))) + (let ((one (derivation->output-path one)) + (two (derivation->output-path two))) + (return (and ok? + (file-exists? (string-append out "/" one)) + (file-exists? (string-append out "/" two)) + (file-exists? (string-append out "/" two "/two")) + (string=? (readlink (string-append out "/" two "/one")) + one))))))) + (define shebang (string-append "#!" (derivation->output-path (%guile-for-build)) "/bin/guile --no-auto-compile")) |