diff options
| author | Mark H Weaver <mhw@netris.org> | 2018-10-21 19:21:47 -0400 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2018-10-21 19:25:45 -0400 |
| commit | 437e1aa03659b77a8eb4b5c6d2b104c03d038564 (patch) | |
| tree | 884e6e2e1fa617c0f90fbc22f06525ab6d62feb5 /module/srfi | |
| parent | bbe6daa769e183a41909e345412af73c6d2561ec (diff) | |
| download | guile-437e1aa03659b77a8eb4b5c6d2b104c03d038564.tar.gz | |
SRFI-19: Fix normalization of seconds and nanoseconds in time records.
Fixes <https://bugs.gnu.org/26162>.
Reported by Zefram <zefram@fysh.org>.
* module/srfi/srfi-19.scm (time-normalize!): Rewrite.
* test-suite/tests/srfi-19.test: Add tests.
Diffstat (limited to 'module/srfi')
| -rw-r--r-- | module/srfi/srfi-19.scm | 34 |
1 files changed, 16 insertions, 18 deletions
diff --git a/module/srfi/srfi-19.scm b/module/srfi/srfi-19.scm index 9de22b0ed..ba1327c9f 100644 --- a/module/srfi/srfi-19.scm +++ b/module/srfi/srfi-19.scm @@ -275,24 +275,22 @@ (values (inexact->exact l) (- r l))))) (define (time-normalize! t) - (if (>= (abs (time-nanosecond t)) 1000000000) - (receive (int frac) - (split-real (time-nanosecond t)) - (set-time-second! t (+ (time-second t) - (quotient int 1000000000))) - (set-time-nanosecond! t (+ (remainder int 1000000000) - frac)))) - (if (and (positive? (time-second t)) - (negative? (time-nanosecond t))) - (begin - (set-time-second! t (- (time-second t) 1)) - (set-time-nanosecond! t (+ 1000000000 (time-nanosecond t)))) - (if (and (negative? (time-second t)) - (positive? (time-nanosecond t))) - (begin - (set-time-second! t (+ (time-second t) 1)) - (set-time-nanosecond! t (+ 1000000000 (time-nanosecond t)))))) - t) + (let ((s (time-second t)) + (ns (time-nanosecond t))) + (when (>= (abs (time-nanosecond t)) + nano) + (let ((s* (+ s (inexact->exact + (truncate-quotient ns nano)))) + (ns* (truncate-remainder ns nano))) + (set-time-second! t s*) + (set-time-nanosecond! t ns*))) + (cond ((and (positive? s) (negative? ns)) + (set-time-second! t (- s 1)) + (set-time-nanosecond! t (+ ns nano))) + ((and (negative? s) (positive? ns)) + (set-time-second! t (+ s 1)) + (set-time-nanosecond! t (- ns nano)))) + t)) (define (make-time type nanosecond second) (time-normalize! (make-time-unnormalized type nanosecond second))) |