[210_13] srfi-19 time-difference实现

devel/210_13.md

@@ -0,0 +1,15 @@
+# [210_13] srfi-19 time-difference实现
+
+## 添加 srfi-19 time-difference实现
+
+## 如何测试
+
+```shell
+# 可能需要清除缓存
+# rm .xmake/ build/ -r
+xmake f -vyD
+xmake b goldfish
+./bin/goldfish tests/goldfish/liii/time-test.scm
+```
+
+

goldfish/srfi/srfi-19.scm

@@ -66,6 +66,7 @@
     copy-time
     ;; Time comparison procedures
     ;; Time arithmetic procedures
+    time-difference
     ;; Current time and clock resolution
     current-date current-julian-day current-time time-resolution
     ;; Date object and accessors
@@ -155,7 +156,26 @@
     ;; Time arithmetic procedures
     ;; ====================
 
-    ;; TODO
+    (define (priv:time->nanoseconds time)
+      (+ (* (time-second time) priv:NANO)
+         (time-nanosecond time)))
+
+    (define (priv:time-difference time1 time2 time3)
+      (unless (and (time? time1) (time? time2))
+        (error 'wrong-type-arg "time-difference: time1 and time2 must be time objects" (list time1 time2)))
+      (unless (eq? (time-type time1) (time-type time2))
+        (error 'wrong-type-arg "time-difference: time types must match"
+               (list (time-type time1) (time-type time2))))
+      (receive (secs nanos)
+               (floor/ (- (priv:time->nanoseconds time1)
+                          (priv:time->nanoseconds time2))
+                       priv:NANO)
+        (set-time-second! time3 secs)
+        (set-time-nanosecond! time3 nanos))
+      time3)
+
+    (define (time-difference time1 time2)
+      (priv:time-difference time1 time2 (%make-time TIME-DURATION 0 0)))
 
     ;; ====================
     ;; Current time and clock resolution

tests/goldfish/liii/time-test.scm

@@ -339,6 +339,59 @@ wrong-type-arg
   (check (time-nanosecond t3) => 0)
   (check (time-second t3) => -1234567890))
 
+#|
+time-difference
+计算两个时间对象的差值。
+
+语法
+----
+(time-difference time1 time2)
+
+参数
+----
+time1 : time?
+time2 : time?
+两个时间对象，时间类型必须相同。
+
+返回值
+-----
+time?
+返回一个 TIME-DURATION 时间类型的时间对象。
+
+错误处理
+--------
+wrong-type-arg
+当参数不是时间对象或时间类型不匹配时抛出错误。
+|#
+
+;; Test time-difference
+(let* ((t1 (make-time TIME-UTC 100 5))
+       (t2 (make-time TIME-UTC 900000000 3))
+       (d  (time-difference t1 t2)))
+  (check (time-type d) => TIME-DURATION)
+  (check (time-second d) => 1)
+  (check (time-nanosecond d) => 100000100))
+
+;; Test negative duration normalization
+(let* ((t1 (make-time TIME-UTC 100 5))
+       (t2 (make-time TIME-UTC 900000000 5))
+       (d  (time-difference t1 t2)))
+  (check (time-second d) => -1)
+  (check (time-nanosecond d) => 100000100))
+
+;; Test zero difference
+(let* ((t1 (make-time TIME-UTC 123456789 42))
+       (d  (time-difference t1 t1)))
+  (check (time-second d) => 0)
+  (check (time-nanosecond d) => 0))
+
+;; Test error conditions
+(check-catch 'wrong-type-arg
+  (time-difference (make-time TIME-UTC 0 0)
+                   (make-time TIME-TAI 0 0)))
+(check-catch 'wrong-type-arg
+  (time-difference "not-time" (make-time TIME-UTC 0 0)))
+
 ;; Test error conditions
 (check-catch 'wrong-type-arg (time-type "not-a-time"))
 (check-catch 'wrong-type-arg (time-nanosecond 123))