aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-09-04 23:05:12 +0200
committerLudovic Courtès <ludo@gnu.org>2014-09-04 23:24:54 +0200
commit6fd1a7967481037560d2ab25f31da182822ef889 (patch)
tree1813e15f7535d84ffb48e53b31ed141d3d9b0323 /tests
parentb21a1c5a18e2e0f564812bd8a94a587d0234c68d (diff)
downloadpatches-6fd1a7967481037560d2ab25f31da182822ef889.tar
patches-6fd1a7967481037560d2ab25f31da182822ef889.tar.gz
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.scm38
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"))