summaryrefslogtreecommitdiff
path: root/test-suite/tests/srfi-19.test
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/tests/srfi-19.test')
-rw-r--r--test-suite/tests/srfi-19.test157
1 files changed, 0 insertions, 157 deletions
diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test
deleted file mode 100644
index 75eb25637..000000000
--- a/test-suite/tests/srfi-19.test
+++ /dev/null
@@ -1,157 +0,0 @@
-;;;; srfi-19.test --- test suite for SRFI-19 -*- scheme -*-
-;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001
-;;;;
-;;;; Copyright (C) 2001 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
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; 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
-
-;; SRFI-19 overrides current-date, so we have to do the test in a
-;; separate module, or later tests will fail.
-
-(define-module (test-suite test-srfi-19)
- :use-module (test-suite lib)
- :use-module (srfi srfi-19)
- :use-module (ice-9 format))
-
-(define (with-tz* tz thunk)
- "Temporarily set the TZ environment variable to the passed string
-value and call THUNK."
- (let ((old-tz #f))
- (dynamic-wind
- (lambda ()
- (set! old-tz (getenv "TZ"))
- (putenv (format "TZ=~A" tz)))
- thunk
- (lambda ()
- (if old-tz
- (putenv (format "TZ=~A" old-tz))
- (putenv "TZ"))))))
-
-(defmacro with-tz (tz . body)
- `(with-tz* ,tz (lambda () ,@body)))
-
-(define (test-integral-time-structure date->time)
- "Test whether the given DATE->TIME procedure creates a time
-structure with integral seconds. (The seconds shall be maintained as
-integers, or precision may go away silently. The SRFI-19 reference
-implementation was not OK for Guile in this respect because of Guile's
-incomplete numerical tower implementation.)"
- (pass-if (format "~A makes integer seconds"
- date->time)
- (exact? (time-second
- (date->time (make-date 0 0 0 12 1 6 2001 0))))))
-
-(define (test-time->date time->date date->time)
- (pass-if (format "~A works"
- time->date)
- (begin
- (time->date (date->time (make-date 0 0 0 12 1 6 2001 0)))
- #t)))
-
-(define (test-dst time->date date->time)
- (pass-if (format "~A respects local DST if no TZ-OFFSET given"
- time->date)
- (let ((time (date->time (make-date 0 0 0 12 1 6 2001 0))))
- ;; on 2001-06-01, there should be two hours zone offset
- ;; between CET (CEST) and GMT
- (= (date-zone-offset
- (with-tz "CET"
- (time->date time)))
- 7200))))
-
-(define-macro (test-time-conversion a b)
- (let* ((a->b-sym (symbol-append a '-> b))
- (b->a-sym (symbol-append b '-> a)))
- `(pass-if (format "~A and ~A work and are inverses of each other"
- ',a->b-sym ',b->a-sym)
- (let ((time (make-time ,a 12345 67890123)))
- (time=? time (,b->a-sym (,a->b-sym time)))))))
-
-(define (test-time-comparison cmp a b)
- (pass-if (format #f "~A works" cmp)
- (cmp a b)))
-
-(define (test-time-arithmetic op a b res)
- (pass-if (format #f "~A works" op)
- (time=? (op a b) res)))
-
-(with-test-prefix "SRFI date/time library"
- ;; check for typos and silly errors
- (pass-if "date-zone-offset is defined"
- (and (defined? 'date-zone-offset)
- date-zone-offset
- #t))
- (pass-if "add-duration is defined"
- (and (defined? 'add-duration)
- add-duration
- #t))
- (pass-if "(current-time time-tai) works"
- (begin (current-time time-tai) #t))
- (test-time-conversion time-utc time-tai)
- (test-time-conversion time-utc time-monotonic)
- (test-time-conversion time-tai time-monotonic)
- (pass-if "string->date works"
- (begin (string->date "2001-06-01@14:00" "~Y-~m-~d@~H:~M")
- #t))
- ;; check for code paths where reals were passed to quotient, which
- ;; doesn't work in Guile (and is unspecified in R5RS)
- (test-time->date time-utc->date date->time-utc)
- (test-time->date time-tai->date date->time-tai)
- (test-time->date time-monotonic->date date->time-monotonic)
- (pass-if "Fractional nanoseconds are handled"
- (begin (make-time time-duration 1000000000.5 0) #t))
- ;; the seconds in a time shall be maintained as integers, or
- ;; precision may silently go away
- (test-integral-time-structure date->time-utc)
- (test-integral-time-structure date->time-tai)
- (test-integral-time-structure date->time-monotonic)
- ;; check for DST and zone related problems
- (pass-if "date->time-utc is the inverse of time-utc->date"
- (let ((time (date->time-utc
- (make-date 0 0 0 14 1 6 2001 7200))))
- (time=? time
- (date->time-utc (time-utc->date time 7200)))))
- (test-dst time-utc->date date->time-utc)
- (test-dst time-tai->date date->time-tai)
- (test-dst time-monotonic->date date->time-monotonic)
- (test-dst julian-day->date date->julian-day)
- (test-dst modified-julian-day->date date->modified-julian-day)
- (pass-if "string->date respects local DST if no time zone is read"
- (time=? (date->time-utc
- (with-tz "CET"
- (string->date "2001-06-01@14:00" "~Y-~m-~d@~H:~M")))
- (date->time-utc
- (make-date 0 0 0 12 1 6 2001 0))))
- ;; check time comparison procedures
- (let* ((time1 (make-time time-monotonic 0 0))
- (time2 (make-time time-monotonic 0 0))
- (time3 (make-time time-monotonic 385907 998360432))
- (time4 (make-time time-monotonic 385907 998360432)))
- (test-time-comparison time<=? time1 time3)
- (test-time-comparison time<? time1 time3)
- (test-time-comparison time=? time1 time2)
- (test-time-comparison time>=? time3 time3)
- (test-time-comparison time>? time3 time2))
- ;; check time arithmetic procedures
- (let* ((time1 (make-time time-monotonic 0 0))
- (time2 (make-time time-monotonic 385907 998360432))
- (diff (time-difference time2 time1)))
- (test-time-arithmetic add-duration time1 diff time2)
- (test-time-arithmetic subtract-duration time2 diff time1)))
-
-;; Local Variables:
-;; eval: (put 'with-tz 'scheme-indent-function 1)
-;; End: