summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-05-19 23:27:48 +0200
committerLudovic Courtès <ludo@gnu.org>2016-05-21 01:35:14 +0200
commit97507ebedc8e1265c2ed354e50a218fb9ee6087b (patch)
tree1f2d983ff43dc210a2e1af3a918c023d0557ff81
parent3cabdead6fbe080d9466bb3130a2b36dd4b07090 (diff)
downloadpatches-97507ebedc8e1265c2ed354e50a218fb9ee6087b.tar
patches-97507ebedc8e1265c2ed354e50a218fb9ee6087b.tar.gz
derivations: 'derivation' sorts items in the resulting object.
* guix/derivations.scm (derivation-input<?): New procedure. (write-derivation)[coalesce-duplicate-inputs]: Remove. Remove calls to 'sort'. (coalesce-duplicate-inputs): New procedure. (derivation-hash): Sort INPUTS and use 'coalesce-duplicate-inputs'. (derivation)[input->derivation-input] [coalesce-duplicate-inputs]: New procedures. Sort OUTPUTS, INPUTS, and ENV-VARS. * tests/derivations.scm ("read-derivation vs. derivation"): New test.
-rw-r--r--guix/derivations.scm133
-rw-r--r--tests/derivations.scm27
2 files changed, 94 insertions, 66 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm
index d4f697477b..76593f373b 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -176,6 +176,11 @@ download with a fixed hash (aka. `fetchurl')."
#t)
(_ #f)))
+(define (derivation-input<? input1 input2)
+ "Compare INPUT1 and INPUT2, two <derivation-input>."
+ (string<? (derivation-input-path input1)
+ (derivation-input-path input2)))
+
(define (derivation-input-output-paths input)
"Return the list of output paths corresponding to INPUT, a
<derivation-input>."
@@ -190,6 +195,30 @@ the store."
(every (cut valid-path? store <>)
(derivation-input-output-paths input)))
+(define (coalesce-duplicate-inputs inputs)
+ "Return a list of inputs, such that when INPUTS contains the same DRV twice,
+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
+ (($ <derivation-input> path sub-drvs)
+ ;; XXX: quadratic
+ (match (find (match-lambda
+ (($ <derivation-input> p s)
+ (string=? p path)))
+ result)
+ (#f
+ (cons input result))
+ ((and dup ($ <derivation-input> _ 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<?))
+ (delq dup result))))))))
+ '()
+ inputs))
+
(define* (derivation-prerequisites drv #:optional (cut? (const #f)))
"Return the list of derivation-inputs required to build DRV, recursively.
@@ -473,29 +502,6 @@ that form."
(define (write-string-list lst)
(write-list lst write port))
- (define (coalesce-duplicate-inputs inputs)
- ;; Return a list of inputs, such that when INPUTS contains the same DRV
- ;; twice, 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
- (($ <derivation-input> path sub-drvs)
- ;; XXX: quadratic
- (match (find (match-lambda
- (($ <derivation-input> p s)
- (string=? p path)))
- result)
- (#f
- (cons input result))
- ((and dup ($ <derivation-input> _ sub-drvs2))
- ;; Merge DUP with INPUT.
- (let ((sub-drvs (delete-duplicates
- (append sub-drvs sub-drvs2))))
- (cons (make-derivation-input path sub-drvs)
- (delq dup result))))))))
- '()
- inputs))
-
(define (write-output output port)
(match output
((name . ($ <derivation-output> path hash-algo hash recursive?))
@@ -515,7 +521,7 @@ that form."
(display "(" port)
(write path port)
(display "," port)
- (write-string-list (sort sub-drvs string<?))
+ (write-string-list sub-drvs)
(display ")" port))))
(define (write-env-var env-var port)
@@ -527,35 +533,20 @@ that form."
(write value port)
(display ")" port))))
- ;; Note: lists are sorted alphabetically, to conform with the behavior of
- ;; C++ `std::map' in Nix itself.
-
+ ;; Assume all the lists we are writing are already sorted.
(match drv
(($ <derivation> outputs inputs sources
system builder args env-vars)
(display "Derive(" port)
- (write-list (sort outputs
- (lambda (o1 o2)
- (string<? (car o1) (car o2))))
- write-output
- port)
+ (write-list outputs write-output port)
(display "," port)
- (write-list (sort (coalesce-duplicate-inputs inputs)
- (lambda (i1 i2)
- (string<? (derivation-input-path i1)
- (derivation-input-path i2))))
- write-input
- port)
+ (write-list inputs write-input port)
(display "," port)
- (write-string-list (sort sources string<?))
+ (write-string-list sources)
(format port ",~s,~s," system builder)
(write-string-list args)
(display "," port)
- (write-list (sort env-vars
- (lambda (e1 e2)
- (string<? (car e1) (car e2))))
- write-env-var
- port)
+ (write-list env-vars write-env-var port)
(display ")" port))))
(define derivation->string
@@ -653,7 +644,10 @@ derivation at FILE."
(let ((hash (derivation-path->base16-hash path)))
(make-derivation-input hash sub-drvs))))
inputs))
- (drv (make-derivation outputs inputs sources
+ (drv (make-derivation outputs
+ (sort (coalesce-duplicate-inputs inputs)
+ derivation-input<?)
+ sources
system builder args env-vars
#f)))
@@ -820,30 +814,38 @@ output should not be used."
(make-derivation outputs inputs sources system builder
args env-vars file))))
+ (define input->derivation-input
+ (match-lambda
+ (((? derivation? drv))
+ (make-derivation-input (derivation-file-name 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 '())))))
+
+ ;; Note: lists are sorted alphabetically, to conform with the behavior of
+ ;; C++ `std::map' in Nix itself.
+
(let* ((outputs (map (lambda (name)
;; Return outputs with an empty path.
(cons name
(make-derivation-output "" hash-algo
hash recursive?)))
- outputs))
- (inputs (map (match-lambda
- (((? derivation? drv))
- (make-derivation-input (derivation-file-name 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 '()))))
- (delete-duplicates inputs)))
- (env-vars (env-vars-with-empty-outputs (user+system-env-vars)))
+ (sort outputs string<?)))
+ (inputs (sort (coalesce-duplicate-inputs
+ (map input->derivation-input
+ (delete-duplicates inputs)))
+ derivation-input<?))
+ (env-vars (sort (env-vars-with-empty-outputs
+ (user+system-env-vars))
+ (lambda (e1 e2)
+ (string<? (car e1) (car e2)))))
(drv-masked (make-derivation outputs
(filter (compose derivation-path?
derivation-input-path)
@@ -858,8 +860,7 @@ output should not be used."
(let ((file (add-text-to-store store (string-append name ".drv")
(derivation->string drv)
- (map derivation-input-path
- inputs))))
+ (map derivation-input-path inputs))))
(set-file-name drv file))))
(define* (map-derivation store drv mapping
diff --git a/tests/derivations.scm b/tests/derivations.scm
index cb7196e2a9..d8553b223e 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -367,6 +367,33 @@
(and (eq? 'one (call-with-input-file one read))
(eq? 'two (call-with-input-file two read)))))))
+(test-assert "read-derivation vs. derivation"
+ ;; Make sure 'derivation' and 'read-derivation' return objects that are
+ ;; identical.
+ (let* ((sources (unfold (cut >= <> 10)
+ (lambda (n)
+ (add-text-to-store %store
+ (format #f "input~a" n)
+ (random-text)))
+ 1+
+ 0))
+ (inputs (map (lambda (file)
+ (derivation %store "derivation-input"
+ %bash '()
+ #:inputs `((,%bash) (,file))))
+ sources))
+ (builder (add-text-to-store %store "builder.sh"
+ "echo one > $one ; echo two > $two"
+ '()))
+ (drv (derivation %store "derivation"
+ %bash `(,builder)
+ #:inputs `((,%bash) (,builder)
+ ,@(map list (append sources inputs)))
+ #:outputs '("two" "one")))
+ (drv* (call-with-input-file (derivation-file-name drv)
+ read-derivation)))
+ (equal? drv* drv)))
+
(test-assert "multiple-output derivation, derivation-path->output-path"
(let* ((builder (add-text-to-store %store "builder.sh"
"echo one > $out ; echo two > $second"