diff options
| -rw-r--r-- | guix/gnu-maintenance.scm | 12 | ||||
| -rw-r--r-- | guix/utils.scm | 20 |
2 files changed, 22 insertions, 10 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index c934694147..6475c386d3 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -28,6 +28,7 @@ #:use-module (srfi srfi-26) #:use-module (system foreign) #:use-module (guix ftp-client) + #:use-module (guix utils) #:export (official-gnu-packages releases latest-release @@ -156,21 +157,12 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\"). files) result))))))) -(define version-string>? - (let ((strverscmp - (let ((sym (or (dynamic-func "strverscmp" (dynamic-link)) - (error "could not find `strverscmp' (from GNU libc)")))) - (pointer->procedure int sym (list '* '*))))) - (lambda (a b) - "Return #t when B denotes a newer version than A." - (> (strverscmp (string->pointer a) (string->pointer b)) 0)))) - (define (latest-release project) "Return (\"FOO-X.Y\" . \"/bar/foo\") or #f." (let ((releases (releases project))) (and (not (null? releases)) (fold (lambda (release latest) - (if (version-string>? (car release) (car latest)) + (if (version>? (car release) (car latest)) release latest)) '("" . "") diff --git a/guix/utils.scm b/guix/utils.scm index 7ab835e7f1..d7c37e37d1 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -57,6 +57,8 @@ gnu-triplet->nix-system %current-system + version-compare + version>? package-name->name+version)) @@ -422,6 +424,24 @@ returned by `config.guess'." ;; By default, this is equal to (gnu-triplet->nix-system %host-type). (make-parameter %system)) +(define version-compare + (let ((strverscmp + (let ((sym (or (dynamic-func "strverscmp" (dynamic-link)) + (error "could not find `strverscmp' (from GNU libc)")))) + (pointer->procedure int sym (list '* '*))))) + (lambda (a b) + "Return '> when A denotes a newer version than B, +'< when A denotes a older version than B, +or '= when they denote equal versions." + (let ((result (strverscmp (string->pointer a) (string->pointer b)))) + (cond ((positive? result) '>) + ((negative? result) '<) + (else '=)))))) + +(define (version>? a b) + "Return #t when A denotes a newer version than B." + (eq? '> (version-compare a b))) + (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 |