Revert "Fix bound-identifier=? to compare binding names, not just symbolic names."

[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 33e667c..8819c4f 100644 (file)
--- a/test-suite/tests/srfi-19.test
+++ b/test-suite/tests/srfi-19.test
@@ -1,22 +1,22 @@
 ;;;; srfi-19.test --- test suite for SRFI-19 -*- scheme -*-
 ;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001
 ;;;;
-;;;;   Copyright (C) 2001, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2007, 2008,
+;;;;   2011 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 library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;;
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library 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.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser 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., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to 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.
@@ -37,11 +37,11 @@ value and call THUNK."
     (dynamic-wind
        (lambda ()
          (set! old-tz (getenv "TZ"))
-         (putenv (format "TZ=~A" tz)))
+         (putenv (format #f "TZ=~A" tz)))
        thunk
        (lambda ()
          (if old-tz
-             (putenv (format "TZ=~A" old-tz))
+             (putenv (format #f "TZ=~A" old-tz))
              (putenv "TZ"))))))
 
 (defmacro with-tz (tz . body)
@@ -53,20 +53,20 @@ 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"
+  (pass-if (format #f "~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"
+  (pass-if (format #f "~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"
+  (pass-if (format #f "~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 4 hours zone offset
@@ -79,7 +79,7 @@ incomplete numerical tower implementation.)"
 (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"
+    `(pass-if (format #f "~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)))))))
@@ -109,7 +109,9 @@ incomplete numerical tower implementation.)"
                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)
@@ -139,6 +141,12 @@ incomplete numerical tower implementation.)"
   (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 "`date->julian-day' honors timezone"
+    (let ((now (current-date -14400)))
+      (time=? (date->time-utc (julian-day->date (date->julian-day now)))
+              (date->time-utc now))))
+
   (pass-if "string->date respects local DST if no time zone is read"
           (time=? (date->time-utc
                    (with-tz "EST5EDT"
@@ -158,6 +166,14 @@ incomplete numerical tower implementation.)"
                                                 0)))
                    (date->time-utc
                     (make-date 0 0 0 0 9 12 2006 0))))
+
+  (pass-if "string->date works on Sunday"
+    ;; `string->date' never rests!
+    (let* ((str  "Sun, 05 Jun 2005 18:33:00 +0200")
+           (date (string->date str "~a, ~d ~b ~Y ~H:~M:~S ~z")))
+      (equal? "Sun Jun 05 18:33:00+0200 2005"
+              (date->string date))))
+
   ;; check time comparison procedures
   (let* ((time1 (make-time time-monotonic 0 0))
          (time2 (make-time time-monotonic 0 0))