ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

derivation: Coalesce multiple occurrences of the same input.

Browse source 
* guix/derivations.scm (write-derivation)[coalesce-duplicate-inputs]:
  New procedure.
  Use it to process INPUTS.

* tests/derivations.scm ("user of multiple-output derivation"): New
  test.
This commit is contained in:
Ludovic Courtès 2012-07-02 01:23:39 +02:00
parent 5f904ffbb1
commit d66ac374e9
2 changed files with 58 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
guix/derivations.scm
View file

@ -206,6 +206,29 @@ (define (list->string lst)
(define (write-list lst)
(display (list->string lst) 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))
;; Note: lists are sorted alphabetically, to conform with the behavior of
;; C++ `std::map' in Nix itself.
@ -229,7 +252,7 @@ (define (write-list lst)
(format #f "(~s,~a)" path
(list->string (map object->string
(sort sub-drvs string<?))))))
(sort inputs
(sort (coalesce-duplicate-inputs inputs)
(lambda (i1 i2)
(string<? (derivation-input-path i1)
(derivation-input-path i2))))))
@ -400,6 +423,8 @@ (define (env-vars-with-empty-outputs)
system builder args env-vars))
(drv (add-output-paths drv-masked)))
;; (write-derivation drv-masked (current-error-port))
;; (newline (current-error-port))
(values (add-text-to-store store (string-append name ".drv")
(call-with-output-string
(cut write-derivation drv <>))

32
tests/derivations.scm
View file

@ -163,6 +163,38 @@ (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 "user of multiple-output derivation"
;; Check whether specifying several inputs coming from the same
;; multiple-output derivation works.
(let* ((builder1 (add-text-to-store %store "my-mo-builder.sh"
"echo one > $out ; echo two > $two"
'()))
(mdrv (derivation %store "multiple-output" (%current-system)
"/bin/sh" `(,builder1)
'()
`((,builder1))
#:outputs '("out" "two")))
(builder2 (add-text-to-store %store "my-mo-user-builder.sh"
"read x < $one;
read y < $two;
echo \"($x $y)\" > $out"
'()))
(udrv (derivation %store "multiple-output-user"
(%current-system)
"/bin/sh" `(,builder2)
`(("one" . ,(derivation-path->output-path
mdrv "out"))
("two" . ,(derivation-path->output-path
mdrv "two")))
`((,builder2)
;; two occurrences of MDRV:
(,mdrv)
(,mdrv "two")))))
(and (build-derivations %store (list (pk 'udrv udrv)))
(let ((p (derivation-path->output-path udrv)))
(and (valid-path? %store p)
(equal? '(one two) (call-with-input-file p read)))))))
(define %coreutils
(false-if-exception (nixpkgs-derivation "coreutils")))