From: Attila Lendvai <attila@lendvai.name>
To: 50878@debbugs.gnu.org
Cc: Attila Lendvai <attila@lendvai.name>
Subject: [bug#50878] [PATCH] union: Resolve collisions by stable-sort'ing them.
Date: Tue, 28 Sep 2021 23:40:45 +0200 [thread overview]
Message-ID: <20210928214044.437-1-attila@lendvai.name> (raw)
* guix/build/union.scm (resolve-collision/alphanumeric-last): New function.
(warn-about-collision): Renamed to default-collision-resolver.
---
this should work, but i cannot test it, because srfi-43 seems not to be
available on the build side:
unpacking bootstrap Guile to '/home/alendvai/workspace/guix/guix/test-tmp/store/qky0jf68rr7pnsvmhj0ay42rzh4qk6r9-guile-bootstrap-2.0'...
[...] output without sfri-43.go
and then unsurprisingly: "no code for module (srfi srfi-43)"
is tis only a peculiarity of the test environment?
can you please advise how to proceed?
guix/build/union.scm | 26 ++++++++++++++++++++------
guix/gexp.scm | 2 +-
tests/union.scm | 9 +++++++++
3 files changed, 30 insertions(+), 7 deletions(-)
diff --git a/guix/build/union.scm b/guix/build/union.scm
index 961ac3298b..747902ec6c 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -23,11 +23,12 @@
#:use-module (ice-9 format)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-43)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:export (union-build
- warn-about-collision
+ default-collision-resolver
relative-file-name
symlink-relative))
@@ -102,10 +103,23 @@ 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/alphanumeric-last files)
+ ;; Let's do a stable-sort at least, so that multiple foo-1.2.3/bin/foo
+ ;; variants will predictably resolve to the highest versioned one.
+ (let* ((original-files (list->vector files))
+ (count (vector-length original-files))
+ (stripped-files (vector-map (lambda (_ el)
+ (strip-store-file-name el))
+ original-files))
+ (indices (vector-unfold values count)))
+ (stable-sort! indices
+ (lambda (a b)
+ (string> (vector-ref stripped-files a)
+ (vector-ref stripped-files b))))
+ (vector-ref original-files (vector-ref indices 0))))
+
+(define (default-collision-resolver files)
+ (let ((file (resolve-collision/alphanumeric-last files)))
(unless (member (basename file) %harmless-collisions)
(format (current-error-port)
"~%warning: collision encountered:~%~{ ~a~%~}"
@@ -117,7 +131,7 @@ first one of THEM."
#: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:
diff --git a/tests/union.scm b/tests/union.scm
index a8387edf42..cbf8840793 100644
--- a/tests/union.scm
+++ b/tests/union.scm
@@ -204,4 +204,13 @@
("/a/b" "/a/b/c/d" => "c/d")
("/a/b/c" "/a/d/e/f" => "../../d/e/f")))
+(test-assert "resolve-collision/alphanumeric-last sorts alphanumerically"
+ (string=
+ ((@@ (guix build union) resolve-collision/alphanumeric-last)
+ (list "/gnu/store/c0000000000000000000000000000000-idris-0.0.0/bin/idris"
+ "/gnu/store/60000000000000000000000000000000-idris-2.0.0/bin/idris"
+ "/gnu/store/z0000000000000000000000000000000-idris-1.3.5/bin/idris"
+ "/gnu/store/00000000000000000000000000000000-idris-1.3.3/bin/idris"))
+ "/gnu/store/60000000000000000000000000000000-idris-2.0.0/bin/idris"))
+
(test-end)
--
2.33.0
next reply other threads:[~2021-09-28 21:45 UTC|newest]
Thread overview: 18+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-09-28 21:40 Attila Lendvai [this message]
2021-09-29 13:48 ` [bug#50878] [PATCH] union: Resolve collisions by stable-sort'ing them Maxime Devos
2021-09-29 16:03 ` Attila Lendvai
2021-09-29 21:00 ` Maxime Devos
2021-09-29 17:42 ` Liliana Marie Prikler
2021-09-30 8:10 ` Attila Lendvai
2021-09-30 8:42 ` Maxime Devos
2021-09-30 14:00 ` Ludovic Courtès
2021-09-30 14:12 ` Attila Lendvai
2021-09-30 15:18 ` Maxime Devos
2021-09-30 18:13 ` Liliana Marie Prikler
2021-09-30 18:52 ` Liliana Marie Prikler
2021-10-03 12:43 ` [bug#50878] [PATCH 1/4] guix: build: Promote local define-inline to a define-constant util Attila Lendvai
2021-10-03 12:43 ` [bug#50878] [PATCH 2/4] guix: build: Avoid using magic literals in the code for hash length Attila Lendvai
2021-10-03 12:43 ` [bug#50878] [PATCH 3/4] guix: build: Factor out and export default-collision-resolver Attila Lendvai
2021-10-03 12:43 ` [bug#50878] [PATCH 4/4] WIP guix: build: Add resolve-collision/alphanumeric-last for union Attila Lendvai
2021-10-03 12:59 ` [bug#50878] (No Subject) Attila Lendvai
2022-09-02 16:04 ` Liliana Marie Prikler
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210928214044.437-1-attila@lendvai.name \
--to=attila@lendvai.name \
--cc=50878@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).