From 6c8582bc41c8935b8e9d63146595e87d9b92fa95 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 3 Apr 2014 17:49:20 -0400 Subject: [PATCH] union: Ensure that the output is always a directory. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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'. --- guix/build/union.scm | 53 +++++++++++++++++++++++++++------------------------- 1 file changed, 28 insertions(+), 25 deletions(-) diff --git a/guix/build/union.scm b/guix/build/union.scm index c65bea4..ccd2d5c 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 -- 1.8.4