02/05: store: Add 'references*'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit e74f64b9e55cbc3052698830001238d2407fed19
Author: Ludovic Courtès <address@hidden>
Date:   Sat Nov 19 17:05:07 2016 +0100

    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).
---
 guix/profiles.scm       |    4 ----
 guix/scripts/system.scm |    3 ---
 guix/store.scm          |    4 ++++
 tests/gexp.scm          |   59 +++++++++++++++++++++++------------------------
 4 files changed, 33 insertions(+), 37 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index b56b8f4..0b317ef 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 71ddccf..bb373a6 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 3047dc3..7f54b87 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 214e7a5..354d28f 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))))))))