me/guix
Archived
1
0
Fork 0
Code Activity

store: Add 'references*'.

Browse source 
* 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).
This commit is contained in:
Ludovic Courtès 2016-11-19 17:05:07 +01:00
parent 713335fa61
commit e74f64b9e5
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
4 changed files with 33 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
guix/profiles.scm
View file

@ -501,10 +501,6 @@ if not found."
#t)))) #t))))
items)) items))
;; TODO: Factorize.
(define references*
(store-lift references))
(with-monad %store-monad (with-monad %store-monad
(match (manifest-entry-item entry) (match (manifest-entry-item entry)
((? package? package) ((? package? package)

3
guix/scripts/system.scm
View file

@ -77,9 +77,6 @@
;;; Installation. ;;; Installation.
;;; ;;;
;; TODO: Factorize.
(define references*
(store-lift references))
(define topologically-sorted* (define topologically-sorted*
(store-lift topologically-sorted)) (store-lift topologically-sorted))

4
guix/store.scm
View file

@ -98,6 +98,7 @@
built-in-builders built-in-builders
references references
references/substitutes references/substitutes
references*
requisites requisites
referrers referrers
optimize-store 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* (define set-build-options*
(store-lift set-build-options)) (store-lift set-build-options))
(define references*
(store-lift references))
(define-inlinable (current-system) (define-inlinable (current-system)
;; Consult the %CURRENT-SYSTEM fluid at bind time. This is equivalent to ;; Consult the %CURRENT-SYSTEM fluid at bind time. This is equivalent to
;; (lift0 %current-system %store-monad), but inlinable, thus avoiding ;; (lift0 %current-system %store-monad), but inlinable, thus avoiding

59
tests/gexp.scm
View file

@ -375,7 +375,7 @@
(drv (gexp->file "foo" exp)) (drv (gexp->file "foo" exp))
(out -> (derivation->output-path drv)) (out -> (derivation->output-path drv))
(done (built-derivations (list drv))) (done (built-derivations (list drv)))
(refs ((store-lift references) out))) (refs (references* out)))
(return (and (equal? sexp (call-with-input-file out read)) (return (and (equal? sexp (call-with-input-file out read))
(equal? (list guile) refs))))) (equal? (list guile) refs)))))
@ -386,7 +386,7 @@
(drv (gexp->file "foo" exp)) (drv (gexp->file "foo" exp))
(out -> (derivation->output-path drv)) (out -> (derivation->output-path drv))
(done (built-derivations (list drv))) (done (built-derivations (list drv)))
(refs ((store-lift references) out))) (refs (references* out)))
(return (and (equal? (string-append guile "/bin/guile") (return (and (equal? (string-append guile "/bin/guile")
(call-with-input-file out read)) (call-with-input-file out read))
(equal? (list guile) refs))))) (equal? (list guile) refs)))))
@ -407,8 +407,8 @@
(out -> (derivation->output-path drv)) (out -> (derivation->output-path drv))
(out2 -> (derivation->output-path drv "2nd")) (out2 -> (derivation->output-path drv "2nd"))
(done (built-derivations (list drv))) (done (built-derivations (list drv)))
(refs ((store-lift references) out)) (refs (references* out))
(refs2 ((store-lift references) out2)) (refs2 (references* out2))
(guile (package-file %bootstrap-guile "bin/guile"))) (guile (package-file %bootstrap-guile "bin/guile")))
(return (and (string=? (readlink (string-append out "/foo")) guile) (return (and (string=? (readlink (string-append out "/foo")) guile)
(string=? (readlink out2) file) (string=? (readlink out2) file)
@ -481,7 +481,7 @@
(ungexp output)))) (ungexp output))))
(xdrv (gexp->derivation "foo" exp (xdrv (gexp->derivation "foo" exp
#:target target)) #:target target))
(refs ((store-lift references) (refs (references*
(derivation-file-name xdrv))) (derivation-file-name xdrv)))
(xcu (package->cross-derivation coreutils (xcu (package->cross-derivation coreutils
target)) target))
@ -506,7 +506,7 @@
(ungexp output)))) (ungexp output))))
(xdrv (gexp->derivation "foo" exp (xdrv (gexp->derivation "foo" exp
#:target target)) #:target target))
(refs ((store-lift references) (refs (references*
(derivation-file-name xdrv))) (derivation-file-name xdrv)))
(xglibc (package->cross-derivation glibc target)) (xglibc (package->cross-derivation glibc target))
(cu (package->derivation coreutils))) (cu (package->derivation coreutils)))
@ -808,34 +808,33 @@
(out -> (derivation->output-path drv))) (out -> (derivation->output-path drv)))
(mbegin %store-monad (mbegin %store-monad
(built-derivations (list drv)) (built-derivations (list drv))
(mlet %store-monad ((refs ((store-lift references) out))) (mlet %store-monad ((refs (references* out)))
(return (and (equal? refs (list text)) (return (and (equal? refs (list text))
(equal? `(list "foo" ,text) (equal? `(list "foo" ,text)
(call-with-input-file out read))))))))) (call-with-input-file out read)))))))))
(test-assert "text-file*" (test-assert "text-file*"
(let ((references (store-lift references))) (run-with-store %store
(run-with-store %store (mlet* %store-monad
(mlet* %store-monad ((drv (package->derivation %bootstrap-guile))
((drv (package->derivation %bootstrap-guile)) (guile -> (derivation->output-path drv))
(guile -> (derivation->output-path drv)) (file (text-file "bar" "This is bar."))
(file (text-file "bar" "This is bar.")) (text (text-file* "foo"
(text (text-file* "foo" %bootstrap-guile "/bin/guile "
%bootstrap-guile "/bin/guile " (gexp-input %bootstrap-guile "out") "/bin/guile "
(gexp-input %bootstrap-guile "out") "/bin/guile " drv "/bin/guile "
drv "/bin/guile " file))
file)) (done (built-derivations (list text)))
(done (built-derivations (list text))) (out -> (derivation->output-path text))
(out -> (derivation->output-path text)) (refs (references* out)))
(refs (references out))) ;; Make sure we get the right references and the right content.
;; Make sure we get the right references and the right content. (return (and (lset= string=? refs (list guile file))
(return (and (lset= string=? refs (list guile file)) (equal? (call-with-input-file out get-string-all)
(equal? (call-with-input-file out get-string-all) (string-append guile "/bin/guile "
(string-append guile "/bin/guile " guile "/bin/guile "
guile "/bin/guile " guile "/bin/guile "
guile "/bin/guile " file)))))
file))))) #:guile-for-build (package-derivation %store %bootstrap-guile)))
#:guile-for-build (package-derivation %store %bootstrap-guile))))
(test-assertm "mixed-text-file" (test-assertm "mixed-text-file"
(mlet* %store-monad ((file -> (mixed-text-file "mixed" (mlet* %store-monad ((file -> (mixed-text-file "mixed"
@ -847,7 +846,7 @@
(guile -> (derivation->output-path guile-drv))) (guile -> (derivation->output-path guile-drv)))
(mbegin %store-monad (mbegin %store-monad
(built-derivations (list drv)) (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") (return (and (string=? (string-append "export PATH=" guile "/bin")
(call-with-input-file out get-string-all)) (call-with-input-file out get-string-all))
(equal? refs (list guile)))))))) (equal? refs (list guile))))))))