mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 22:08:16 -05:00
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:
parent
baed8816fc
commit
7db3ff4a29
4 changed files with 20 additions and 4 deletions
|
@ -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?
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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")
|
||||||
|
|
Loading…
Reference in a new issue