[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/01: SRFI-19: Check for incompatible types in time com
From: |
Mark H. Weaver |
Subject: |
[Guile-commits] 01/01: SRFI-19: Check for incompatible types in time comparisons. |
Date: |
Sun, 21 Oct 2018 19:43:40 -0400 (EDT) |
mhw pushed a commit to branch stable-2.2
in repository guile.
commit c9d903b6e4f8cc1d8382b20a2f0502c4ce8ffe0a
Author: Mark H Weaver <address@hidden>
Date: Sun Oct 21 19:38:18 2018 -0400
SRFI-19: Check for incompatible types in time comparisons.
Fixes <https://bugs.gnu.org/26163>.
Reported by Zefram <address@hidden>.
* module/srfi/srfi-19.scm (time-compare-check): New procedure.
(time=?): Use 'time-compare-check' to check the arguments and raise an
error in case of mismatched types. Previously, mismatched types would
cause time=? to return #f.
(time>?, time<?, time>=?, time<=?, time-difference!): Use
'time-compare-check' to check the arguments.
---
module/srfi/srfi-19.scm | 19 ++++++++++++-------
1 file changed, 12 insertions(+), 7 deletions(-)
diff --git a/module/srfi/srfi-19.scm b/module/srfi/srfi-19.scm
index ba1327c..2f5f322 100644
--- a/module/srfi/srfi-19.scm
+++ b/module/srfi/srfi-19.scm
@@ -374,35 +374,39 @@
(else (time-error 'time-resolution 'invalid-clock-type clock-type)))))
;; -- Time comparisons
+
+(define (time-compare-check t1 t2 caller)
+ (unless (and (time? t1) (time? t2)
+ (eq? (time-type t1) (time-type t2)))
+ (time-error caller 'incompatible-time-types (cons t1 t2))))
(define (time=? t1 t2)
;; Arrange tests for speed and presume that t1 and t2 are actually times.
;; also presume it will be rare to check two times of different types.
+ (time-compare-check t1 t2 'time=?)
(and (= (time-second t1) (time-second t2))
- (= (time-nanosecond t1) (time-nanosecond t2))
- ;; XXX The SRFI-19 reference implementation raises an error in
- ;; case of unequal time types. Here we return #false.
- (eq? (time-type t1) (time-type t2))))
-
-;; XXX In the following comparison procedures, the SRFI-19 reference
-;; implementation raises an error in case of unequal time types.
+ (= (time-nanosecond t1) (time-nanosecond t2))))
(define (time>? t1 t2)
+ (time-compare-check t1 t2 'time>?)
(or (> (time-second t1) (time-second t2))
(and (= (time-second t1) (time-second t2))
(> (time-nanosecond t1) (time-nanosecond t2)))))
(define (time<? t1 t2)
+ (time-compare-check t1 t2 'time<?)
(or (< (time-second t1) (time-second t2))
(and (= (time-second t1) (time-second t2))
(< (time-nanosecond t1) (time-nanosecond t2)))))
(define (time>=? t1 t2)
+ (time-compare-check t1 t2 'time>=?)
(or (> (time-second t1) (time-second t2))
(and (= (time-second t1) (time-second t2))
(>= (time-nanosecond t1) (time-nanosecond t2)))))
(define (time<=? t1 t2)
+ (time-compare-check t1 t2 'time<=?)
(or (< (time-second t1) (time-second t2))
(and (= (time-second t1) (time-second t2))
(<= (time-nanosecond t1) (time-nanosecond t2)))))
@@ -413,6 +417,7 @@
;; implementation raises an error in case of unequal time types.
(define (time-difference! time1 time2)
+ (time-compare-check time1 time2 'time-difference!)
(let ((sec-diff (- (time-second time1) (time-second time2)))
(nsec-diff (- (time-nanosecond time1) (time-nanosecond time2))))
(set-time-type! time1 time-duration)