@@ -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))
@@ -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
@@ -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)