From: Mark H Weaver <mhw@netris.org>
Date: Sun, 21 Oct 2018 23:21:47 +0000 (-0400)
Subject: SRFI-19: Fix normalization of seconds and nanoseconds in time records.
X-Git-Tag: v2.9.2~2^2~36
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=437e1aa03659b77a8eb4b5c6d2b104c03d038564;p=platform%2Fupstream%2Fguile.git

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.
---

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)))
diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test
index 0f1c33352..4d79f1043 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