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.
This commit is contained in:
parent
3cabdead6f
commit
97507ebedc
|
@ -176,6 +176,11 @@ download with a fixed hash (aka. `fetchurl')."
|
||||||
#t)
|
#t)
|
||||||
(_ #f)))
|
(_ #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)
|
(define (derivation-input-output-paths input)
|
||||||
"Return the list of output paths corresponding to INPUT, a
|
"Return the list of output paths corresponding to INPUT, a
|
||||||
<derivation-input>."
|
<derivation-input>."
|
||||||
|
@ -190,6 +195,30 @@ the store."
|
||||||
(every (cut valid-path? store <>)
|
(every (cut valid-path? store <>)
|
||||||
(derivation-input-output-paths input)))
|
(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)))
|
(define* (derivation-prerequisites drv #:optional (cut? (const #f)))
|
||||||
"Return the list of derivation-inputs required to build DRV, recursively.
|
"Return the list of derivation-inputs required to build DRV, recursively.
|
||||||
|
|
||||||
|
@ -473,29 +502,6 @@ that form."
|
||||||
(define (write-string-list lst)
|
(define (write-string-list lst)
|
||||||
(write-list lst write port))
|
(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)
|
(define (write-output output port)
|
||||||
(match output
|
(match output
|
||||||
((name . ($ <derivation-output> path hash-algo hash recursive?))
|
((name . ($ <derivation-output> path hash-algo hash recursive?))
|
||||||
|
@ -515,7 +521,7 @@ that form."
|
||||||
(display "(" port)
|
(display "(" port)
|
||||||
(write path port)
|
(write path port)
|
||||||
(display "," port)
|
(display "," port)
|
||||||
(write-string-list (sort sub-drvs string<?))
|
(write-string-list sub-drvs)
|
||||||
(display ")" port))))
|
(display ")" port))))
|
||||||
|
|
||||||
(define (write-env-var env-var port)
|
(define (write-env-var env-var port)
|
||||||
|
@ -527,35 +533,20 @@ that form."
|
||||||
(write value port)
|
(write value port)
|
||||||
(display ")" port))))
|
(display ")" port))))
|
||||||
|
|
||||||
;; Note: lists are sorted alphabetically, to conform with the behavior of
|
;; Assume all the lists we are writing are already sorted.
|
||||||
;; C++ `std::map' in Nix itself.
|
|
||||||
|
|
||||||
(match drv
|
(match drv
|
||||||
(($ <derivation> outputs inputs sources
|
(($ <derivation> outputs inputs sources
|
||||||
system builder args env-vars)
|
system builder args env-vars)
|
||||||
(display "Derive(" port)
|
(display "Derive(" port)
|
||||||
(write-list (sort outputs
|
(write-list outputs write-output port)
|
||||||
(lambda (o1 o2)
|
|
||||||
(string<? (car o1) (car o2))))
|
|
||||||
write-output
|
|
||||||
port)
|
|
||||||
(display "," port)
|
(display "," port)
|
||||||
(write-list (sort (coalesce-duplicate-inputs inputs)
|
(write-list inputs write-input port)
|
||||||
(lambda (i1 i2)
|
|
||||||
(string<? (derivation-input-path i1)
|
|
||||||
(derivation-input-path i2))))
|
|
||||||
write-input
|
|
||||||
port)
|
|
||||||
(display "," port)
|
(display "," port)
|
||||||
(write-string-list (sort sources string<?))
|
(write-string-list sources)
|
||||||
(format port ",~s,~s," system builder)
|
(format port ",~s,~s," system builder)
|
||||||
(write-string-list args)
|
(write-string-list args)
|
||||||
(display "," port)
|
(display "," port)
|
||||||
(write-list (sort env-vars
|
(write-list env-vars write-env-var port)
|
||||||
(lambda (e1 e2)
|
|
||||||
(string<? (car e1) (car e2))))
|
|
||||||
write-env-var
|
|
||||||
port)
|
|
||||||
(display ")" port))))
|
(display ")" port))))
|
||||||
|
|
||||||
(define derivation->string
|
(define derivation->string
|
||||||
|
@ -653,7 +644,10 @@ derivation at FILE."
|
||||||
(let ((hash (derivation-path->base16-hash path)))
|
(let ((hash (derivation-path->base16-hash path)))
|
||||||
(make-derivation-input hash sub-drvs))))
|
(make-derivation-input hash sub-drvs))))
|
||||||
inputs))
|
inputs))
|
||||||
(drv (make-derivation outputs inputs sources
|
(drv (make-derivation outputs
|
||||||
|
(sort (coalesce-duplicate-inputs inputs)
|
||||||
|
derivation-input<?)
|
||||||
|
sources
|
||||||
system builder args env-vars
|
system builder args env-vars
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
|
@ -820,30 +814,38 @@ output should not be used."
|
||||||
(make-derivation outputs inputs sources system builder
|
(make-derivation outputs inputs sources system builder
|
||||||
args env-vars file))))
|
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)
|
(let* ((outputs (map (lambda (name)
|
||||||
;; Return outputs with an empty path.
|
;; Return outputs with an empty path.
|
||||||
(cons name
|
(cons name
|
||||||
(make-derivation-output "" hash-algo
|
(make-derivation-output "" hash-algo
|
||||||
hash recursive?)))
|
hash recursive?)))
|
||||||
outputs))
|
(sort outputs string<?)))
|
||||||
(inputs (map (match-lambda
|
(inputs (sort (coalesce-duplicate-inputs
|
||||||
(((? derivation? drv))
|
(map input->derivation-input
|
||||||
(make-derivation-input (derivation-file-name drv)
|
(delete-duplicates inputs)))
|
||||||
'("out")))
|
derivation-input<?))
|
||||||
(((? derivation? drv) sub-drvs ...)
|
(env-vars (sort (env-vars-with-empty-outputs
|
||||||
(make-derivation-input (derivation-file-name drv)
|
(user+system-env-vars))
|
||||||
sub-drvs))
|
(lambda (e1 e2)
|
||||||
(((? direct-store-path? input))
|
(string<? (car e1) (car e2)))))
|
||||||
(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)))
|
|
||||||
(drv-masked (make-derivation outputs
|
(drv-masked (make-derivation outputs
|
||||||
(filter (compose derivation-path?
|
(filter (compose derivation-path?
|
||||||
derivation-input-path)
|
derivation-input-path)
|
||||||
|
@ -858,8 +860,7 @@ output should not be used."
|
||||||
|
|
||||||
(let ((file (add-text-to-store store (string-append name ".drv")
|
(let ((file (add-text-to-store store (string-append name ".drv")
|
||||||
(derivation->string drv)
|
(derivation->string drv)
|
||||||
(map derivation-input-path
|
(map derivation-input-path inputs))))
|
||||||
inputs))))
|
|
||||||
(set-file-name drv file))))
|
(set-file-name drv file))))
|
||||||
|
|
||||||
(define* (map-derivation store drv mapping
|
(define* (map-derivation store drv mapping
|
||||||
|
|
|
@ -367,6 +367,33 @@
|
||||||
(and (eq? 'one (call-with-input-file one read))
|
(and (eq? 'one (call-with-input-file one read))
|
||||||
(eq? 'two (call-with-input-file two 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"
|
(test-assert "multiple-output derivation, derivation-path->output-path"
|
||||||
(let* ((builder (add-text-to-store %store "builder.sh"
|
(let* ((builder (add-text-to-store %store "builder.sh"
|
||||||
"echo one > $out ; echo two > $second"
|
"echo one > $out ; echo two > $second"
|
||||||
|
|
Loading…
Reference in New Issue