mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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:
Ludovic Courtès
parent
3cabdead6f
commit
97507ebedc
2 changed files with 94 additions and 66 deletions
|
|
@ -176,6 +176,11 @@ (define (fixed-output-derivation? drv)
|
|||
#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 @@ (define (valid-derivation-input? store input)
|
|||
(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 @@ (define format simple-format)
|
|||
(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 @@ (define (write-input input port)
|
|||
(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 @@ (define (write-env-var env-var port)
|
|||
(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 @@ (define derivation-hash ; `hashDerivationModulo' in derivations.cc
|
|||
(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 @@ (define (set-file-name drv file)
|
|||
(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 @@ (define (set-file-name drv file)
|
|||
|
||||
(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
|
||||
|
|
|
|||
|
|
@ -367,6 +367,33 @@ (define prefix-len (string-length dir))
|
|||
(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"
|
||||
|
|
|
|||
Loading…
Reference in a new issue