diff --git a/devel/210_13.md b/devel/210_13.md new file mode 100644 index 00000000..1b798369 --- /dev/null +++ b/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 +``` + + diff --git a/goldfish/srfi/srfi-19.scm b/goldfish/srfi/srfi-19.scm index 8ccbe89e..e0b6d676 100644 --- a/goldfish/srfi/srfi-19.scm +++ b/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 diff --git a/tests/goldfish/liii/time-test.scm b/tests/goldfish/liii/time-test.scm index 86e5b1c9..b3e4ce7e 100644 --- a/tests/goldfish/liii/time-test.scm +++ b/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))