diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2016-10-14 18:56:48 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2016-10-14 23:31:50 +0200 |
| commit | b013c33f6f060c14ca7d1f3cfcb5d8ce3ef1c53c (patch) | |
| tree | f83963c52c49c32d4d8de8ac49c1b45e751548c5 /tests | |
| parent | d0025d01445ff271ececea20cfa6a2346593d1d6 (diff) | |
| download | patches-b013c33f6f060c14ca7d1f3cfcb5d8ce3ef1c53c.tar patches-b013c33f6f060c14ca7d1f3cfcb5d8ce3ef1c53c.tar.gz | |
grafts: 'graft-derivation' does now introduce grafts that shadow other grafts.
Partly fixes <http://bugs.gnu.org/24418>.
* guix/grafts.scm (cumulative-grafts)[graft-origin?]: New procedure.
[dependency-grafts]: Use it in new 'if' around recursive call.
* tests/grafts.scm ("graft-derivation, grafts are not shadowed"): New test.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/grafts.scm | 62 |
1 files changed, 62 insertions, 0 deletions
diff --git a/tests/grafts.scm b/tests/grafts.scm index f2ff839fd8..4eff06b4b3 100644 --- a/tests/grafts.scm +++ b/tests/grafts.scm @@ -218,4 +218,66 @@ (let ((out (derivation->output-path grafted))) (file-is-directory? (string-append out "/" repl)))))) +(test-assert "graft-derivation, grafts are not shadowed" + ;; We build a DAG as below, where dotted arrows represent replacements and + ;; solid arrows represent dependencies: + ;; + ;; P1 ·············> P1R + ;; |\__________________. + ;; v v + ;; P2 ·············> P2R + ;; | + ;; v + ;; P3 + ;; + ;; We want to make sure that the two grafts we want to apply to P3 are + ;; honored and not shadowed by other computed grafts. + (let* ((p1 (build-expression->derivation + %store "p1" + '(mkdir (assoc-ref %outputs "out")))) + (p1r (build-expression->derivation + %store "P1" + '(let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/replacement") + (const #t))))) + (p2 (build-expression->derivation + %store "p2" + `(let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (chdir out) + (symlink (assoc-ref %build-inputs "p1") "p1")) + #:inputs `(("p1" ,p1)))) + (p2r (build-expression->derivation + %store "P2" + `(let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (chdir out) + (symlink (assoc-ref %build-inputs "p1") "p1") + (call-with-output-file (string-append out "/replacement") + (const #t))) + #:inputs `(("p1" ,p1)))) + (p3 (build-expression->derivation + %store "p3" + `(let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (chdir out) + (symlink (assoc-ref %build-inputs "p2") "p2")) + #:inputs `(("p2" ,p2)))) + (p1g (graft + (origin p1) + (replacement p1r))) + (p2g (graft + (origin p2) + (replacement (graft-derivation %store p2r (list p1g))))) + (p3d (graft-derivation %store p3 (list p1g p2g)))) + (and (build-derivations %store (list p3d)) + (let ((out (derivation->output-path (pk p3d)))) + ;; Make sure OUT refers to the replacement of P2, which in turn + ;; refers to the replacement of P1, as specified by P1G and P2G. + ;; It used to be the case that P2G would be shadowed by a simple + ;; P2->P2R graft, which is not what we want. + (and (file-exists? (string-append out "/p2/replacement")) + (file-exists? (string-append out "/p2/p1/replacement"))))))) + (test-end) |