tribes/guix
1
0
Fork 1
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-05-27 19:41:50 +02:00
Code Activity

vm: Move store copy handling to (guix build store-copy).

Browse Source 
* 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.
This commit is contained in:
Ludovic Courtès
2014-09-04 23:05:12 +02:00
parent b21a1c5a18
commit 6fd1a79674
5 changed files with 111 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tests/gexp.scm
+38
View File
@@ -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"))