From: Attila Lendvai <attila@lendvai.name>
To: 50878@debbugs.gnu.org
Cc: Attila Lendvai <attila@lendvai.name>
Subject: [bug#50878] [PATCH 4/4] WIP guix: build: Add resolve-collision/alphanumeric-last for union.
Date: Sun, 3 Oct 2021 14:43:04 +0200 [thread overview]
Message-ID: <20211003124303.8277-4-attila@lendvai.name> (raw)
In-Reply-To: <20211003124303.8277-1-attila@lendvai.name>
It is currently not used anywhere, only exported. The tests are boken, because
guile is too old in the test environment, at least on 'x86_64-linux' (guile
2.0.9 doesn't have srfi-43, aka vectors). Probably it's also broken because
testing errors with `no code for module (guix build utils)`.
* guix/build/union.scm (resolve-collision/alphanumeric-last): New function.
* guix/build/utils.scm (compare-strings-ignoring-store-path-prefix): New function.
---
I think the previous 3 patches in this patchset are worthy of inclusion,
but this one is more of a good idea than a worked out change, to be picked
up later, if at all.
The primary issue is that the test framework uses a guile that is too old,
but it's also not used anywhere. It would be nice if this was used for
resolving conflicts for profiles, i.e. for the user's bin/ directory.
guix/build/union.scm | 12 ++++++++++++
guix/build/utils.scm | 27 +++++++++++++++++++++++++++
tests/union.scm | 9 +++++++++
3 files changed, 48 insertions(+)
diff --git a/guix/build/union.scm b/guix/build/union.scm
index 9e8c2af4f5..339af7576c 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -19,15 +19,18 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build union)
+ #:use-module (guix build utils)
#:use-module (ice-9 match)
#: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
default-collision-resolver
+ resolve-collision/alphanumeric-last
relative-file-name
symlink-relative))
@@ -102,6 +105,15 @@ identical, #f otherwise."
;; applications via 'glib-or-gtk-build-system'.
'("icon-theme.cache" "gschemas.compiled"))
+(define (resolve-collision/alphanumeric-last files)
+ ;; Let's do a stable-sort, so that multiple foo-1.2.3/bin/foo variants will
+ ;; predictably resolve to the highest versioned one.
+ (let ((files-vector (list->vector files)))
+ (stable-sort! files-vector
+ (lambda (a b)
+ (> 0 (compare-strings-ignoring-store-path-prefix a b))))
+ (vector-ref files-vector 0)))
+
(define (resolve-collision/pick-first files)
(first files))
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 4009c137b8..1ae0244b04 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -47,6 +47,7 @@
%store-hash-string-length
store-file-name?
strip-store-file-name
+ compare-strings-ignoring-store-path-prefix
package-name->name+version
parallel-job-count
@@ -171,6 +172,32 @@
is typically a \"PACKAGE-VERSION\" string."
(string-drop file (store-path-prefix-length)))
+(define (compare-strings-ignoring-store-path-prefix a b)
+ (let ((a-length (string-length a))
+ (b-length (string-length b)))
+ (do ((i (store-path-prefix-length) (+ i 1)))
+ ((not (and (< i a-length)
+ (< i b-length)
+ (char=? (string-ref a i)
+ (string-ref b i))))
+ (cond
+ ((= a-length b-length)
+ (if (= i a-length) ; we reached the end without any difference
+ 0
+ (- (char->integer (string-ref a i))
+ (char->integer (string-ref b i)))))
+ ((> a-length b-length)
+ (if (= i b-length) ; we reached the end of B without a difference
+ 1
+ (- (char->integer (string-ref a i))
+ (char->integer (string-ref b i)))))
+ (else ; i.e. (< a-length b-length)
+ (if (= i a-length) ; we reached the end of A without a difference
+ -1
+ (- (char->integer (string-ref a i))
+ (char->integer (string-ref b i)))))))
+ '())))
+
(define (package-name->name+version name)
"Given NAME, a package name like \"foo-0.9.1b\", return two values:
\"foo\" and \"0.9.1b\". When the version part is unavailable, NAME and
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 prev parent reply other threads:[~2021-10-03 12:48 UTC|newest]
Thread overview: 18+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-09-28 21:40 [bug#50878] [PATCH] union: Resolve collisions by stable-sort'ing them Attila Lendvai
2021-09-29 13:48 ` 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 ` Attila Lendvai [this message]
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=20211003124303.8277-4-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).