diff options
author | Mark H Weaver <mhw@netris.org> | 2014-04-03 17:49:20 -0400 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2014-04-03 18:35:16 -0400 |
commit | 6a0b30f36c3bf2992eaddd23d4e05b7f7b987506 (patch) | |
tree | 9457dcbc57f4fdafb07693713c5af5d8b0f1a049 /guix | |
parent | ded1012f3c9f5d5e60481274c5b3280acc277b34 (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.scm | 53 |
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 |