diff options
| author | Mark H Weaver <mhw@netris.org> | 2018-10-21 19:38:18 -0400 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2018-10-21 19:42:38 -0400 |
| commit | c9d903b6e4f8cc1d8382b20a2f0502c4ce8ffe0a (patch) | |
| tree | e8495c71a83d9571669da3f8af242bb7e89bc8d5 /module/srfi | |
| parent | 437e1aa03659b77a8eb4b5c6d2b104c03d038564 (diff) | |
| download | guile-c9d903b6e4f8cc1d8382b20a2f0502c4ce8ffe0a.tar.gz | |
SRFI-19: Check for incompatible types in time comparisons.
Fixes <https://bugs.gnu.org/26163>.
Reported by Zefram <zefram@fysh.org>.
* 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.
Diffstat (limited to 'module/srfi')
| -rw-r--r-- | module/srfi/srfi-19.scm | 19 |
1 files changed, 12 insertions, 7 deletions
diff --git a/module/srfi/srfi-19.scm b/module/srfi/srfi-19.scm index ba1327c9f..2f5f322df 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) |