;;;; 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, 2006, 2007 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
:use-module (srfi srfi-19)
:use-module (ice-9 format))
+;; Make sure we use the default locale.
+(setlocale LC_ALL "C")
+
(define (with-tz* tz thunk)
"Temporarily set the TZ environment variable to the passed string
value and call THUNK."
(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"
add-duration
#t))
(pass-if "(current-time time-tai) works"
- (begin (current-time time-tai) #t))
+ (time? (current-time time-tai)))
+ (pass-if "(current-time time-process) works"
+ (time? (current-time time-process)))
(test-time-conversion time-utc time-tai)
(test-time-conversion time-utc time-monotonic)
(test-time-conversion time-tai time-monotonic)
(string->date "2001-06-01@08:00" "~Y-~m-~d@~H:~M")))
(date->time-utc
(make-date 0 0 0 12 1 6 2001 0))))
+ (pass-if "string->date understands days and months"
+ (time=? (let ((d (string->date "Saturday, December 9, 2006"
+ "~A, ~B ~d, ~Y")))
+ (date->time-utc (make-date (date-nanosecond d)
+ (date-second d)
+ (date-minute d)
+ (date-hour d)
+ (date-day d)
+ (date-month d)
+ (date-year d)
+ 0)))
+ (date->time-utc
+ (make-date 0 0 0 0 9 12 2006 0))))
;; check time comparison procedures
(let* ((time1 (make-time time-monotonic 0 0))
(time2 (make-time time-monotonic 0 0))
(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)))