~ruther/guix-local

7db3ff4a29415ccc4f781c3e2450deb97d51a26f — Ludovic Courtès 12 years ago baed881
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.
4 files changed, 20 insertions(+), 4 deletions(-)

M guix/http-client.scm
M guix/scripts/substitute-binary.scm
M guix/utils.scm
M tests/utils.scm
M guix/http-client.scm => guix/http-client.scm +2 -2
@@ 133,7 133,7 @@ closed it will also close PORT, unless the KEEP-ALIVE? is true."
             (get-bytevector-all (response-port r))))))

 ;; 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))
                'read-response-body read-response-body*)))



@@ 163,7 163,7 @@ unbuffered port, suitable for use in `filtered-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
                     ;; 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+
                         (if (defined? 'http-get*)
                             (http-get* uri #:decode-body? text?

M guix/scripts/substitute-binary.scm => guix/scripts/substitute-binary.scm +2 -2
@@ 155,7 155,7 @@ provide."
     ;; and then cancel with:
     ;;   sudo tc qdisc del dev eth0 root
     (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
                         0)
         (begin


@@ 417,7 417,7 @@ PORT.  REPORT-PROGRESS is a two-argument procedure such as that returned by

  ;; 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.
  (if (version>? (version) "2.0.5")
  (if (guile-version>? "2.0.5")
      (make-custom-binary-input-port "progress-port-proc"
                                     read! #f #f
                                     (cut close-port port))

M guix/utils.scm => guix/utils.scm +10 -0
@@ 59,6 59,7 @@
            %current-target-system
            version-compare
            version>?
            guile-version>?
            package-name->name+version
            string-tokenize*
            file-extension


@@ 316,6 317,15 @@ or '= when they denote equal versions."
  "Return #t when A denotes a newer version than 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)
  "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

M tests/utils.scm => tests/utils.scm +6 -0
@@ 66,6 66,12 @@
           ("nixpkgs" "1.0pre22125_a28fe19")
           ("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*"
  '(("foo")
    ("foo" "bar" "baz")