diff options
Diffstat (limited to 'test-suite/tests/srfi-19.test')
-rw-r--r-- | test-suite/tests/srfi-19.test | 157 |
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: |