aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-11-19 17:05:07 +0100
committerLudovic Courtès <ludo@gnu.org>2016-11-19 18:44:53 +0100
commite74f64b9e55cbc3052698830001238d2407fed19 (patch)
treefe2b0d8aba16272b4e51ea904c7907cc32b964e4
parent713335fa610713dc9491fc4848f5f5842423b143 (diff)
downloadpatches-e74f64b9e55cbc3052698830001238d2407fed19.tar
patches-e74f64b9e55cbc3052698830001238d2407fed19.tar.gz
store: Add 'references*'.
* guix/store.scm (references*): New procedure. * guix/profiles.scm (manifest-lookup-package)[references*]: Remove. * guix/scripts/system.scm (references*): Remove. * tests/gexp.scm ("gexp->file", "gexp->file + file-append") ("gexp->derivation", "gexp->derivation, cross-compilation") ("gexp->derivation, ungexp + ungexp-native") ("scheme-file", "text-file*", "mixed-text-file"): Remove 'references*' instead of (store-lift references).
-rw-r--r--guix/profiles.scm4
-rw-r--r--guix/scripts/system.scm3
-rw-r--r--guix/store.scm4
-rw-r--r--tests/gexp.scm59
4 files changed, 33 insertions, 37 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm
index b56b8f4c79..0b317ef51e 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -501,10 +501,6 @@ if not found."
#t))))
items))
- ;; TODO: Factorize.
- (define references*
- (store-lift references))
-
(with-monad %store-monad
(match (manifest-entry-item entry)
((? package? package)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 71ddccfa61..bb373a6726 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -77,9 +77,6 @@
;;; Installation.
;;;
-;; TODO: Factorize.
-(define references*
- (store-lift references))
(define topologically-sorted*
(store-lift topologically-sorted))
diff --git a/guix/store.scm b/guix/store.scm
index 3047dc39b9..7f54b87db1 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -98,6 +98,7 @@
built-in-builders
references
references/substitutes
+ references*
requisites
referrers
optimize-store
@@ -1170,6 +1171,9 @@ where FILE is the entry's absolute file name and STAT is the result of
(define set-build-options*
(store-lift set-build-options))
+(define references*
+ (store-lift references))
+
(define-inlinable (current-system)
;; Consult the %CURRENT-SYSTEM fluid at bind time. This is equivalent to
;; (lift0 %current-system %store-monad), but inlinable, thus avoiding
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 214e7a5302..354d28f014 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -375,7 +375,7 @@
(drv (gexp->file "foo" exp))
(out -> (derivation->output-path drv))
(done (built-derivations (list drv)))
- (refs ((store-lift references) out)))
+ (refs (references* out)))
(return (and (equal? sexp (call-with-input-file out read))
(equal? (list guile) refs)))))
@@ -386,7 +386,7 @@
(drv (gexp->file "foo" exp))
(out -> (derivation->output-path drv))
(done (built-derivations (list drv)))
- (refs ((store-lift references) out)))
+ (refs (references* out)))
(return (and (equal? (string-append guile "/bin/guile")
(call-with-input-file out read))
(equal? (list guile) refs)))))
@@ -407,8 +407,8 @@
(out -> (derivation->output-path drv))
(out2 -> (derivation->output-path drv "2nd"))
(done (built-derivations (list drv)))
- (refs ((store-lift references) out))
- (refs2 ((store-lift references) out2))
+ (refs (references* out))
+ (refs2 (references* out2))
(guile (package-file %bootstrap-guile "bin/guile")))
(return (and (string=? (readlink (string-append out "/foo")) guile)
(string=? (readlink out2) file)
@@ -481,7 +481,7 @@
(ungexp output))))
(xdrv (gexp->derivation "foo" exp
#:target target))
- (refs ((store-lift references)
+ (refs (references*
(derivation-file-name xdrv)))
(xcu (package->cross-derivation coreutils
target))
@@ -506,7 +506,7 @@
(ungexp output))))
(xdrv (gexp->derivation "foo" exp
#:target target))
- (refs ((store-lift references)
+ (refs (references*
(derivation-file-name xdrv)))
(xglibc (package->cross-derivation glibc target))
(cu (package->derivation coreutils)))
@@ -808,34 +808,33 @@
(out -> (derivation->output-path drv)))
(mbegin %store-monad
(built-derivations (list drv))
- (mlet %store-monad ((refs ((store-lift references) out)))
+ (mlet %store-monad ((refs (references* out)))
(return (and (equal? refs (list text))
(equal? `(list "foo" ,text)
(call-with-input-file out read)))))))))
(test-assert "text-file*"
- (let ((references (store-lift references)))
- (run-with-store %store
- (mlet* %store-monad
- ((drv (package->derivation %bootstrap-guile))
- (guile -> (derivation->output-path drv))
- (file (text-file "bar" "This is bar."))
- (text (text-file* "foo"
- %bootstrap-guile "/bin/guile "
- (gexp-input %bootstrap-guile "out") "/bin/guile "
- drv "/bin/guile "
- file))
- (done (built-derivations (list text)))
- (out -> (derivation->output-path text))
- (refs (references out)))
- ;; Make sure we get the right references and the right content.
- (return (and (lset= string=? refs (list guile file))
- (equal? (call-with-input-file out get-string-all)
- (string-append guile "/bin/guile "
- guile "/bin/guile "
- guile "/bin/guile "
- file)))))
- #:guile-for-build (package-derivation %store %bootstrap-guile))))
+ (run-with-store %store
+ (mlet* %store-monad
+ ((drv (package->derivation %bootstrap-guile))
+ (guile -> (derivation->output-path drv))
+ (file (text-file "bar" "This is bar."))
+ (text (text-file* "foo"
+ %bootstrap-guile "/bin/guile "
+ (gexp-input %bootstrap-guile "out") "/bin/guile "
+ drv "/bin/guile "
+ file))
+ (done (built-derivations (list text)))
+ (out -> (derivation->output-path text))
+ (refs (references* out)))
+ ;; Make sure we get the right references and the right content.
+ (return (and (lset= string=? refs (list guile file))
+ (equal? (call-with-input-file out get-string-all)
+ (string-append guile "/bin/guile "
+ guile "/bin/guile "
+ guile "/bin/guile "
+ file)))))
+ #:guile-for-build (package-derivation %store %bootstrap-guile)))
(test-assertm "mixed-text-file"
(mlet* %store-monad ((file -> (mixed-text-file "mixed"
@@ -847,7 +846,7 @@
(guile -> (derivation->output-path guile-drv)))
(mbegin %store-monad
(built-derivations (list drv))
- (mlet %store-monad ((refs ((store-lift references) out)))
+ (mlet %store-monad ((refs (references* out)))
(return (and (string=? (string-append "export PATH=" guile "/bin")
(call-with-input-file out get-string-all))
(equal? refs (list guile))))))))