Commit | Line | Data |
---|---|---|
90612863 | 1 | ;;;; time.test --- test suite for Guile's time functions -*- scheme -*- |
c59e0b9f | 2 | ;;;; Jim Blandy <jimb@red-bean.com> --- June 1999, 2004 |
90612863 | 3 | ;;;; |
69f23174 | 4 | ;;;; Copyright (C) 1999, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. |
90612863 | 5 | ;;;; |
53befeb7 NJ |
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. | |
90612863 | 10 | ;;;; |
53befeb7 | 11 | ;;;; This library is distributed in the hope that it will be useful, |
90612863 | 12 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
53befeb7 NJ |
13 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
14 | ;;;; Lesser General Public License for more details. | |
90612863 | 15 | ;;;; |
53befeb7 NJ |
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 | |
90612863 | 19 | |
c59e0b9f KR |
20 | (define-module (test-suite test-time) |
21 | #:use-module (test-suite lib) | |
22 | #:use-module (ice-9 threads)) | |
23 | ||
24 | ;;; | |
25 | ;;; gmtime | |
26 | ;;; | |
27 | ||
28 | (with-test-prefix "gmtime" | |
29 | ||
30 | (for-each (lambda (t) | |
31 | (pass-if (list "in another thread after error" t) | |
32 | (or (provided? 'threads) (throw 'unsupported)) | |
33 | ||
c59e0b9f KR |
34 | (alarm 5) |
35 | (false-if-exception (gmtime t)) | |
004be623 KR |
36 | (join-thread (begin-thread (catch #t |
37 | (lambda () (gmtime t)) | |
38 | (lambda args #f)))) | |
c59e0b9f KR |
39 | (alarm 0) |
40 | #t)) | |
41 | ||
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))))) | |
47 | ||
48 | ;;; | |
49 | ;;; internal-time-units-per-second | |
50 | ;;; | |
51 | ||
52 | (with-test-prefix "internal-time-units-per-second" | |
53 | ||
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. | |
57 | ;; | |
58 | (pass-if "versus times and sleep" | |
59 | (or (defined? 'times) (throw 'unsupported)) | |
60 | ||
61 | (let ((old (times))) | |
62 | (sleep 1) | |
63 | (let* ((new (times)) | |
64 | (elapsed (- (tms:clock new) (tms:clock old)))) | |
65 | (<= (* 0.5 internal-time-units-per-second) | |
66 | elapsed | |
67 | (* 2 internal-time-units-per-second)))))) | |
90612863 | 68 | |
8ab3d8a0 KR |
69 | ;;; |
70 | ;;; localtime | |
71 | ;;; | |
72 | ||
73 | (with-test-prefix "localtime" | |
74 | ||
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 | |
78 | ||
79 | (pass-if "gmtoff of EST+5 at GMT 10:00am on 10 Jan 2000" | |
80 | (let ((tm (gmtime 0))) | |
81 | (set-tm:hour tm 10) | |
82 | (set-tm:mday tm 10) | |
83 | (set-tm:mon tm 0) | |
84 | (set-tm:year tm 100) | |
85 | (let* ((t (car (mktime tm "GMT"))) | |
86 | (tm (localtime t "EST+5"))) | |
87 | (eqv? (* 5 3600) (tm:gmtoff tm))))) | |
88 | ||
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))) | |
92 | (set-tm:hour tm 3) | |
93 | (set-tm:mday tm 10) | |
94 | (set-tm:mon tm 0) | |
95 | (set-tm:year tm 100) | |
96 | (let* ((t (car (mktime tm "GMT"))) | |
97 | (tm (localtime t "EST+5"))) | |
98 | (eqv? (* 5 3600) (tm:gmtoff tm))))) | |
99 | ||
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))) | |
103 | (set-tm:hour tm 22) | |
104 | (set-tm:mday tm 10) | |
105 | (set-tm:mon tm 0) | |
106 | (set-tm:year tm 100) | |
107 | (let* ((t (car (mktime tm "GMT"))) | |
108 | (tm (localtime t "AST-10"))) | |
109 | (eqv? (* -10 3600) (tm:gmtoff tm))))) | |
110 | ||
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))) | |
114 | (set-tm:hour tm 3) | |
115 | (set-tm:mday tm 1) | |
116 | (set-tm:mon tm 0) | |
117 | (set-tm:year tm 100) | |
118 | (let* ((t (car (mktime tm "GMT"))) | |
119 | (tm (localtime t "EST+5"))) | |
120 | (eqv? (* 5 3600) (tm:gmtoff tm))))) | |
121 | ||
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))) | |
125 | (set-tm:hour tm 22) | |
126 | (set-tm:mday tm 31) | |
127 | (set-tm:mon tm 11) | |
128 | (set-tm:year tm 100) | |
129 | (let* ((t (car (mktime tm "GMT"))) | |
130 | (tm (localtime t "AST-10"))) | |
131 | (eqv? (* -10 3600) (tm:gmtoff tm)))))) | |
132 | ||
133 | ;;; | |
134 | ;;; mktime | |
135 | ;;; | |
136 | ||
137 | (with-test-prefix "mktime" | |
138 | ||
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 | |
142 | ||
143 | (pass-if "gmtoff of EST+5 at 10:00am on 10 Jan 2000" | |
144 | (let ((tm (gmtime 0))) | |
145 | (set-tm:hour tm 10) | |
146 | (set-tm:mday tm 10) | |
147 | (set-tm:mon tm 0) | |
148 | (set-tm:year tm 100) | |
149 | (let ((tm (cdr (mktime tm "EST+5")))) | |
150 | (eqv? (* 5 3600) (tm:gmtoff tm))))) | |
151 | ||
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))) | |
155 | (set-tm:hour tm 22) | |
156 | (set-tm:mday tm 10) | |
157 | (set-tm:mon tm 0) | |
158 | (set-tm:year tm 100) | |
159 | (let ((tm (cdr (mktime tm "EST+5")))) | |
160 | (eqv? (* 5 3600) (tm:gmtoff tm))))) | |
161 | ||
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))) | |
165 | (set-tm:hour tm 3) | |
166 | (set-tm:mday tm 10) | |
167 | (set-tm:mon tm 0) | |
168 | (set-tm:year tm 100) | |
169 | (let ((tm (cdr (mktime tm "AST-10")))) | |
170 | (eqv? (* -10 3600) (tm:gmtoff tm))))) | |
171 | ||
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))) | |
175 | (set-tm:hour tm 22) | |
176 | (set-tm:mday tm 31) | |
177 | (set-tm:mon tm 11) | |
178 | (set-tm:year tm 100) | |
179 | (let ((tm (cdr (mktime tm "EST+5")))) | |
180 | (eqv? (* 5 3600) (tm:gmtoff tm))))) | |
181 | ||
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))) | |
185 | (set-tm:hour tm 3) | |
186 | (set-tm:mday tm 1) | |
187 | (set-tm:mon tm 0) | |
188 | (set-tm:year tm 100) | |
189 | (let ((tm (cdr (mktime tm "AST-10")))) | |
190 | (eqv? (* -10 3600) (tm:gmtoff tm)))))) | |
191 | ||
feb3640d KR |
192 | ;;; |
193 | ;;; strftime | |
194 | ;;; | |
195 | ||
8ab3d8a0 KR |
196 | (with-test-prefix "strftime" |
197 | ||
69f23174 LC |
198 | (pass-if "strftime %Z doesn't return garbage" |
199 | (let ((t (localtime (current-time)))) | |
200 | (set-tm:zone t "ZOW") | |
201 | (set-tm:isdst t 0) | |
202 | (string=? (strftime "%Z" t) | |
203 | "ZOW"))) | |
8ab3d8a0 | 204 | |
587a3355 MG |
205 | (pass-if "strftime passes wide characters" |
206 | (let ((t (localtime (current-time)))) | |
207 | (string=? (substring (strftime "\u0100%Z" t) 0 1) | |
208 | "\u0100"))) | |
209 | ||
8ab3d8a0 KR |
210 | (with-test-prefix "C99 %z format" |
211 | ||
8ab3d8a0 KR |
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. | |
214 | ||
215 | (pass-if "GMT" | |
8ab3d8a0 KR |
216 | (putenv "TZ=GMT+0") |
217 | (tzset) | |
218 | (let ((tm (localtime 86400))) | |
219 | (string=? "+0000" (strftime "%z" tm)))) | |
220 | ||
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 | |
224 | (pass-if "EST+5" | |
8ab3d8a0 KR |
225 | (putenv "TZ=EST+5") |
226 | (tzset) | |
227 | (let ((tm (localtime 86400))) | |
228 | (string=? "-0500" (strftime "%z" tm)))))) | |
c59e0b9f KR |
229 | |
230 | ;;; | |
231 | ;;; strptime | |
232 | ;;; | |
233 | ||
234 | (with-test-prefix "strptime" | |
235 | ||
236 | (pass-if "in another thread after error" | |
237 | (or (defined? 'strptime) (throw 'unsupported)) | |
238 | (or (provided? 'threads) (throw 'unsupported)) | |
239 | ||
c59e0b9f KR |
240 | (alarm 5) |
241 | (false-if-exception | |
242 | (strptime "%a" "nosuchday")) | |
8ab3d8a0 | 243 | (join-thread (begin-thread (strptime "%d" "1"))) |
c59e0b9f | 244 | (alarm 0) |
8ab3d8a0 KR |
245 | #t) |
246 | ||
247 | (with-test-prefix "GNU %s format" | |
248 | ||
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"))) | |
252 | ||
253 | (pass-if "gmtoff on GMT" | |
254 | (or have-strptime-%s (throw 'unsupported)) | |
255 | (putenv "TZ=GMT+0") | |
256 | (tzset) | |
257 | (let ((tm (car (strptime "%s" "86400")))) | |
258 | (eqv? 0 (tm:gmtoff tm)))) | |
259 | ||
260 | ;; prior to guile 1.6.9 and 1.8.1 we didn't pass tm_gmtoff back from | |
261 | ;; strptime | |
262 | (pass-if "gmtoff on EST+5" | |
263 | (or have-strptime-%s (throw 'unsupported)) | |
264 | (putenv "TZ=EST+5") | |
265 | (tzset) | |
266 | (let ((tm (car (strptime "%s" "86400")))) | |
267 | (eqv? (* 5 3600) (tm:gmtoff tm)))))) |