2006-02-01 Ludovic Courtès <ludovic.courtes@laas.fr>

[bpt/guile.git] / test-suite / tests / srfi-19.test

diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test
index 4300bf0..f694b86 100644 (file)
--- a/test-suite/tests/srfi-19.test
+++ b/test-suite/tests/srfi-19.test
@@ -1,7 +1,7 @@
 ;;;; srfi-19.test --- test suite for SRFI-19 -*- scheme -*-
 ;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001
 ;;;;
-;;;;   Copyright (C) 2001, 2003, 2004 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -15,8 +15,8 @@
 ;;;;
 ;;;; You should have received a copy of the GNU General Public License
 ;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;;;; Boston, MA 02111-1307 USA
+;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
 
 ;; SRFI-19 overrides current-date, so we have to do the test in a
 ;; separate module, or later tests will fail.
@@ -89,6 +89,12 @@ incomplete numerical tower implementation.)"
   (pass-if (format #f "~A works" op)
            (time=? (op a b) res)))
 
+;; return true if time objects X and Y are equal
+(define (time-equal? x y)
+  (and (eq?  (time-type x)       (time-type y))
+       (eqv? (time-second x)     (time-second y))
+       (eqv? (time-nanosecond x) (time-nanosecond y))))
+
 (with-test-prefix "SRFI date/time library"
   ;; check for typos and silly errors
   (pass-if "date-zone-offset is defined"
@@ -153,6 +159,25 @@ incomplete numerical tower implementation.)"
     (test-time-arithmetic add-duration time1 diff time2)
     (test-time-arithmetic subtract-duration time2 diff time1))
 
+  (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
+    (pass-if "31dec98 23:59:59"
+      (time-equal? (make-time time-tai 0 915148830)
+                  (date->time-tai (make-date 0 59 59 23 31 12 1998 0))))
+    (pass-if "1jan99 0:00:00"
+      (time-equal? (make-time time-tai 0 915148832)
+                  (date->time-tai (make-date 0 0  0  0   1  1 1999 0))))
+
+    ;; leap second 1 Jan 2006, 1 second of UTC in make-date is out as 2
+    ;; seconds of TAI in date->time-tai
+    (pass-if "31dec05 23:59:59"
+      (time-equal? (make-time time-tai 0 1136073631)
+                  (date->time-tai (make-date 0 59 59 23 31 12 2005 0))))
+    (pass-if "1jan06 0:00:00"
+      (time-equal? (make-time time-tai 0 1136073633)
+                  (date->time-tai (make-date 0 0  0  0   1  1 2006 0)))))
+
   (with-test-prefix "date-week-number"
     (pass-if (= 0 (date-week-number (make-date 0 0 0 0 1 1 1984 0) 0)))
     (pass-if (= 0 (date-week-number (make-date 0 0 0 0 7 1 1984 0) 0)))