cache: Work around 'time-monotonic' bug in Guile 2.2.2.

* guix/cache.scm (time-monotonic) [guile-2.2]: New variable.
* tests/cache.scm (time-monotonic) [guile-2.2]: Likewise.
* guix/build/download.scm (time-monotonic) [guile-2.2]: Adjust comment:
it's a 2.2.2 bug.
This commit is contained in:
Ludovic Courtès 2017-04-22 14:40:51 +02:00
parent 8a8e2d2ed5
commit 25a49294ca
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 16 additions and 3 deletions

View File

@ -142,9 +142,8 @@ Otherwise return STORE-PATH."
(cond-expand (cond-expand
(guile-2.2 (guile-2.2
;; Guile 2.2.0 to 2.2.2 included has a bug whereby 'time-monotonic' objects ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
;; have seconds and nanoseconds swapped (fixed in Guile commit 886ac3e). ;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it.
;; Work around it.
(define time-monotonic time-tai)) (define time-monotonic time-tai))
(else #t)) (else #t))

View File

@ -33,6 +33,13 @@
;;; ;;;
;;; Code: ;;; Code:
(cond-expand
(guile-2.2
;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it.
(define time-monotonic time-tai))
(else #t))
(define (obsolete? date now ttl) (define (obsolete? date now ttl)
"Return #t if DATE is obsolete compared to NOW + TTL seconds." "Return #t if DATE is obsolete compared to NOW + TTL seconds."
(time>? (subtract-duration now (make-time time-duration 0 ttl)) (time>? (subtract-duration now (make-time time-duration 0 ttl))

View File

@ -24,6 +24,13 @@
#:use-module ((guix utils) #:select (call-with-temporary-directory)) #:use-module ((guix utils) #:select (call-with-temporary-directory))
#:use-module (ice-9 match)) #:use-module (ice-9 match))
(cond-expand
(guile-2.2
;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it.
(define time-monotonic time-tai))
(else #t))
(test-begin "cache") (test-begin "cache")
(test-equal "remove-expired-cache-entries" (test-equal "remove-expired-cache-entries"