Commit | Line | Data |
fc003d4b |
1 | #!./perl -w |
8d063cd8 |
2 | |
a8c5b3cc |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | require './test.pl'; |
26575770 |
7 | } |
8 | |
7eb4f9b7 |
9 | plan tests => 66; |
8d063cd8 |
10 | |
ea4c52f0 |
11 | # These tests make sure, among other things, that we don't end up |
12 | # burning tons of CPU for dates far in the future. |
13 | # watchdog() makes sure that the test script eventually exits if |
14 | # the tests are triggering the failing behavior |
15 | watchdog(15); |
16 | |
8d063cd8 |
17 | ($beguser,$begsys) = times; |
18 | |
19 | $beg = time; |
20 | |
463ee0b2 |
21 | while (($now = time) == $beg) { sleep 1 } |
8d063cd8 |
22 | |
26575770 |
23 | ok($now > $beg && $now - $beg < 10, 'very basic time test'); |
8d063cd8 |
24 | |
5f80d426 |
25 | for ($i = 0; $i < 1_000_000; $i++) { |
584ba4d5 |
26 | for my $j (1..100) {}; # burn some user cycles |
8d063cd8 |
27 | ($nowuser, $nowsys) = times; |
5f80d426 |
28 | $i = 2_000_000 if $nowuser > $beguser && ( $nowsys >= $begsys || |
a0d0e21e |
29 | (!$nowsys && !$begsys)); |
8d063cd8 |
30 | last if time - $beg > 20; |
31 | } |
32 | |
5f80d426 |
33 | ok($i >= 2_000_000, 'very basic times test'); |
8d063cd8 |
34 | |
35 | ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($beg); |
36 | ($xsec,$foo) = localtime($now); |
37 | $localyday = $yday; |
38 | |
fc003d4b |
39 | isnt($sec, $xsec, 'localtime() list context'); |
40 | ok $mday, ' month day'; |
41 | ok $year, ' year'; |
26575770 |
42 | |
43 | ok(localtime() =~ /^(Sun|Mon|Tue|Wed|Thu|Fri|Sat)[ ] |
44 | (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ] |
45 | ([ \d]\d)\ (\d\d):(\d\d):(\d\d)\ (\d{4})$ |
46 | /x, |
47 | 'localtime(), scalar context' |
48 | ); |
8d063cd8 |
49 | |
a8c5b3cc |
50 | SKIP: { |
51 | # This conditional of "No tzset()" is stolen from ext/POSIX/t/time.t |
52 | skip "No tzset()", 1 |
7b903762 |
53 | if $^O eq "VMS" || $^O eq "cygwin" || |
a8c5b3cc |
54 | $^O eq "djgpp" || $^O eq "MSWin32" || $^O eq "dos" || |
55 | $^O eq "interix"; |
56 | |
8572b25d |
57 | # check that localtime respects changes to $ENV{TZ} |
58 | $ENV{TZ} = "GMT-5"; |
59 | ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($beg); |
60 | $ENV{TZ} = "GMT+5"; |
61 | ($sec,$min,$hour2,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($beg); |
62 | ok($hour != $hour2, 'changes to $ENV{TZ} respected'); |
a8c5b3cc |
63 | } |
8572b25d |
64 | |
a0d0e21e |
65 | |
8d063cd8 |
66 | ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($beg); |
67 | ($xsec,$foo) = localtime($now); |
68 | |
fc003d4b |
69 | isnt($sec, $xsec, 'gmtime() list conext'); |
70 | ok $mday, ' month day'; |
71 | ok $year, ' year'; |
26575770 |
72 | |
73 | my $day_diff = $localyday - $yday; |
74 | ok( grep({ $day_diff == $_ } (0, 1, -1, 364, 365, -364, -365)), |
75 | 'gmtime() and localtime() agree what day of year'); |
8d063cd8 |
76 | |
f5a29b03 |
77 | |
78 | # This could be stricter. |
26575770 |
79 | ok(gmtime() =~ /^(Sun|Mon|Tue|Wed|Thu|Fri|Sat)[ ] |
80 | (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ] |
81 | ([ \d]\d)\ (\d\d):(\d\d):(\d\d)\ (\d{4})$ |
82 | /x, |
83 | 'gmtime(), scalar context' |
84 | ); |
a272e669 |
85 | |
86 | |
87 | |
88 | # Test gmtime over a range of times. |
89 | { |
d95a2ea5 |
90 | # The range should be limited only by the 53-bit mantissa of an IEEE double (or |
91 | # whatever kind of double you've got). Here we just prove that we're comfortably |
92 | # beyond the range possible with 32-bit time_t. |
a272e669 |
93 | my %tests = ( |
94 | # time_t gmtime list scalar |
461d5a49 |
95 | -2**35 => [52, 13, 20, 7, 2, -1019, 5, 65, 0, "Fri Mar 7 20:13:52 881"], |
96 | -2**32 => [44, 31, 17, 24, 10, -67, 0, 327, 0, "Sun Nov 24 17:31:44 1833"], |
97 | -2**31 => [52, 45, 20, 13, 11, 1, 5, 346, 0, "Fri Dec 13 20:45:52 1901"], |
98 | -1 => [59, 59, 23, 31, 11, 69, 3, 364, 0, "Wed Dec 31 23:59:59 1969"], |
99 | 0 => [0, 0, 0, 1, 0, 70, 4, 0, 0, "Thu Jan 1 00:00:00 1970"], |
100 | 1 => [1, 0, 0, 1, 0, 70, 4, 0, 0, "Thu Jan 1 00:00:01 1970"], |
101 | 2**30 => [4, 37, 13, 10, 0, 104, 6, 9, 0, "Sat Jan 10 13:37:04 2004"], |
102 | 2**31 => [8, 14, 3, 19, 0, 138, 2, 18, 0, "Tue Jan 19 03:14:08 2038"], |
103 | 2**32 => [16, 28, 6, 7, 1, 206, 0, 37, 0, "Sun Feb 7 06:28:16 2106"], |
104 | 2**39 => [8, 18, 12, 25, 0, 17491, 2, 24, 0, "Tue Jan 25 12:18:08 19391"], |
a272e669 |
105 | ); |
106 | |
107 | for my $time (keys %tests) { |
108 | my @expected = @{$tests{$time}}; |
109 | my $scalar = pop @expected; |
110 | |
111 | ok eq_array([gmtime($time)], \@expected), "gmtime($time) list context"; |
112 | is scalar gmtime($time), $scalar, " scalar"; |
113 | } |
114 | } |
115 | |
116 | |
117 | # Test localtime |
118 | { |
119 | # We pick times which fall in the middle of a month, so the month and year should be |
120 | # the same regardless of the time zone. |
121 | my %tests = ( |
122 | # time_t month, year, scalar |
461d5a49 |
123 | -8589934592 => [9, -203, qr/Oct \d+ .* 1697$/], |
124 | -1296000 => [11, 69, qr/Dec \d+ .* 1969$/], |
125 | 1296000 => [0, 70, qr/Jan \d+ .* 1970$/], |
126 | 5000000000 => [5, 228, qr/Jun \d+ .* 2128$/], |
127 | 1163500000 => [10, 106, qr/Nov \d+ .* 2006$/], |
a272e669 |
128 | ); |
129 | |
130 | for my $time (keys %tests) { |
131 | my @expected = @{$tests{$time}}; |
132 | my $scalar = pop @expected; |
133 | |
4c91ace1 |
134 | my @time = (localtime($time))[4,5]; |
135 | ok( eq_array(\@time, \@expected), "localtime($time) list context" ) |
136 | or diag("@time"); |
a272e669 |
137 | like scalar localtime($time), $scalar, " scalar"; |
138 | } |
a8c5b3cc |
139 | } |
43eb9815 |
140 | |
141 | # Test floating point args |
142 | { |
143 | eval { |
144 | $SIG{__WARN__} = sub { die @_; }; |
fc003d4b |
145 | is( (localtime(1296000.23))[5] + 1900, 1970 ); |
43eb9815 |
146 | }; |
147 | is($@, '', 'Ignore fractional time'); |
148 | eval { |
149 | $SIG{__WARN__} = sub { die @_; }; |
fc003d4b |
150 | is( (gmtime(1.23))[5] + 1900, 1970 ); |
43eb9815 |
151 | }; |
152 | is($@, '', 'Ignore fractional time'); |
153 | } |
e66590ee |
154 | |
155 | |
156 | # Some sanity tests for the far, far future and far, far past |
157 | { |
158 | my %time2year = ( |
159 | -2**52 => -142711421, |
160 | -2**48 => -8917617, |
161 | -2**46 => -2227927, |
162 | 2**46 => 2231866, |
163 | 2**48 => 8921556, |
164 | 2**52 => 142715360, |
165 | ); |
166 | |
167 | for my $time (sort keys %time2year) { |
168 | my $want = $time2year{$time}; |
169 | |
170 | my $have = (gmtime($time))[5] + 1900; |
171 | is $have, $want, "year check, gmtime($time)"; |
172 | |
173 | $have = (localtime($time))[5] + 1900; |
174 | is $have, $want, "year check, localtime($time)"; |
175 | } |
176 | } |
fc003d4b |
177 | |
178 | |
179 | # Test that Perl warns properly when it can't handle a time. |
180 | { |
181 | my $warning; |
182 | local $SIG{__WARN__} = sub { $warning .= join "\n", @_; }; |
183 | |
184 | my $big_time = 2**60; |
185 | my $small_time = -2**60; |
186 | |
187 | $warning = ''; |
188 | my $date = gmtime($big_time); |
189 | like $warning, qr/^gmtime(.*) too large/; |
190 | |
191 | $warning = ''; |
192 | $date = localtime($big_time); |
193 | like $warning, qr/^localtime(.*) too large/; |
194 | |
195 | $warning = ''; |
196 | $date = gmtime($small_time); |
197 | like $warning, qr/^gmtime(.*) too small/; |
198 | |
199 | $warning = ''; |
200 | $date = localtime($small_time); |
201 | like $warning, qr/^localtime(.*) too small/; |
202 | } |
7eb4f9b7 |
203 | |
204 | SKIP: { #rt #73040 |
205 | # these are from the definitions of TIME_LOWER_BOUND AND TIME_UPPER_BOUND |
206 | my $smallest = -67768100567755200.0; |
207 | my $biggest = 67767976233316800.0; |
208 | |
209 | # offset to a value that will fail |
210 | my $small_time = $smallest - 200; |
211 | my $big_time = $biggest + 200; |
212 | |
213 | # check they're representable - typically means NV is |
214 | # long double |
215 | if ($small_time + 200 != $smallest |
216 | || $small_time == $smallest |
217 | || $big_time - 200 != $biggest |
218 | || $big_time == $biggest) { |
219 | skip "Can't represent test values", 4; |
220 | } |
221 | my $small_time_f = sprintf("%.0f", $small_time); |
222 | my $big_time_f = sprintf("%.0f", $big_time); |
223 | |
224 | # check the numbers in the warning are correct |
225 | my $warning; |
226 | local $SIG{__WARN__} = sub { $warning .= join "\n", @_; }; |
227 | $warning = ''; |
228 | my $date = gmtime($big_time); |
229 | like $warning, qr/^gmtime\($big_time_f\) too large/; |
230 | |
231 | $warning = ''; |
232 | $date = localtime($big_time); |
233 | like $warning, qr/^localtime\($big_time_f\) too large/; |
234 | |
235 | $warning = ''; |
236 | $date = gmtime($small_time); |
237 | like $warning, qr/^gmtime\($small_time_f\) too small/; |
238 | |
239 | $warning = ''; |
240 | $date = localtime($small_time); |
241 | like $warning, qr/^localtime\($small_time_f\) too small/; |
242 | |
243 | } |