From ba04f80e2e0fd92ca381c8fac8a659cb8f9abdd2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 19 Jun 2019 22:05:06 +0200 Subject: derivations: Rewrite and replace 'derivations-prerequisites-to-build'. The new 'derivation-build-plan' procedure has a more appropriate signature: it takes a list of instead of taking one . Its body is also much simpler. * guix/derivations.scm (derivation-build-plan): New procedure. (derivation-prerequisites-to-build): Express in terms of 'derivation-build-plan' and mark as deprecated. * tests/derivations.scm: Change 'derivation-prerequisites-to-build' tests to 'derivation-build-plan' and adjust accordingly. --- tests/derivations.scm | 63 ++++++++++++++++++++++++++++----------------------- 1 file changed, 35 insertions(+), 28 deletions(-) (limited to 'tests/derivations.scm') diff --git a/tests/derivations.scm b/tests/derivations.scm index 93f4cdd8ee..35fb20bab0 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -809,13 +809,13 @@ (equal? (pk 'x content) (pk 'y (call-with-input-file out get-string-all))) ))))) -(test-assert "build-expression->derivation and derivation-prerequisites-to-build" +(test-assert "build-expression->derivation and derivation-build-plan" (let ((drv (build-expression->derivation %store "fail" #f))) ;; The only direct dependency is (%guile-for-build) and it's already ;; built. - (null? (derivation-prerequisites-to-build %store drv)))) + (null? (derivation-build-plan %store (derivation-inputs drv))))) -(test-assert "derivation-prerequisites-to-build when outputs already present" +(test-assert "derivation-build-plan when outputs already present" (let* ((builder `(begin ,(random-text) (mkdir %output) #t)) (input-drv (build-expression->derivation %store "input" builder)) (input-path (derivation->output-path input-drv)) @@ -828,9 +828,12 @@ (valid-path? %store output)) (error "things already built" input-drv)) - (and (equal? (map derivation-input-path - (derivation-prerequisites-to-build %store drv)) - (list (derivation-file-name input-drv))) + (and (lset= equal? + (map derivation-file-name + (derivation-build-plan %store + (list (derivation-input drv)))) + (list (derivation-file-name input-drv) + (derivation-file-name drv))) ;; Build DRV and delete its input. (build-derivations %store (list drv)) @@ -839,9 +842,10 @@ ;; Now INPUT-PATH is missing, yet it shouldn't be listed as a ;; prerequisite to build because DRV itself is already built. - (null? (derivation-prerequisites-to-build %store drv))))) + (null? (derivation-build-plan %store + (list (derivation-input drv))))))) -(test-assert "derivation-prerequisites-to-build and substitutes" +(test-assert "derivation-build-plan and substitutes" (let* ((store (open-connection)) (drv (build-expression->derivation store "prereq-subst" (random 1000))) @@ -853,17 +857,19 @@ (with-derivation-narinfo drv (let-values (((build download) - (derivation-prerequisites-to-build store drv)) + (derivation-build-plan store + (list (derivation-input drv)))) ((build* download*) - (derivation-prerequisites-to-build store drv - #:substitutable-info - (const #f)))) + (derivation-build-plan store + (list (derivation-input drv)) + #:substitutable-info + (const #f)))) (and (null? build) (equal? (map substitutable-path download) (list output)) (null? download*) - (null? build*)))))) + (equal? (list drv) build*)))))) -(test-assert "derivation-prerequisites-to-build and substitutes, non-substitutable build" +(test-assert "derivation-build-plan and substitutes, non-substitutable build" (let* ((store (open-connection)) (drv (build-expression->derivation store "prereq-no-subst" (random 1000) @@ -876,16 +882,16 @@ (with-derivation-narinfo drv (let-values (((build download) - (derivation-prerequisites-to-build store drv))) + (derivation-build-plan store + (list (derivation-input drv))))) ;; Despite being available as a substitute, DRV will be built locally ;; due to #:substitutable? #f. (and (null? download) (match build - (((? derivation-input? input)) - (string=? (derivation-input-path input) - (derivation-file-name drv))))))))) + (((= derivation-file-name build)) + (string=? build (derivation-file-name drv))))))))) -(test-assert "derivation-prerequisites-to-build and substitutes, local build" +(test-assert "derivation-build-plan and substitutes, local build" (with-store store (let* ((drv (build-expression->derivation store "prereq-subst-local" (random 1000) @@ -898,7 +904,8 @@ (with-derivation-narinfo drv (let-values (((build download) - (derivation-prerequisites-to-build store drv))) + (derivation-build-plan store + (list (derivation-input drv))))) ;; #:local-build? is *not* synonymous with #:substitutable?, so we ;; must be able to substitute DRV's output. ;; See . @@ -907,7 +914,7 @@ (((= substitutable-path item)) (string=? item (derivation->output-path drv)))))))))) -(test-assert "derivation-prerequisites-to-build in 'check' mode" +(test-assert "derivation-build-plan in 'check' mode" (with-store store (let* ((dep (build-expression->derivation store "dep" `(begin ,(random-text) @@ -919,13 +926,13 @@ (delete-paths store (list (derivation->output-path dep))) ;; In 'check' mode, DEP must be rebuilt. - (and (null? (derivation-prerequisites-to-build store drv)) - (match (derivation-prerequisites-to-build store drv - #:mode (build-mode - check)) - ((input) - (string=? (derivation-input-path input) - (derivation-file-name dep)))))))) + (and (null? (derivation-build-plan store + (list (derivation-input drv)))) + (lset= equal? + (derivation-build-plan store + (list (derivation-input drv)) + #:mode (build-mode check)) + (list drv dep)))))) (test-assert "substitution-oracle and #:substitute? #f" (with-store store -- cgit 1.4.1 From 5cf4b26d52bcea382d98fb4becce89be9ee37b55 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 23 Jun 2019 11:28:29 +0200 Subject: derivations: now aggregates a . Consequently, the whole graph of object is readily available without having to go through 'read-derivation-from-file', which could have cache misses if the requested object had been GC'd in the meantime. This is an important property for the performance of things like 'derivation-build-plan' that traverse the derivation graph. * guix/derivations.scm (): Replace 'path' field by 'derivation'. (derivation-input-path): Adjust accordingly. (derivation-input-key): New procedure. (derivation-input-output-paths): Adjust accordingly. (coalesce-duplicate-inputs): Likewise. (derivation-prerequisites): Use 'derivation-input-key' to compute keys for INPUT-SET. (derivation-build-plan): Likewise. (read-derivation): Add optional 'read-derivation-from-file' parameter. [make-input-drvs]: Call it. (write-derivation)[write-input]: Adjust to new . (derivation/masked-inputs): Likewise, and remove redundant 'coalesce-duplicate-inputs' call. (derivation)[input->derivation-input]: Change to consider only the derivation case. Update call to 'make-derivation-input'. [input->source]: New procedure. Separate sources from inputs. (map-derivation): Adjust to new . * tests/derivations.scm ("parse & export"): Pass a second argument to 'read-derivation'. ("build-expression->derivation and derivation-prerequisites") ("derivation-prerequisites and valid-derivation-input?"): Adjust to new . --- guix/derivations.scm | 156 ++++++++++++++++++++++++++++---------------------- tests/derivations.scm | 10 ++-- 2 files changed, 95 insertions(+), 71 deletions(-) (limited to 'tests/derivations.scm') diff --git a/guix/derivations.scm b/guix/derivations.scm index f6e94694fd..5c568f223b 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -152,22 +152,28 @@ (recursive? derivation-output-recursive?)) ; Boolean (define-immutable-record-type - (make-derivation-input path sub-derivations) + (make-derivation-input drv sub-derivations) derivation-input? - (path derivation-input-path) ; store path + (drv derivation-input-derivation) ; (sub-derivations derivation-input-sub-derivations)) ; list of strings -(define (derivation-input-derivation input) - "Return the object INPUT refers to." - (read-derivation-from-file (derivation-input-path input))) + +(define (derivation-input-path input) + "Return the file name of the derivation INPUT refers to." + (derivation-file-name (derivation-input-derivation input))) (define* (derivation-input drv #:optional (outputs (derivation-output-names drv))) "Return a for the OUTPUTS of DRV." ;; This is a public interface meant to be more convenient than ;; 'make-derivation-input' and giving us more control. - (make-derivation-input (derivation-file-name drv) - outputs)) + (make-derivation-input drv outputs)) + +(define (derivation-input-key input) + "Return an object for which 'equal?' and 'hash' are constant-time, and which +can thus be used as a key for INPUT in lookup tables." + (cons (derivation-input-path input) + (derivation-input-sub-derivations input))) (set-record-type-printer! (lambda (drv port) @@ -209,8 +215,8 @@ download with a fixed hash (aka. `fetchurl')." "Return the list of output paths corresponding to INPUT, a ." (match input - (($ path sub-drvs) - (map (cut derivation-path->output-path path <>) + (($ drv sub-drvs) + (map (cut derivation->output-path drv <>) sub-drvs)))) (define (valid-derivation-input? store input) @@ -225,20 +231,20 @@ they are coalesced, with their sub-derivations merged. This is needed because Nix itself keeps only one of them." (fold (lambda (input result) (match input - (($ path sub-drvs) + (($ (= derivation-file-name path) sub-drvs) ;; XXX: quadratic (match (find (match-lambda - (($ p s) + (($ (= derivation-file-name p) + s) (string=? p path))) result) (#f (cons input result)) - ((and dup ($ _ sub-drvs2)) + ((and dup ($ drv sub-drvs2)) ;; Merge DUP with INPUT. (let ((sub-drvs (delete-duplicates (append sub-drvs sub-drvs2)))) - (cons (make-derivation-input path - (sort sub-drvs string - (lambda (substitutables) - (loop rest build - (append substitutables substitute) - (set-insert input visited)))) - (else - (let ((deps (derivation-inputs - (derivation-input-derivation input)))) - (loop (append deps rest) - (cons (derivation-input-derivation input) build) - substitute - (set-insert input visited))))))))) + (let ((key (derivation-input-key input))) + (cond ((set-contains? visited key) + (loop rest build substitute visited)) + ((input-built? input) + (loop rest build substitute + (set-insert key visited))) + ((input-substitutable-info input) + => + (lambda (substitutables) + (loop rest build + (append substitutables substitute) + (set-insert key visited)))) + (else + (let ((deps (derivation-inputs + (derivation-input-derivation input)))) + (loop (append deps rest) + (cons (derivation-input-derivation input) build) + substitute + (set-insert key visited)))))))))) (define-deprecated (derivation-prerequisites-to-build store drv #:rest rest) derivation-build-plan @@ -410,10 +419,15 @@ by 'substitution-oracle'." (list (derivation-input drv)) rest))) (values (map derivation-input build) download))) -(define (read-derivation drv-port) +(define* (read-derivation drv-port + #:optional (read-derivation-from-file + read-derivation-from-file)) "Read the derivation from DRV-PORT and return the corresponding -object. Most of the time you'll want to use 'read-derivation-from-file', -which caches things as appropriate and is thus more efficient." +object. Call READ-DERIVATION-FROM-FILE to read derivations declared as inputs +of the derivation being parsed. + +Most of the time you'll want to use 'read-derivation-from-file', which caches +things as appropriate and is thus more efficient." (define comma (string->symbol ",")) @@ -449,8 +463,9 @@ which caches things as appropriate and is thus more efficient." (fold-right (lambda (input result) (match input ((path (sub-drvs ...)) - (cons (make-derivation-input path sub-drvs) - result)))) + (let ((drv (read-derivation-from-file path))) + (cons (make-derivation-input drv sub-drvs) + result))))) '() x)) @@ -552,9 +567,15 @@ that form." (define (write-input input port) (match input - (($ path sub-drvs) + (($ obj sub-drvs) (display "(\"" port) - (display path port) + + ;; 'derivation/masked-inputs' produces objects that contain a string + ;; instead of a , so we need to account for that. + (display (if (derivation? obj) + (derivation-file-name obj) + obj) + port) (display "\"," port) (write-string-list sub-drvs) (display ")" port)))) @@ -645,13 +666,16 @@ name of each input with that input's hash." (($ outputs inputs sources system builder args env-vars) (let ((inputs (map (match-lambda - (($ path sub-drvs) + (($ (= derivation-file-name path) + sub-drvs) (let ((hash (derivation-path->base16-hash path))) (make-derivation-input hash sub-drvs)))) inputs))) (make-derivation outputs - (sort (coalesce-duplicate-inputs inputs) - derivation-inputderivation-input (match-lambda (((? derivation? drv)) - (make-derivation-input (derivation-file-name drv) '("out"))) + (make-derivation-input drv '("out"))) (((? derivation? drv) sub-drvs ...) - (make-derivation-input (derivation-file-name drv) sub-drvs)) - (((? direct-store-path? input)) - (make-derivation-input input '("out"))) - (((? direct-store-path? input) sub-drvs ...) - (make-derivation-input input sub-drvs)) - ((input . _) - (let ((path (add-to-store store (basename input) - #t "sha256" input))) - (make-derivation-input path '()))))) + (make-derivation-input drv sub-drvs)) + (_ #f))) + + (define input->source + (match-lambda + (((? string? input) . _) + (if (direct-store-path? input) + input + (add-to-store store (basename input) + #t "sha256" input))) + (_ #f))) ;; Note: lists are sorted alphabetically, to conform with the behavior of ;; C++ `std::map' in Nix itself. @@ -828,29 +854,24 @@ derivation. It is kept as-is, uninterpreted, in the derivation." (make-derivation-output "" hash-algo hash recursive?))) (sort outputs stringsource inputs)) + stringderivation-input - (delete-duplicates inputs))) + (filter-map input->derivation-input inputs)) derivation-inputbytevector drv) - (map derivation-input-path inputs))) + (append (map derivation-input-path inputs) + sources))) (drv* (set-field drv (derivation-file-name) file))) (hash-set! %derivation-cache file drv*) drv*))) @@ -920,7 +941,8 @@ recursively." ;; in the format used in 'derivation' calls. (mlambda (input loop) (match input - (($ path (sub-drvs ...)) + (($ (= derivation-file-name path) + (sub-drvs ...)) (match (vhash-assoc path mapping) ((_ . (? derivation? replacement)) (cons replacement sub-drvs)) diff --git a/tests/derivations.scm b/tests/derivations.scm index 35fb20bab0..54fa588969 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -87,9 +87,11 @@ (test-assert "parse & export" (let* ((f (search-path %load-path "tests/test.drv")) (b1 (call-with-input-file f get-bytevector-all)) - (d1 (read-derivation (open-bytevector-input-port b1))) + (d1 (read-derivation (open-bytevector-input-port b1) + identity)) (b2 (call-with-bytevector-output-port (cut write-derivation d1 <>))) - (d2 (read-derivation (open-bytevector-input-port b2)))) + (d2 (read-derivation (open-bytevector-input-port b2) + identity))) (and (equal? b1 b2) (equal? d1 d2)))) @@ -724,7 +726,7 @@ (test-assert "build-expression->derivation and derivation-prerequisites" (let ((drv (build-expression->derivation %store "fail" #f))) (any (match-lambda - (($ path) + (($ (= derivation-file-name path)) (string=? path (derivation-file-name (%guile-for-build))))) (derivation-prerequisites drv)))) @@ -741,7 +743,7 @@ (match (derivation-prerequisites c (cut valid-derivation-input? %store <>)) - ((($ file ("out"))) + ((($ (= derivation-file-name file) ("out"))) (string=? file (derivation-file-name b))) (x (pk 'fail x #f))))) -- cgit 1.4.1 From 7c690a47381f645ec5ec0a1fd6ffc34dba1b69c2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 23 Jun 2019 12:39:39 +0200 Subject: derivations: 'build-derivations' can be passed derivation inputs. * guix/derivations.scm (build-derivations): Accept records among DERIVATIONS. * tests/derivations.scm ("build-derivations with specific output"): Test it. --- guix/derivations.scm | 5 +++++ tests/derivations.scm | 7 +++++-- 2 files changed, 10 insertions(+), 2 deletions(-) (limited to 'tests/derivations.scm') diff --git a/guix/derivations.scm b/guix/derivations.scm index 403e86749b..433b4551a5 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -1016,6 +1016,11 @@ derivation/output pairs, using the specified MODE." (build-things store (map (match-lambda ((? derivation? drv) (derivation-file-name drv)) + ((? derivation-input? input) + (cons (derivation-input-path input) + (string-join + (derivation-input-sub-derivations input) + ","))) ((? string? file) file) (((? derivation? drv) . output) (cons (derivation-file-name drv) diff --git a/tests/derivations.scm b/tests/derivations.scm index 54fa588969..d173a78906 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -807,9 +807,12 @@ ;; Ask for nothing but the "out" output of DRV. (build-derivations store `((,drv . "out"))) + ;; Synonymous: + (build-derivations store (list (derivation-input drv '("out")))) + (valid-path? store out) - (equal? (pk 'x content) (pk 'y (call-with-input-file out get-string-all))) - ))))) + (equal? (pk 'x content) + (pk 'y (call-with-input-file out get-string-all)))))))) (test-assert "build-expression->derivation and derivation-build-plan" (let ((drv (build-expression->derivation %store "fail" #f))) -- cgit 1.4.1