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

union: Make the log port a parameter. 

* guix/build/union.scm (union-build): Add 'log-port' keyword parameter;
  use it.
This commit is contained in:
Ludovic Courtès 2013-10-30 21:43:37 +01:00
parent d0dc4907d6
commit c065c443a0
1 changed files with 5 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
guix/build/union.scm
View File

@ -100,7 +100,8 @@ single leaf."
,@(map loop dirs)))) ,@(map loop dirs))))
(leaf leaf)))) (leaf leaf))))
(define* (union-build output directories) (define* (union-build output directories
#:key (log-port (current-error-port)))
"Build in the OUTPUT directory a symlink tree that is the union of all "Build in the OUTPUT directory a symlink tree that is the union of all
the DIRECTORIES." the DIRECTORIES."
(define (file-tree dir) (define (file-tree dir)
@ -174,6 +175,8 @@ the DIRECTORIES."
(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)
(setvbuf log-port _IOLBF))
(mkdir output) (mkdir output)
(let loop ((tree (delete-duplicate-leaves (let loop ((tree (delete-duplicate-leaves
@ -189,8 +192,7 @@ the DIRECTORIES."
;; A leaf: create a symlink. ;; A leaf: create a symlink.
(let* ((dir (string-join dir "/")) (let* ((dir (string-join dir "/"))
(target (string-append output "/" dir "/" (basename tree)))) (target (string-append output "/" dir "/" (basename tree))))
(format (current-error-port) "`~a' ~~> `~a'~%" (format log-port "`~a' ~~> `~a'~%" tree target)
tree target)
(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.