GNU bug report logs - #50878
[PATCH] union: Resolve collisions by stable-sort'ing them.

Previous Next

Full log

View this message in rfc822 format

From: Attila Lendvai <attila <at> lendvai.name>
To: 50878 <at> debbugs.gnu.org
Cc: Attila Lendvai <attila <at> lendvai.name>
Subject: [bug#50878] [PATCH 3/4] guix: build: Factor out and export default-collision-resolver.
Date: Sun,  3 Oct 2021 14:43:02 +0200

This prepares the stage for new collision resolvers, but no semantic changes.

* guix/build/union.scm (resolve-collision/pick-first): New function.
(resolve-collision-and-maybe-warn): New function.
(default-collision-resolver): New function.
---
 guix/build/union.scm | 16 ++++++++++------
 guix/gexp.scm        |  2 +-
 2 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/guix/build/union.scm b/guix/build/union.scm
index 961ac3298b..9e8c2af4f5 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
+            default-collision-resolver
 
             relative-file-name
             symlink-relative))
@@ -102,10 +102,11 @@ identical, #f otherwise."
   ;; applications via 'glib-or-gtk-build-system'.
   '("icon-theme.cache" "gschemas.compiled"))
 
-(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)))
+(define (resolve-collision/pick-first files)
+  (first files))
+
+(define (resolve-collision-and-maybe-warn files resolver)
+  (let ((file (resolver files)))
     (unless (member (basename file) %harmless-collisions)
       (format (current-error-port)
               "~%warning: collision encountered:~%~{  ~a~%~}"
@@ -113,11 +114,14 @@ first one of THEM."
       (format (current-error-port) "warning: choosing ~a~%" file))
     file))
 
+(define (default-collision-resolver files)
+  (resolve-collision-and-maybe-warn files resolve-collision/pick-first))
+
 (define* (union-build output inputs
                       #:key (log-port (current-error-port))
                       (create-all-directories? #f)
                       (symlink symlink)
-                      (resolve-collision warn-about-collision))
+                      (resolve-collision default-collision-resolver))
   "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 f3d278b3e6..32e8748443 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -1983,7 +1983,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 'default-collision-resolver))
   "Return a directory that is the union of THINGS, where THINGS is a list of
 file-like objects denoting directories.  For example:
 
-- 
2.33.0

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.