summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2014-04-03 17:49:20 -0400
committerMark H Weaver <mhw@netris.org>2014-04-03 18:35:16 -0400
commit6a0b30f36c3bf2992eaddd23d4e05b7f7b987506 (patch)
tree9457dcbc57f4fdafb07693713c5af5d8b0f1a049 /guix
parentded1012f3c9f5d5e60481274c5b3280acc277b34 (diff)
union: Ensure that the output is always a directory.
Fixes the creation of single-package profiles, reported by Ludovic Courtès. * guix/build/union.scm (union-build): Add new internal procedure 'union-of-directories' that always creates a directory, containing the code previously used only to merge multiple directories. Call it from the multiple-directory case in 'union' and from the top-level 'union-build'.
Diffstat (limited to 'guix')
-rw-r--r--guix/build/union.scm53
1 files changed, 28 insertions, 25 deletions
diff --git a/guix/build/union.scm b/guix/build/union.scm
index c65bea4692..ccd2d5c103 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -108,30 +108,8 @@ the INPUTS."
(call-with-values (lambda () (partition file-is-directory? inputs))
(match-lambda*
((dirs ())
- ;; All inputs are directories. Create a new directory
- ;; where we will merge the input directories.
- (mkdir output)
-
- ;; Build a hash table mapping each file to a list of input
- ;; directories containing that file.
- (let ((table (make-hash-table)))
-
- (define (add-to-table! file dir)
- (hash-set! table file (cons dir (hash-ref table file '()))))
-
- ;; Populate the table.
- (for-each (lambda (dir)
- (for-each (cut add-to-table! <> dir)
- (files-in-directory dir)))
- dirs)
-
- ;; Now iterate over the table and recursively
- ;; perform a union for each entry.
- (hash-for-each (lambda (file dirs-with-file)
- (union (string-append output "/" file)
- (map (cut string-append <> "/" file)
- (reverse dirs-with-file))))
- table)))
+ ;; All inputs are directories.
+ (union-of-directories output dirs))
((() (file (? (cut file=? <> file)) ...))
;; There are no directories, and all files have the same contents,
@@ -141,11 +119,36 @@ the INPUTS."
((dirs files)
(resolve-collisions output dirs files)))))))
+ (define (union-of-directories output dirs)
+ ;; Create a new directory where we will merge the input directories.
+ (mkdir output)
+
+ ;; Build a hash table mapping each file to a list of input
+ ;; directories containing that file.
+ (let ((table (make-hash-table)))
+
+ (define (add-to-table! file dir)
+ (hash-set! table file (cons dir (hash-ref table file '()))))
+
+ ;; Populate the table.
+ (for-each (lambda (dir)
+ (for-each (cut add-to-table! <> dir)
+ (files-in-directory dir)))
+ dirs)
+
+ ;; Now iterate over the table and recursively
+ ;; perform a union for each entry.
+ (hash-for-each (lambda (file dirs-with-file)
+ (union (string-append output "/" file)
+ (map (cut string-append <> "/" file)
+ (reverse dirs-with-file))))
+ table)))
+
(setvbuf (current-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF)
(when (file-port? log-port)
(setvbuf log-port _IOLBF))
- (union output (delete-duplicates inputs)))
+ (union-of-directories output (delete-duplicates inputs)))
;;; union.scm ends here