TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

derivations: 'derivation-prerequisites-to-build' returns <substitutable>. 

* guix/derivations.scm (derivation-prerequisites-to-build): Rename
 #:substitutable? to #:substitutable-info.
[derivation-substitutable?]: Rename to...
[derivation-substitutable-info]: ... this.  Return a list of <substitutable>.
Second return value is now a list of <substitutable> instead of a list
of strings.
* guix/ui.scm (show-what-to-build)[substitutable?]: Rename to...
[substitutable-info]: ... this.
Adjust to new 'derivation-prerequisites-to-build' return value type.
* tests/derivations.scm ("derivation-prerequisites-to-build and
substitutes"): Adjust.
("derivation-prerequisites-to-build and substitutes, local build"):
Likewise.
This commit is contained in:
Ludovic Courtès 2017-05-31 11:06:42 +02:00
parent ef51ac21ee
commit 2dc98729af
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 36 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
guix/derivations.scm
View File

@ -334,13 +334,13 @@ substituter many times."
(mode (build-mode normal)) (mode (build-mode normal))
(outputs (outputs
(derivation-output-names drv)) (derivation-output-names drv))
(substitutable? (substitutable-info
(substitution-oracle store (substitution-oracle store
(list drv) (list drv)
#:mode mode))) #:mode mode)))
"Return two values: the list of derivation-inputs required to build the "Return two values: the list of derivation-inputs required to build the
OUTPUTS of DRV and not already available in STORE, recursively, and the list OUTPUTS of DRV and not already available in STORE, recursively, and the list
of required store paths that can be substituted. SUBSTITUTABLE? must be a of required store paths that can be substituted. SUBSTITUTABLE-INFO must be a
one-argument procedure similar to that returned by 'substitution-oracle'." one-argument procedure similar to that returned by 'substitution-oracle'."
(define built? (define built?
(cut valid-path? store <>)) (cut valid-path? store <>))
@ -351,7 +351,7 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
(define input-substitutable? (define input-substitutable?
;; Return true if and only if all of SUB-DRVS are subsitutable. If at ;; Return true if and only if all of SUB-DRVS are subsitutable. If at
;; least one is missing, then everything must be rebuilt. ;; least one is missing, then everything must be rebuilt.
(compose (cut every substitutable? <>) derivation-input-output-paths)) (compose (cut every substitutable-info <>) derivation-input-output-paths))
(define (derivation-built? drv* sub-drvs) (define (derivation-built? drv* sub-drvs)
;; In 'check' mode, assume that DRV is not built. ;; In 'check' mode, assume that DRV is not built.
@ -359,20 +359,24 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
(eq? drv* drv))) (eq? drv* drv)))
(every built? (derivation-output-paths drv* sub-drvs)))) (every built? (derivation-output-paths drv* sub-drvs))))
(define (derivation-substitutable? drv sub-drvs) (define (derivation-substitutable-info drv sub-drvs)
(and (substitutable-derivation? drv) (and (substitutable-derivation? drv)
(every substitutable? (derivation-output-paths drv sub-drvs)))) (let ((info (filter-map substitutable-info
(derivation-output-paths drv sub-drvs))))
(and (= (length info) (length sub-drvs))
info))))
(let loop ((drv drv) (let loop ((drv drv)
(sub-drvs outputs) (sub-drvs outputs)
(build '()) (build '()) ;list of <derivation-input>
(substitute '())) (substitute '())) ;list of <substitutable>
(cond ((derivation-built? drv sub-drvs) (cond ((derivation-built? drv sub-drvs)
(values build substitute)) (values build substitute))
((derivation-substitutable? drv sub-drvs) ((derivation-substitutable-info drv sub-drvs)
(values build =>
(append (derivation-output-paths drv sub-drvs) (lambda (substitutables)
substitute))) (values build
(append substitutables substitute))))
(else (else
(let ((build (if (substitutable-derivation? drv) (let ((build (if (substitutable-derivation? drv)
build build
@ -389,8 +393,9 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
(append (append-map (lambda (input) (append (append-map (lambda (input)
(if (and (not (input-built? input)) (if (and (not (input-built? input))
(input-substitutable? input)) (input-substitutable? input))
(derivation-input-output-paths (map substitutable-info
input) (derivation-input-output-paths
input))
'())) '()))
(derivation-inputs drv)) (derivation-inputs drv))
substitute) substitute)

25
guix/ui.scm
View File

@ -588,7 +588,7 @@ error."
derivations listed in DRV using MODE, a 'build-mode' value. Return #t if derivations listed in DRV using MODE, a 'build-mode' value. Return #t if
there's something to build, #f otherwise. When USE-SUBSTITUTES?, check and there's something to build, #f otherwise. When USE-SUBSTITUTES?, check and
report what is prerequisites are available for download." report what is prerequisites are available for download."
(define substitutable? (define substitutable-info
;; Call 'substitutation-oracle' upfront so we don't end up launching the ;; Call 'substitutation-oracle' upfront so we don't end up launching the
;; substituter many times. This makes a big difference, especially when ;; substituter many times. This makes a big difference, especially when
;; DRV is a long list as is the case with 'guix environment'. ;; DRV is a long list as is the case with 'guix environment'.
@ -600,7 +600,7 @@ report what is prerequisites are available for download."
(or (null? (derivation-outputs drv)) (or (null? (derivation-outputs drv))
(let ((out (derivation->output-path drv))) ;XXX: assume "out" exists (let ((out (derivation->output-path drv))) ;XXX: assume "out" exists
(or (valid-path? store out) (or (valid-path? store out)
(substitutable? out))))) (substitutable-info out)))))
(let*-values (((build download) (let*-values (((build download)
(fold2 (lambda (drv build download) (fold2 (lambda (drv build download)
@ -608,7 +608,8 @@ report what is prerequisites are available for download."
(derivation-prerequisites-to-build (derivation-prerequisites-to-build
store drv store drv
#:mode mode #:mode mode
#:substitutable? substitutable?))) #:substitutable-info
substitutable-info)))
(values (append b build) (values (append b build)
(append d download)))) (append d download))))
'() '() '() '()
@ -622,11 +623,13 @@ report what is prerequisites are available for download."
(if use-substitutes? (if use-substitutes?
(delete-duplicates (delete-duplicates
(append download (append download
(remove (cut valid-path? store <>) (filter-map (lambda (item)
(append-map (if (valid-path? store item)
substitutable-references #f
(substitutable-path-info store (substitutable-info item)))
download))))) (append-map
substitutable-references
download))))
download))) download)))
;; TODO: Show the installed size of DOWNLOAD. ;; TODO: Show the installed size of DOWNLOAD.
(if dry-run? (if dry-run?
@ -640,7 +643,8 @@ report what is prerequisites are available for download."
(N_ "~:[The following file would be downloaded:~%~{ ~a~%~}~;~]" (N_ "~:[The following file would be downloaded:~%~{ ~a~%~}~;~]"
"~:[The following files would be downloaded:~%~{ ~a~%~}~;~]" "~:[The following files would be downloaded:~%~{ ~a~%~}~;~]"
(length download)) (length download))
(null? download) download)) (null? download)
(map substitutable-path download)))
(begin (begin
(format (current-error-port) (format (current-error-port)
(N_ "~:[The following derivation will be built:~%~{ ~a~%~}~;~]" (N_ "~:[The following derivation will be built:~%~{ ~a~%~}~;~]"
@ -651,7 +655,8 @@ report what is prerequisites are available for download."
(N_ "~:[The following file will be downloaded:~%~{ ~a~%~}~;~]" (N_ "~:[The following file will be downloaded:~%~{ ~a~%~}~;~]"
"~:[The following files will be downloaded:~%~{ ~a~%~}~;~]" "~:[The following files will be downloaded:~%~{ ~a~%~}~;~]"
(length download)) (length download))
(null? download) download))) (null? download)
(map substitutable-path download))))
(pair? build))) (pair? build)))
(define show-what-to-build* (define show-what-to-build*

6
tests/derivations.scm
View File

@ -831,10 +831,10 @@
(derivation-prerequisites-to-build store drv)) (derivation-prerequisites-to-build store drv))
((build* download*) ((build* download*)
(derivation-prerequisites-to-build store drv (derivation-prerequisites-to-build store drv
#:substitutable? #:substitutable-info
(const #f)))) (const #f))))
(and (null? build) (and (null? build)
(equal? download (list output)) (equal? (map substitutable-path download) (list output))
(null? download*) (null? download*)
(null? build*)))))) (null? build*))))))
@ -879,7 +879,7 @@
;; See <http://bugs.gnu.org/18747>. ;; See <http://bugs.gnu.org/18747>.
(and (null? build) (and (null? build)
(match download (match download
(((? string? item)) (((= substitutable-path item))
(string=? item (derivation->output-path drv)))))))))) (string=? item (derivation->output-path drv))))))))))
(test-assert "derivation-prerequisites-to-build in 'check' mode" (test-assert "derivation-prerequisites-to-build in 'check' mode"