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 | ;;;; |
6e7d5622 | 4 | ;;;; Copyright (C) 1999, 2004, 2006 Free Software Foundation, Inc. |
90612863 JB |
5 | ;;;; |
6 | ;;;; This program is free software; you can redistribute it and/or modify | |
7 | ;;;; it under the terms of the GNU General Public License as published by | |
8 | ;;;; the Free Software Foundation; either version 2, or (at your option) | |
9 | ;;;; any later version. | |
10 | ;;;; | |
11 | ;;;; This program 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 | |
14 | ;;;; GNU General Public License for more details. | |
15 | ;;;; | |
16 | ;;;; You should have received a copy of the GNU General Public License | |
17 | ;;;; along with this software; see the file COPYING. If not, write to | |
92205699 MV |
18 | ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
19 | ;;;; Boston, MA 02110-1301 USA | |
90612863 | 20 | |
c59e0b9f KR |
21 | (define-module (test-suite test-time) |
22 | #:use-module (test-suite lib) | |
23 | #:use-module (ice-9 threads)) | |
24 | ||
25 | ;;; | |
26 | ;;; gmtime | |
27 | ;;; | |
28 | ||
29 | (with-test-prefix "gmtime" | |
30 | ||
31 | (for-each (lambda (t) | |
32 | (pass-if (list "in another thread after error" t) | |
33 | (or (provided? 'threads) (throw 'unsupported)) | |
34 | ||
35 | ;; actually this test is perfectly good, but the "internal | |
36 | ;; define - missing body expression" in syntax.test somehow | |
37 | ;; ends up leaving SCM_DEFER_INTS, making the test here hang | |
38 | ;; | |
39 | (throw 'unresolved) | |
40 | ||
41 | (alarm 5) | |
42 | (false-if-exception (gmtime t)) | |
a64d0589 MV |
43 | (thread-join (begin-thread (catch 'out-of-range |
44 | (lambda () (gmtime t)) | |
45 | (lambda args #f)))) | |
c59e0b9f KR |
46 | (alarm 0) |
47 | #t)) | |
48 | ||
49 | ;; time values that might provoke an error from libc | |
50 | ;; on 32-bit glibc all values (which fit) are fine | |
51 | ;; on 64-bit glibc apparently 2^63 can overflow a 32-bit tm_year | |
52 | (list (1- (ash 1 31)) (1- (ash 1 63)) | |
53 | -1 (- (ash 1 31)) (- (ash 1 63))))) | |
54 | ||
55 | ;;; | |
56 | ;;; internal-time-units-per-second | |
57 | ;;; | |
58 | ||
59 | (with-test-prefix "internal-time-units-per-second" | |
60 | ||
61 | ;; Check that sleep 1 gives about internal-time-units-per-second worth of | |
62 | ;; elapsed time from times:clock. This mainly ensures | |
63 | ;; internal-time-units-per-second correctly indicates CLK_TCK units. | |
64 | ;; | |
65 | (pass-if "versus times and sleep" | |
66 | (or (defined? 'times) (throw 'unsupported)) | |
67 | ||
68 | (let ((old (times))) | |
69 | (sleep 1) | |
70 | (let* ((new (times)) | |
71 | (elapsed (- (tms:clock new) (tms:clock old)))) | |
72 | (<= (* 0.5 internal-time-units-per-second) | |
73 | elapsed | |
74 | (* 2 internal-time-units-per-second)))))) | |
90612863 | 75 | |
feb3640d KR |
76 | ;;; |
77 | ;;; strftime | |
78 | ;;; | |
79 | ||
80 | ;; Note we must force isdst to get the ZOW zone name out of %Z on HP-UX. | |
81 | ;; If localtime is in daylight savings then it will decide there's no | |
82 | ;; daylight savings zone name for the fake ZOW, and come back empty. | |
83 | ;; | |
9f4e29f6 KR |
84 | ;; This test is disabled because on NetBSD %Z doesn't look at the tm_zone |
85 | ;; field in struct tm passed by guile. That behaviour is reasonable enough | |
86 | ;; since that field is not in C99 so a C99 program won't know it has to be | |
87 | ;; set. For the details on that see | |
88 | ;; | |
89 | ;; http://www.netbsd.org/cgi-bin/query-pr-single.pl?number=21722 | |
90 | ;; | |
91 | ;; Not sure what to do about this in guile, it'd be nice for %Z to look at | |
92 | ;; tm:zone everywhere. | |
93 | ;; | |
94 | ;; | |
95 | ;; (pass-if "strftime %Z doesn't return garbage" | |
96 | ;; (let ((t (localtime (current-time)))) | |
97 | ;; (set-tm:zone t "ZOW") | |
98 | ;; (set-tm:isdst t 0) | |
99 | ;; (string=? (strftime "%Z" t) | |
100 | ;; "ZOW"))) | |
c59e0b9f KR |
101 | |
102 | ;;; | |
103 | ;;; strptime | |
104 | ;;; | |
105 | ||
106 | (with-test-prefix "strptime" | |
107 | ||
108 | (pass-if "in another thread after error" | |
109 | (or (defined? 'strptime) (throw 'unsupported)) | |
110 | (or (provided? 'threads) (throw 'unsupported)) | |
111 | ||
112 | ;; actually this test is perfectly good, but the "internal define - | |
113 | ;; missing body expression" in syntax.test somehow ends up leaving | |
114 | ;; SCM_DEFER_INTS, making the test here hang | |
115 | ;; | |
116 | (throw 'unresolved) | |
117 | ||
118 | (alarm 5) | |
119 | (false-if-exception | |
120 | (strptime "%a" "nosuchday")) | |
a64d0589 | 121 | (thread-join (begin-thread (strptime "%d" "1"))) |
c59e0b9f KR |
122 | (alarm 0) |
123 | #t)) |