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 9de22b0edadc2b6d85932ed0fe912f39358b348e..ba1327c9fac10457950698f80cce572506751a1d 100644 (file)
--- 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 0f1c333523fa67590d7b7c9b3c5d0e4312490655..4d79f104356d26c7cacb2955c89280b500db8e5b 100644 (file)
--- 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