From d2d0514b58bfddd061cd7f692bcc2075fdc33711 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 29 Oct 2014 00:26:05 +0100 Subject: [PATCH] derivations: Fix 'derivation-prerequisites-to-build' when #:local-build?. * guix/derivations.scm (derivation-prerequisites-to-build)[derivation-substitutable?]: Call 'substitutable-derivation?'. : When 'substitutable-derivation?' returns #f, add DRV to BUILD. --- guix/derivations.scm | 10 ++++++++-- tests/derivations.scm | 25 ++++++++++++++++++++++++- 2 files changed, 32 insertions(+), 3 deletions(-) diff --git a/guix/derivations.scm b/guix/derivations.scm index 5a8cc2c57a..b80e31936e 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -217,7 +217,8 @@ that second value is the empty list." (every built? (derivation-output-paths 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) (sub-drvs outputs) @@ -230,7 +231,12 @@ that second value is the empty list." (append (derivation-output-paths drv sub-drvs) substitute))) (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 (input-built? i) (input-substitutable? i))) diff --git a/tests/derivations.scm b/tests/derivations.scm index 9073867793..29b341e2bb 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -562,7 +562,6 @@ ;; prerequisite to build because DRV itself is already built. (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" (let* ((store (open-connection)) (drv (build-expression->derivation store "prereq-subst" @@ -583,6 +582,30 @@ (null? download*) (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 + ;; + ;; 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" (let* ((builder '(begin (mkdir %output)