diff options
author | Marius Bakke <mbakke@fastmail.com> | 2018-04-16 18:15:28 +0200 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2018-04-16 18:15:28 +0200 |
commit | 5d904d63f4d43e3f0e4be38c5f5404e029c00a22 (patch) | |
tree | b2893eceae99c967e0f49cdbfe084f6c7d4767c4 /guix/build | |
parent | bab5f3a7f62150ae009e78d03c4b1f5b1646104c (diff) | |
parent | d0ee11b2f000c3c027fd8370bc2195266398444f (diff) | |
download | guix-patches-5d904d63f4d43e3f0e4be38c5f5404e029c00a22.tar guix-patches-5d904d63f4d43e3f0e4be38c5f5404e029c00a22.tar.gz |
Merge branch 'master' into staging
Diffstat (limited to 'guix/build')
-rw-r--r-- | guix/build/union.scm | 40 |
1 files changed, 25 insertions, 15 deletions
diff --git a/guix/build/union.scm b/guix/build/union.scm index d46b750035..1179f1234b 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com> ;;; @@ -25,7 +25,9 @@ #:use-module (srfi srfi-26) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) - #:export (union-build)) + #:export (union-build + + warn-about-collision)) ;;; Commentary: ;;; @@ -76,14 +78,29 @@ identical, #f otherwise." (or (eof-object? n1) (loop)))))))))))))) +(define (warn-about-collision files) + "Handle the collision among FILES by emitting a warning and choosing the +first one of THEM." + (format (current-error-port) + "~%warning: collision encountered:~%~{ ~a~%~}" + files) + (let ((file (first files))) + (format (current-error-port) "warning: choosing ~a~%" file) + file)) + (define* (union-build output inputs #:key (log-port (current-error-port)) (create-all-directories? #f) - (symlink symlink)) + (symlink symlink) + (resolve-collision warn-about-collision)) "Build in the OUTPUT directory a symlink tree that is the union of all the INPUTS, using SYMLINK to create symlinks. As a special case, if CREATE-ALL-DIRECTORIES?, creates the subdirectories in the output directory to -make sure the caller can modify them later." +make sure the caller can modify them later. + +When two or more regular files collide, call RESOLVE-COLLISION with the list +of colliding files and use the one that it returns; or, if RESOLVE-COLLISION +returns #f, skip the faulty file altogether." (define (symlink* input output) (format log-port "`~a' ~~> `~a'~%" input output) @@ -92,17 +109,10 @@ make sure the caller can modify them later." (define (resolve-collisions output dirs files) (cond ((null? dirs) ;; The inputs are all files. - (format (current-error-port) - "~%warning: collision encountered:~%~{~a~%~}" - files) - - (let ((file (first files))) - ;; TODO: Implement smarter strategies. - (format (current-error-port) - "warning: arbitrarily choosing ~a~%" - file) - - (symlink* file output))) + (match (resolve-collision files) + (#f #f) + ((? string? file) + (symlink* file output)))) (else ;; The inputs are a mixture of files and directories |