utils: Add `guile-version>?', and use it.

This fixes Guile version comparisons when (version) has a
vendor-specific suffix.

Reported by Andreas Enge <andreas@enge.fr>.

* guix/utils.scm (guile-version>?): New procedure.
* tests/utils.scm ("guile-version>? 1.8", "guile-version>? 10.5"): New
  tests.
* guix/scripts/substitute-binary.scm (fetch, progress-report-port): Use
  `guile-version>?' instead of `version>?'.
* guix/http-client.scm (when-guile<=2.0.5, http-fetch): Likewise.
This commit is contained in:
Ludovic Courtès 2013-08-23 15:51:36 +02:00
parent baed8816fc
commit 7db3ff4a29
4 changed files with 20 additions and 4 deletions

View file

@ -133,7 +133,7 @@ (define bad-response
(get-bytevector-all (response-port r)))))) (get-bytevector-all (response-port r))))))
;; Install this patch only on Guile 2.0.5. ;; Install this patch only on Guile 2.0.5.
(when (version>? "2.0.6" (version)) (unless (guile-version>? "2.0.5")
(module-set! (resolve-module '(web response)) (module-set! (resolve-module '(web response))
'read-response-body read-response-body*))) 'read-response-body read-response-body*)))
@ -163,7 +163,7 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t))
;; Try hard to use the API du jour to get an input port. ;; Try hard to use the API du jour to get an input port.
;; On Guile 2.0.5 and before, we can only get a string or ;; On Guile 2.0.5 and before, we can only get a string or
;; bytevector, and not an input port. Work around that. ;; bytevector, and not an input port. Work around that.
(if (version>? (version) "2.0.7") (if (guile-version>? "2.0.7")
(http-get uri #:streaming? #t #:port port) ; 2.0.9+ (http-get uri #:streaming? #t #:port port) ; 2.0.9+
(if (defined? 'http-get*) (if (defined? 'http-get*)
(http-get* uri #:decode-body? text? (http-get* uri #:decode-body? text?

View file

@ -155,7 +155,7 @@ (define* (fetch uri #:key (buffered? #t) (timeout? #t))
;; and then cancel with: ;; and then cancel with:
;; sudo tc qdisc del dev eth0 root ;; sudo tc qdisc del dev eth0 root
(let ((port #f)) (let ((port #f))
(with-timeout (if (or timeout? (version>? (version) "2.0.5")) (with-timeout (if (or timeout? (guile-version>? "2.0.5"))
%fetch-timeout %fetch-timeout
0) 0)
(begin (begin
@ -417,7 +417,7 @@ (define (read! bv start count)
;; Since `http-fetch' in Guile 2.0.5 returns all the data once it's done, ;; Since `http-fetch' in Guile 2.0.5 returns all the data once it's done,
;; don't pretend to report any progress in that case. ;; don't pretend to report any progress in that case.
(if (version>? (version) "2.0.5") (if (guile-version>? "2.0.5")
(make-custom-binary-input-port "progress-port-proc" (make-custom-binary-input-port "progress-port-proc"
read! #f #f read! #f #f
(cut close-port port)) (cut close-port port))

View file

@ -59,6 +59,7 @@ (define-module (guix utils)
%current-target-system %current-target-system
version-compare version-compare
version>? version>?
guile-version>?
package-name->name+version package-name->name+version
string-tokenize* string-tokenize*
file-extension file-extension
@ -316,6 +317,15 @@ (define (version>? a b)
"Return #t when A denotes a newer version than B." "Return #t when A denotes a newer version than B."
(eq? '> (version-compare a b))) (eq? '> (version-compare a b)))
(define (guile-version>? str)
"Return #t if the running Guile version is greater than STR."
;; Note: Using (version>? (version) "2.0.5") or similar doesn't work,
;; because the result of (version) can have a prefix, like "2.0.5-deb1".
(version>? (string-append (major-version) "."
(minor-version) "."
(micro-version))
str))
(define (package-name->name+version name) (define (package-name->name+version name)
"Given NAME, a package name like \"foo-0.9.1b\", return two values: "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 \"foo\" and \"0.9.1b\". When the version part is unavailable, NAME and

View file

@ -66,6 +66,12 @@ (define-module (test-utils)
("nixpkgs" "1.0pre22125_a28fe19") ("nixpkgs" "1.0pre22125_a28fe19")
("gtk2" "2.38.0")))) ("gtk2" "2.38.0"))))
(test-assert "guile-version>? 1.8"
(guile-version>? "1.8"))
(test-assert "guile-version>? 10.5"
(not (guile-version>? "10.5")))
(test-equal "string-tokenize*" (test-equal "string-tokenize*"
'(("foo") '(("foo")
("foo" "bar" "baz") ("foo" "bar" "baz")