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 | ;;;; |
feb3640d | 4 | ;;;; Copyright (C) 1999, 2004 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)) | |
43 | (future-ref (future (catch 'out-of-range | |
44 | (lambda () (gmtime t)) | |
45 | (lambda args #f)))) | |
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 | ;; | |
90612863 JB |
84 | (pass-if "strftime %Z doesn't return garbage" |
85 | (let ((t (localtime (current-time)))) | |
feb3640d KR |
86 | (set-tm:zone t "ZOW") |
87 | (set-tm:isdst t 0) | |
90612863 JB |
88 | (string=? (strftime "%Z" t) |
89 | "ZOW"))) | |
c59e0b9f KR |
90 | |
91 | ;;; | |
92 | ;;; strptime | |
93 | ;;; | |
94 | ||
95 | (with-test-prefix "strptime" | |
96 | ||
97 | (pass-if "in another thread after error" | |
98 | (or (defined? 'strptime) (throw 'unsupported)) | |
99 | (or (provided? 'threads) (throw 'unsupported)) | |
100 | ||
101 | ;; actually this test is perfectly good, but the "internal define - | |
102 | ;; missing body expression" in syntax.test somehow ends up leaving | |
103 | ;; SCM_DEFER_INTS, making the test here hang | |
104 | ;; | |
105 | (throw 'unresolved) | |
106 | ||
107 | (alarm 5) | |
108 | (false-if-exception | |
109 | (strptime "%a" "nosuchday")) | |
110 | (future-ref (future (strptime "%d" "1"))) | |
111 | (alarm 0) | |
112 | #t)) |