1 ;;;; time.test --- test suite for Guile's time functions -*- scheme -*-
2 ;;;; Jim Blandy <jimb@red-bean.com> --- June 1999, 2004
4 ;;;; Copyright (C) 1999, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
6 ;;;; This library is free software; you can redistribute it and/or
7 ;;;; modify it under the terms of the GNU Lesser General Public
8 ;;;; License as published by the Free Software Foundation; either
9 ;;;; version 3 of the License, or (at your option) any later version.
11 ;;;; This library is distributed in the hope that it will be useful,
12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;;;; Lesser General Public License for more details.
16 ;;;; You should have received a copy of the GNU Lesser General Public
17 ;;;; License along with this library; if not, write to the Free Software
18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20 (define-module (test-suite test-time)
21 #:use-module (test-suite lib)
22 #:use-module (ice-9 threads))
28 (with-test-prefix "gmtime"
31 (pass-if (list "in another thread after error" t)
32 (or (provided? 'threads) (throw 'unsupported))
35 (false-if-exception (gmtime t))
36 (join-thread (begin-thread (catch #t
37 (lambda () (gmtime t))
42 ;; time values that might provoke an error from libc
43 ;; on 32-bit glibc all values (which fit) are fine
44 ;; on 64-bit glibc apparently 2^63 can overflow a 32-bit tm_year
45 (list (1- (ash 1 31)) (1- (ash 1 63))
46 -1 (- (ash 1 31)) (- (ash 1 63)))))
49 ;;; internal-time-units-per-second
52 (with-test-prefix "internal-time-units-per-second"
54 ;; Check that sleep 1 gives about internal-time-units-per-second worth of
55 ;; elapsed time from times:clock. This mainly ensures
56 ;; internal-time-units-per-second correctly indicates CLK_TCK units.
58 (pass-if "versus times and sleep"
59 (or (defined? 'times) (throw 'unsupported))
64 (elapsed (- (tms:clock new) (tms:clock old))))
65 (<= (* 0.5 internal-time-units-per-second)
67 (* 2 internal-time-units-per-second))))))
73 (with-test-prefix "localtime"
75 ;; gmtoff is calculated with some explicit code, try to exercise that
76 ;; here, looking at cases where the localtime and gmtime are within the same
77 ;; day, or crossing midnight, or crossing new year
79 (pass-if "gmtoff of EST+5 at GMT 10:00am on 10 Jan 2000"
80 (let ((tm (gmtime 0)))
85 (let* ((t (car (mktime tm "GMT")))
86 (tm (localtime t "EST+5")))
87 (eqv? (* 5 3600) (tm:gmtoff tm)))))
89 ;; crossing forward over day boundary
90 (pass-if "gmtoff of EST+5 at GMT 3am on 10 Jan 2000"
91 (let ((tm (gmtime 0)))
96 (let* ((t (car (mktime tm "GMT")))
97 (tm (localtime t "EST+5")))
98 (eqv? (* 5 3600) (tm:gmtoff tm)))))
100 ;; crossing backward over day boundary
101 (pass-if "gmtoff of AST-10 at GMT 10pm on 10 Jan 2000"
102 (let ((tm (gmtime 0)))
107 (let* ((t (car (mktime tm "GMT")))
108 (tm (localtime t "AST-10")))
109 (eqv? (* -10 3600) (tm:gmtoff tm)))))
111 ;; crossing forward over year boundary
112 (pass-if "gmtoff of EST+5 at GMT 3am on 1 Jan 2000"
113 (let ((tm (gmtime 0)))
118 (let* ((t (car (mktime tm "GMT")))
119 (tm (localtime t "EST+5")))
120 (eqv? (* 5 3600) (tm:gmtoff tm)))))
122 ;; crossing backward over day boundary
123 (pass-if "gmtoff of AST-10 at GMT 10pm on 31 Dec 2000"
124 (let ((tm (gmtime 0)))
129 (let* ((t (car (mktime tm "GMT")))
130 (tm (localtime t "AST-10")))
131 (eqv? (* -10 3600) (tm:gmtoff tm))))))
137 (with-test-prefix "mktime"
139 ;; gmtoff is calculated with some explicit code, try to exercise that
140 ;; here, looking at cases where the mktime and gmtime are within the same
141 ;; day, or crossing midnight, or crossing new year
143 (pass-if "gmtoff of EST+5 at 10:00am on 10 Jan 2000"
144 (let ((tm (gmtime 0)))
149 (let ((tm (cdr (mktime tm "EST+5"))))
150 (eqv? (* 5 3600) (tm:gmtoff tm)))))
152 ;; crossing forward over day boundary
153 (pass-if "gmtoff of EST+5 at 10:00pm on 10 Jan 2000"
154 (let ((tm (gmtime 0)))
159 (let ((tm (cdr (mktime tm "EST+5"))))
160 (eqv? (* 5 3600) (tm:gmtoff tm)))))
162 ;; crossing backward over day boundary
163 (pass-if "gmtoff of AST-10 at 3:00am on 10 Jan 2000"
164 (let ((tm (gmtime 0)))
169 (let ((tm (cdr (mktime tm "AST-10"))))
170 (eqv? (* -10 3600) (tm:gmtoff tm)))))
172 ;; crossing forward over year boundary
173 (pass-if "gmtoff of EST+5 at 10:00pm on 31 Dec 2000"
174 (let ((tm (gmtime 0)))
179 (let ((tm (cdr (mktime tm "EST+5"))))
180 (eqv? (* 5 3600) (tm:gmtoff tm)))))
182 ;; crossing backward over day boundary
183 (pass-if "gmtoff of AST-10 at 3:00am on 1 Jan 2000"
184 (let ((tm (gmtime 0)))
189 (let ((tm (cdr (mktime tm "AST-10"))))
190 (eqv? (* -10 3600) (tm:gmtoff tm))))))
196 (with-test-prefix "strftime"
198 (pass-if "strftime %Z doesn't return garbage"
199 (let ((t (localtime (current-time))))
200 (set-tm:zone t "ZOW")
202 (string=? (strftime "%Z" t)
205 (pass-if "strftime passes wide characters"
206 (let ((t (localtime (current-time))))
207 (string=? (substring (strftime "\u0100%Z" t) 0 1)
210 (with-test-prefix "C99 %z format"
212 ;; %z here is quite possibly affected by the same tm:gmtoff vs current
213 ;; zone as %Z above is, so in the following tests we make them the same.
218 (let ((tm (localtime 86400)))
219 (string=? "+0000" (strftime "%z" tm))))
221 ;; prior to guile 1.6.9 and 1.8.1 this test failed, getting "+0500",
222 ;; because we didn't adjust for tm:gmtoff being west of Greenwich versus
223 ;; tm_gmtoff being east of Greenwich
227 (let ((tm (localtime 86400)))
228 (string=? "-0500" (strftime "%z" tm))))))
234 (with-test-prefix "strptime"
236 (pass-if "in another thread after error"
237 (or (defined? 'strptime) (throw 'unsupported))
238 (or (provided? 'threads) (throw 'unsupported))
242 (strptime "%a" "nosuchday"))
243 (join-thread (begin-thread (strptime "%d" "1")))
247 (with-test-prefix "GNU %s format"
249 ;; "%s" to parse a count of seconds since 1970 is a GNU extension
250 (define have-strptime-%s
251 (false-if-exception (strptime "%s" "0")))
253 (pass-if "gmtoff on GMT"
254 (or have-strptime-%s (throw 'unsupported))
257 (let ((tm (car (strptime "%s" "86400"))))
258 (eqv? 0 (tm:gmtoff tm))))
260 ;; prior to guile 1.6.9 and 1.8.1 we didn't pass tm_gmtoff back from
262 (pass-if "gmtoff on EST+5"
263 (or have-strptime-%s (throw 'unsupported))
266 (let ((tm (car (strptime "%s" "86400"))))
267 (eqv? (* 5 3600) (tm:gmtoff tm))))))