nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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'.
This commit is contained in:
Mark H Weaver 2014-04-03 17:49:20 -04:00
parent ded1012f3c
commit 6a0b30f36c
1 changed files with 28 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
guix/build/union.scm
View File

@ -108,30 +108,8 @@ the INPUTS."
(call-with-values (lambda () (partition file-is-directory? inputs)) (call-with-values (lambda () (partition file-is-directory? inputs))
(match-lambda* (match-lambda*
((dirs ()) ((dirs ())
;; All inputs are directories. Create a new directory ;; All inputs are directories.
;; where we will merge the input directories. (union-of-directories output dirs))
(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)))
((() (file (? (cut file=? <> file)) ...)) ((() (file (? (cut file=? <> file)) ...))
;; There are no directories, and all files have the same contents, ;; There are no directories, and all files have the same contents,
@ -141,11 +119,36 @@ the INPUTS."
((dirs files) ((dirs files)
(resolve-collisions output 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-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF) (setvbuf (current-error-port) _IOLBF)
(when (file-port? log-port) (when (file-port? log-port)
(setvbuf log-port _IOLBF)) (setvbuf log-port _IOLBF))
(union output (delete-duplicates inputs))) (union-of-directories output (delete-duplicates inputs)))
;;; union.scm ends here ;;; union.scm ends here