store: Remove 'references/substitutes'.
This procedure lost its only user in commit
710854304b
.
* guix/store.scm (references/substitutes): Remove.
* tests/store.scm ("references/substitutes missing reference info")
("references/substitutes with substitute info"): Remove.
This commit is contained in:
parent
4a93fb0595
commit
2725f04634
@ -148,7 +148,6 @@
|
|||||||
built-in-builders
|
built-in-builders
|
||||||
references
|
references
|
||||||
references/cached
|
references/cached
|
||||||
references/substitutes
|
|
||||||
references*
|
references*
|
||||||
query-path-info*
|
query-path-info*
|
||||||
requisites
|
requisites
|
||||||
@ -1481,7 +1480,7 @@ error if there is no such root."
|
|||||||
;; Brute-force cache mapping store items to their list of references.
|
;; Brute-force cache mapping store items to their list of references.
|
||||||
;; Caching matters because when building a profile in the presence of
|
;; Caching matters because when building a profile in the presence of
|
||||||
;; grafts, we keep calling 'graft-derivation', which in turn calls
|
;; grafts, we keep calling 'graft-derivation', which in turn calls
|
||||||
;; 'references/substitutes' many times with the same arguments. Ideally we
|
;; 'references/cached' many times with the same arguments. Ideally we
|
||||||
;; would use a cache associated with the daemon connection instead (XXX).
|
;; would use a cache associated with the daemon connection instead (XXX).
|
||||||
(make-hash-table 100))
|
(make-hash-table 100))
|
||||||
|
|
||||||
@ -1492,58 +1491,6 @@ error if there is no such root."
|
|||||||
(hash-set! %reference-cache item references)
|
(hash-set! %reference-cache item references)
|
||||||
references)))
|
references)))
|
||||||
|
|
||||||
(define (references/substitutes store items)
|
|
||||||
"Return the list of list of references of ITEMS; the result has the same
|
|
||||||
length as ITEMS. Query substitute information for any item missing from the
|
|
||||||
store at once. Raise a '&store-protocol-error' exception if reference
|
|
||||||
information for one of ITEMS is missing."
|
|
||||||
(let* ((requested items)
|
|
||||||
(local-refs (map (lambda (item)
|
|
||||||
(or (hash-ref %reference-cache item)
|
|
||||||
(guard (c ((store-protocol-error? c) #f))
|
|
||||||
(references store item))))
|
|
||||||
items))
|
|
||||||
(missing (fold-right (lambda (item local-ref result)
|
|
||||||
(if local-ref
|
|
||||||
result
|
|
||||||
(cons item result)))
|
|
||||||
'()
|
|
||||||
items local-refs))
|
|
||||||
|
|
||||||
;; Query all the substitutes at once to minimize the cost of
|
|
||||||
;; launching 'guix substitute' and making HTTP requests.
|
|
||||||
(substs (if (null? missing)
|
|
||||||
'()
|
|
||||||
(substitutable-path-info store missing))))
|
|
||||||
(when (< (length substs) (length missing))
|
|
||||||
(raise (condition (&store-protocol-error
|
|
||||||
(message "cannot determine \
|
|
||||||
the list of references")
|
|
||||||
(status 1)))))
|
|
||||||
|
|
||||||
;; Intersperse SUBSTS and LOCAL-REFS.
|
|
||||||
(let loop ((items items)
|
|
||||||
(local-refs local-refs)
|
|
||||||
(result '()))
|
|
||||||
(match items
|
|
||||||
(()
|
|
||||||
(let ((result (reverse result)))
|
|
||||||
(for-each (cut hash-set! %reference-cache <> <>)
|
|
||||||
requested result)
|
|
||||||
result))
|
|
||||||
((item items ...)
|
|
||||||
(match local-refs
|
|
||||||
((#f tail ...)
|
|
||||||
(loop items tail
|
|
||||||
(cons (any (lambda (subst)
|
|
||||||
(and (string=? (substitutable-path subst) item)
|
|
||||||
(substitutable-references subst)))
|
|
||||||
substs)
|
|
||||||
result)))
|
|
||||||
((head tail ...)
|
|
||||||
(loop items tail
|
|
||||||
(cons head result)))))))))
|
|
||||||
|
|
||||||
(define* (fold-path store proc seed paths
|
(define* (fold-path store proc seed paths
|
||||||
#:optional (relatives (cut references store <>)))
|
#:optional (relatives (cut references store <>)))
|
||||||
"Call PROC for each of the RELATIVES of PATHS, exactly once, and return the
|
"Call PROC for each of the RELATIVES of PATHS, exactly once, and return the
|
||||||
|
@ -308,42 +308,6 @@
|
|||||||
(null? (references %store t1))
|
(null? (references %store t1))
|
||||||
(null? (referrers %store t2)))))
|
(null? (referrers %store t2)))))
|
||||||
|
|
||||||
(test-assert "references/substitutes missing reference info"
|
|
||||||
(with-store s
|
|
||||||
(set-build-options s #:use-substitutes? #f)
|
|
||||||
(guard (c ((store-protocol-error? c) #t))
|
|
||||||
(let* ((b (add-to-store s "bash" #t "sha256"
|
|
||||||
(search-bootstrap-binary "bash"
|
|
||||||
(%current-system))))
|
|
||||||
(d (derivation s "the-thing" b '("--help")
|
|
||||||
#:inputs `((,b)))))
|
|
||||||
(references/substitutes s (list (derivation->output-path d) b))
|
|
||||||
#f))))
|
|
||||||
|
|
||||||
(test-assert "references/substitutes with substitute info"
|
|
||||||
(with-store s
|
|
||||||
(set-build-options s #:use-substitutes? #t)
|
|
||||||
(let* ((t1 (add-text-to-store s "random1" (random-text)))
|
|
||||||
(t2 (add-text-to-store s "random2" (random-text)
|
|
||||||
(list t1)))
|
|
||||||
(t3 (add-text-to-store s "build" "echo -n $t2 > $out"))
|
|
||||||
(b (add-to-store s "bash" #t "sha256"
|
|
||||||
(search-bootstrap-binary "bash"
|
|
||||||
(%current-system))))
|
|
||||||
(d (derivation s "the-thing" b `("-e" ,t3)
|
|
||||||
#:inputs `((,b) (,t3) (,t2))
|
|
||||||
#:env-vars `(("t2" . ,t2))))
|
|
||||||
(o (derivation->output-path d)))
|
|
||||||
(with-derivation-narinfo d
|
|
||||||
(sha256 => (gcrypt:sha256 (string->utf8 t2)))
|
|
||||||
(references => (list t2))
|
|
||||||
|
|
||||||
(equal? (references/substitutes s (list o t3 t2 t1))
|
|
||||||
`((,t2) ;refs of O
|
|
||||||
() ;refs of T3
|
|
||||||
(,t1) ;refs of T2
|
|
||||||
())))))) ;refs of T1
|
|
||||||
|
|
||||||
(test-equal "substitutable-path-info when substitutes are turned off"
|
(test-equal "substitutable-path-info when substitutes are turned off"
|
||||||
'()
|
'()
|
||||||
(with-store s
|
(with-store s
|
||||||
|
Loading…
Reference in New Issue
Block a user