diff --git a/guix/derivations.scm b/guix/derivations.scm index 11d47e9702..7f32718048 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -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 + (($ path sub-drvs) + ;; XXX: quadratic + (match (find (match-lambda + (($ p s) + (string=? p path))) + result) + (#f + (cons input result)) + ((and dup ($ _ 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)) diff --git a/tests/derivations.scm b/tests/derivations.scm index cdb1942539..097b9d7d28 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -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")))