[Guile-commits] 22/55: SRFI-19: Fix normalization of seconds and nanoseconds in time records.

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 0389c59bd4201ed10c26917d23adb1dfea56f659
Author: Mark H Weaver <address@hidden>
Date:   Sun Oct 21 19:21:47 2018 -0400

    SRFI-19: Fix normalization of seconds and nanoseconds in time records.
    
    Fixes <https://bugs.gnu.org/26162>.
    Reported by Zefram <address@hidden>.
    
    * module/srfi/srfi-19.scm (time-normalize!): Rewrite.
    * test-suite/tests/srfi-19.test: Add tests.
---
 module/srfi/srfi-19.scm       | 34 ++++++++++++++++------------------
 test-suite/tests/srfi-19.test |  8 ++++++++
 2 files changed, 24 insertions(+), 18 deletions(-)

diff --git a/module/srfi/srfi-19.scm b/module/srfi/srfi-19.scm
index 9de22b0..ba1327c 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)))
diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test
index 0f1c333..4d79f10 100644
--- a/test-suite/tests/srfi-19.test
+++ b/test-suite/tests/srfi-19.test
@@ -206,6 +206,14 @@ incomplete numerical tower implementation.)"
     (test-time-arithmetic add-duration time1 diff time2)
     (test-time-arithmetic subtract-duration time2 diff time1))
 
+  (with-test-prefix "nanosecond normalization"
+    (pass-if "small positive duration"
+      (time-equal? (make-time time-duration 999999000 0)
+                   (time-difference (make-time time-tai 0 1) (make-time 
time-tai 1000 0))))
+    (pass-if "small negative duration"
+      (time-equal? (make-time time-duration -999999000 0)
+                   (time-difference (make-time time-tai 1000 0) (make-time 
time-tai 0 1)))))
+
   (with-test-prefix "date->time-tai"
     ;; leap second 1 Jan 1999, 1 second of UTC in make-date is out as 2
     ;; seconds of TAI in date->time-tai