futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

store: Remove 'references/substitutes'.

Browse Source 
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:
Ludovic Courtès 2021-05-31 22:28:43 +02:00
parent 4a93fb0595
commit 2725f04634
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 1 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
guix/store.scm
View File

@ -148,7 +148,6 @@
built-in-builders
references
references/cached
references/substitutes
references*
query-path-info*
requisites
@ -1481,7 +1480,7 @@ error if there is no such root."
;; Brute-force cache mapping store items to their list of references.
;; Caching matters because when building a profile in the presence of
;; 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).
(make-hash-table 100))
@ -1492,58 +1491,6 @@ error if there is no such root."
(hash-set! %reference-cache item 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
#:optional (relatives (cut references store <>)))
"Call PROC for each of the RELATIVES of PATHS, exactly once, and return the

36
tests/store.scm
View File

@ -308,42 +308,6 @@
(null? (references %store t1))
(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"
'()
(with-store s