diff options
| -rw-r--r-- | guix/build/union.scm | 25 | ||||
| -rw-r--r-- | guix/gexp.scm | 2 |
2 files changed, 18 insertions, 9 deletions
diff --git a/guix/build/union.scm b/guix/build/union.scm index bf75c67c52..ce6d030109 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -27,7 +27,7 @@ #:use-module (rnrs io ports) #:export (union-build - warn-about-collision + resolve-collision/default relative-file-name symlink-relative)) @@ -103,22 +103,31 @@ identical, #f otherwise." ;; for most packages. '("icon-theme.cache" "gschemas.compiled" "ld.so.cache")) -(define (warn-about-collision files) - "Handle the collision among FILES by emitting a warning and choosing the -first one of THEM." - (let ((file (first files))) - (unless (member (basename file) %harmless-collisions) +(define (resolve+warn-if-harmful resolve files) + "Same as (resolve files), but print a warning if the resolved file is not +considered harmless. Also warn if the resolver doesn't pick any file." + (let ((file (resolve files))) + (cond + ((not file) (format (current-error-port) "~%warning: collision encountered:~%~{ ~a~%~}" files) - (format (current-error-port) "warning: choosing ~a~%" file)) + (format (current-error-port) "warning: not choosing any file~%")) + (((negate member) (basename file) %harmless-collisions) + (format (current-error-port) + "~%warning: collision encountered:~%~{ ~a~%~}" + files) + (format (current-error-port) "warning: choosing ~a~%" file))) file)) +(define (resolve-collision/default files) + (resolve+warn-if-harmful first files)) + (define* (union-build output inputs #:key (log-port (current-error-port)) (create-all-directories? #f) (symlink symlink) - (resolve-collision warn-about-collision)) + (resolve-collision resolve-collision/default)) "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 diff --git a/guix/gexp.scm b/guix/gexp.scm index 73595a216b..a50b93ed48 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -2128,7 +2128,7 @@ This yields an 'etc' directory containing these two files." (define* (directory-union name things #:key (copy? #f) (quiet? #f) - (resolve-collision 'warn-about-collision)) + (resolve-collision 'resolve-collision/default)) "Return a directory that is the union of THINGS, where THINGS is a list of file-like objects denoting directories. For example: |