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

union: Delete duplicates when passed the same input several times.

Browse source 
* guix/build/union.scm (union-build): Prepend "." to the result of
  `union-tree', to match the expectations of `delete-duplicate-leaves'.
  Don't do mkdir when SUBDIR is ".".
* tests/union.scm ("union-build"): Keep duplicates in %BOOTSTRAP-INPUTS.
This commit is contained in:
Ludovic Courtès 2013-02-06 22:51:24 +01:00
parent 44ce77ff52
commit 6211223021
2 changed files with 10 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
guix/build/union.scm
View file

@ -150,8 +150,9 @@ (define (resolve-collision leaves)
(mkdir output) (mkdir output)
(let loop ((tree (delete-duplicate-leaves (let loop ((tree (delete-duplicate-leaves
(cons "."
(tree-union (append-map (compose tree-leaves file-tree) (tree-union (append-map (compose tree-leaves file-tree)
directories)) directories)))
leaf=? leaf=?
resolve-collision)) resolve-collision))
(dir '())) (dir '()))
@ -165,8 +166,9 @@ (define (resolve-collision leaves)
(symlink tree target))) (symlink tree target)))
(((? string? subdir) leaves ...) (((? string? subdir) leaves ...)
;; A sub-directory: create it in OUTPUT, and iterate over LEAVES. ;; A sub-directory: create it in OUTPUT, and iterate over LEAVES.
(unless (string=? subdir ".")
(let ((dir (string-join dir "/"))) (let ((dir (string-join dir "/")))
(mkdir (string-append output "/" dir "/" subdir))) (mkdir (string-append output "/" dir "/" subdir))))
(for-each (cute loop <> `(,@dir ,subdir)) (for-each (cute loop <> `(,@dir ,subdir))
leaves)) leaves))
((leaves ...) ((leaves ...)

7
tests/union.scm
View file

@ -94,9 +94,10 @@ (define %store
(let* ((inputs (map (match-lambda (let* ((inputs (map (match-lambda
((name package) ((name package)
`(,name ,(package-derivation %store package)))) `(,name ,(package-derivation %store package))))
(delete-duplicates %bootstrap-inputs
(lambda (i1 i2) ;; Purposefully leave duplicate entries.
(eq? (second i1) (second i2)))))) (append %bootstrap-inputs
(take %bootstrap-inputs 3))))
(builder `(begin (builder `(begin
(use-modules (guix build union)) (use-modules (guix build union))
(union-build (assoc-ref %outputs "out") (union-build (assoc-ref %outputs "out")