nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

derivations: Fix 'derivation-prerequisites-to-build' when #:local-build?. 

* guix/derivations.scm (derivation-prerequisites-to-build)[derivation-substitutable?]:
  Call 'substitutable-derivation?'.
  <body>: When 'substitutable-derivation?' returns #f, add DRV to BUILD.
This commit is contained in:
Ludovic Courtès 2014-10-29 00:26:05 +01:00
parent e6740741d1
commit d2d0514b58
2 changed files with 32 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
guix/derivations.scm
View File

@ -217,7 +217,8 @@ that second value is the empty list."
(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? drv sub-drvs)
(every substitutable? (derivation-output-paths drv sub-drvs))) (and (substitutable-derivation? drv)
(every substitutable? (derivation-output-paths drv sub-drvs))))
(let loop ((drv drv) (let loop ((drv drv)
(sub-drvs outputs) (sub-drvs outputs)
@ -230,7 +231,12 @@ that second value is the empty list."
(append (derivation-output-paths drv sub-drvs) (append (derivation-output-paths drv sub-drvs)
substitute))) substitute)))
(else (else
(let ((inputs (remove (lambda (i) (let ((build (if (substitutable-derivation? drv)
build
(cons (make-derivation-input
(derivation-file-name drv) sub-drvs)
build)))
(inputs (remove (lambda (i)
(or (member i build) ; XXX: quadratic (or (member i build) ; XXX: quadratic
(input-built? i) (input-built? i)
(input-substitutable? i))) (input-substitutable? i)))

25
tests/derivations.scm
View File

@ -562,7 +562,6 @@
;; prerequisite to build because DRV itself is already built. ;; prerequisite to build because DRV itself is already built.
(null? (derivation-prerequisites-to-build %store drv))))) (null? (derivation-prerequisites-to-build %store drv)))))
(test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1))
(test-assert "derivation-prerequisites-to-build and substitutes" (test-assert "derivation-prerequisites-to-build and substitutes"
(let* ((store (open-connection)) (let* ((store (open-connection))
(drv (build-expression->derivation store "prereq-subst" (drv (build-expression->derivation store "prereq-subst"
@ -583,6 +582,30 @@
(null? download*) (null? download*)
(null? build*)))))) (null? build*))))))
(test-assert "derivation-prerequisites-to-build and substitutes, local build"
(let* ((store (open-connection))
(drv (build-expression->derivation store "prereq-subst-local"
(random 1000)
;; XXX: Adjust once
;; <http://bugs.gnu.org/18747>
;; is fixed.
#:local-build? #t))
(output (derivation->output-path drv)))
;; Make sure substitutes are usable.
(set-build-options store #:use-substitutes? #t)
(with-derivation-narinfo drv
(let-values (((build download)
(derivation-prerequisites-to-build store drv)))
;; Despite being available as a substitute, DRV will be built locally
;; due to #:local-build?.
(and (null? download)
(match build
(((? derivation-input? input))
(string=? (derivation-input-path input)
(derivation-file-name drv)))))))))
(test-assert "build-expression->derivation with expression returning #f" (test-assert "build-expression->derivation with expression returning #f"
(let* ((builder '(begin (let* ((builder '(begin
(mkdir %output) (mkdir %output)