1#!perl -w 2 3BEGIN { 4 unshift @INC, "../../t"; 5 require 'loc_tools.pl'; 6} 7 8use strict; 9 10use Config; 11use POSIX; 12use Test::More tests => 30; 13 14# For the first go to UTC to avoid DST issues around the world when testing. SUS3 says that 15# null should get you UTC, but some environments want the explicit names. 16# Those with a working tzset() should be able to use the TZ below. 17$ENV{TZ} = "EST5EDT"; 18 19SKIP: { 20 # It looks like POSIX.xs claims that only VMS and Mac OS traditional 21 # don't have tzset(). Win32 works to call the function, but it doesn't 22 # actually do anything. Cygwin works in some places, but not others. The 23 # other Win32's below are guesses. 24 skip "No tzset()", 1 25 if $^O eq "VMS" || $^O eq "cygwin" || 26 $^O eq "MSWin32" || $^O eq "interix"; 27 tzset(); 28 SKIP: { 29 my @tzname = tzname(); 30 31 # See extensive discussion in GH #22062. 32 skip 1 if $tzname[1] ne "EDT"; 33 is(strftime("%Y-%m-%d %H:%M:%S", 0, 30, 2, 10, 2, 124, 0, 0, 0), 34 "2024-03-10 02:30:00", 35 "strftime() doesnt pay attention to dst"); 36 } 37} 38 39# go to UTC to avoid DST issues around the world when testing. SUS3 says that 40# null should get you UTC, but some environments want the explicit names. 41# Those with a working tzset() should be able to use the TZ below. 42$ENV{TZ} = "UTC0UTC"; 43 44SKIP: { 45 skip "No tzset()", 2 46 if $^O eq "VMS" || $^O eq "cygwin" || 47 $^O eq "MSWin32" || $^O eq "interix"; 48 tzset(); 49 my @tzname = tzname(); 50 like($tzname[0], qr/(GMT|UTC)/i, "tzset() to GMT/UTC"); 51 SKIP: { 52 skip "Mac OS X/Darwin doesn't handle this", 1 if $^O =~ /darwin/i; 53 like($tzname[1], qr/(GMT|UTC)/i, "The whole year?"); 54 } 55} 56 57if ($^O eq "hpux" && $Config{osvers} >= 11.3) { 58 # HP does not support UTC0UTC and/or GMT0GMT, as they state that this is 59 # legal syntax but as it has no DST rule, it cannot be used. That is the 60 # conclusion of bug 61 # QXCR1000896916: Some timezone valuesfailing on 11.31 that work on 11.23 62 $ENV{TZ} = "UTC"; 63} 64 65# asctime and ctime...Let's stay below INT_MAX for 32-bits and 66# positive for some picky systems. 67 68is(asctime(CORE::localtime(0)), ctime(0), "asctime() and ctime() at zero"); 69is(asctime(POSIX::localtime(0)), ctime(0), "asctime() and ctime() at zero"); 70is(asctime(CORE::localtime(12345678)), ctime(12345678), 71 "asctime() and ctime() at 12345678"); 72is(asctime(POSIX::localtime(12345678)), ctime(12345678), 73 "asctime() and ctime() at 12345678"); 74 75my $illegal_format = "%!"; 76 77# An illegal format could result in an empty result, but many platforms just 78# pass it through, or strip off the '%' 79sub munge_illegal_format_result($) { 80 my $result = shift; 81 $result = "" if $result eq $illegal_format || $result eq '!'; 82 return $result; 83} 84 85my $jan_16 = 15 * 86400; 86 87is(munge_illegal_format_result(strftime($illegal_format, 88 CORE::localtime($jan_16))), 89 "", "strftime returns appropriate result for an illegal format"); 90 91# Careful! strftime() is locale sensitive. Let's take care of that 92my $orig_time_loc = 'C'; 93 94my $LC_TIME_enabled = locales_enabled('LC_TIME'); 95if ($LC_TIME_enabled) { 96 $orig_time_loc = setlocale(LC_TIME) || die "Cannot get time locale information: $!"; 97 setlocale(LC_TIME, "C") || die "Cannot setlocale() to C: $!"; 98} 99 100my $ctime_format = "%a %b %d %H:%M:%S %Y\n"; 101is(ctime($jan_16), strftime($ctime_format, CORE::localtime($jan_16)), 102 "get ctime() equal to strftime()"); 103is(ctime($jan_16), strftime($ctime_format, POSIX::localtime($jan_16)), 104 "get localtime() equal to strftime()"); 105 106my $ss = chr 223; 107unlike($ss, qr/\w/, 'Not internally UTF-8 encoded'); 108is(ord strftime($ss, CORE::localtime), 223, 109 'Format string has correct character'); 110is(ord strftime($ss, POSIX::localtime(time)), 111 223, 'Format string has correct character'); 112unlike($ss, qr/\w/, 'Still not internally UTF-8 encoded'); 113 114my $zh_format = "%Y\x{5e74}%m\x{6708}%d\x{65e5}"; 115my $zh_expected_result = "1970\x{5e74}01\x{6708}16\x{65e5}"; 116isnt(strftime($zh_format, CORE::gmtime($jan_16)), 117 $zh_expected_result, 118 "strftime() UTF-8 format doesn't return UTF-8 in non-UTF-8 locale"); 119 120my $utf8_locale = find_utf8_ctype_locale(); 121SKIP: { 122 my $has_time_utf8_locale = ($LC_TIME_enabled && defined $utf8_locale); 123 if ($has_time_utf8_locale) { 124 my $time_utf8_locale = setlocale(LC_TIME, $utf8_locale); 125 126 # Some platforms don't allow LC_TIME to be changed to a UTF-8 locale, 127 # even if we have found one whose LC_CTYPE can be. The next two tests 128 # are invalid on such platforms. Check for that. (Examples include 129 # OpenBSD, and Alpine Linux without the add-on locales package 130 # installed.) 131 if ( ! defined $time_utf8_locale 132 || ! is_locale_utf8($time_utf8_locale)) 133 { 134 $has_time_utf8_locale = 0; 135 } 136 } 137 138 skip "No LC_TIME UTF-8 locale", 2 unless $has_time_utf8_locale; 139 140 # By setting LC_TIME only, we verify that the code properly handles the 141 # case where that and LC_CTYPE differ 142 is(strftime($zh_format, CORE::gmtime($jan_16)), 143 $zh_expected_result, 144 "strftime() can handle a UTF-8 format; LC_CTYPE != LCTIME"); 145 is(strftime($zh_format, POSIX::gmtime($jan_16)), 146 $zh_expected_result, 147 "Same, but uses POSIX::gmtime; previous test used CORE::"); 148 setlocale(LC_TIME, "C") || die "Cannot setlocale() to C: $!"; 149} 150 151my $non_C_locale = $utf8_locale; 152if (! defined $non_C_locale) { 153 my @locales = find_locales(LC_CTYPE); 154 while (@locales) { 155 if ($locales[0] ne "C") { 156 $non_C_locale = $locales[0]; 157 last; 158 } 159 160 shift @locales; 161 } 162} 163 164SKIP: { 165 skip "No non-C locale", 4 if ! locales_enabled(LC_CTYPE) 166 || ! defined $non_C_locale; 167 my $orig_ctype_locale = setlocale(LC_CTYPE) 168 || die "Cannot get ctype locale information: $!"; 169 setlocale(LC_CTYPE, $non_C_locale) 170 || die "Cannot setlocale(LC_CTYPE) to $non_C_locale: $!"; 171 172 is(ctime($jan_16), strftime($ctime_format, CORE::localtime($jan_16)), 173 "Repeat of ctime() equal to strftime()"); 174 is(setlocale(LC_CTYPE), $non_C_locale, "strftime restores LC_CTYPE"); 175 176 is(munge_illegal_format_result(strftime($illegal_format, 177 CORE::localtime($jan_16))), 178 "", "strftime returns appropriate result for an illegal format"); 179 is(setlocale(LC_CTYPE), $non_C_locale, 180 "strftime restores LC_CTYPE even on failure"); 181 182 setlocale(LC_CTYPE, $orig_ctype_locale) 183 || die "Cannot setlocale(LC_CTYPE) back to orig: $!"; 184} 185 186if ($LC_TIME_enabled) { 187 setlocale(LC_TIME, $orig_time_loc) 188 || die "Cannot setlocale(LC_TIME) back to orig: $!"; 189} 190 191# clock() seems to have different definitions of what it does between POSIX 192# and BSD. Cygwin, Win32, and Linux lean the BSD way. So, the tests just 193# check the basics. 194like(clock(), qr/\d*/, "clock() returns a numeric value"); 195cmp_ok(clock(), '>=', 0, "...and it returns something >= 0"); 196 197SKIP: { 198 skip "No difftime()", 1 if $Config{d_difftime} ne 'define'; 199 is(difftime(2, 1), 1, "difftime()"); 200} 201 202SKIP: { 203 skip "No mktime()", 2 if $Config{d_mktime} ne 'define'; 204 my $time = time(); 205 is(mktime(CORE::localtime($time)), $time, "mktime()"); 206 is(mktime(POSIX::localtime($time)), $time, "mktime()"); 207} 208 209{ 210 # GH #22498 211 is(strftime(42, CORE::localtime), '42', "strftime() works if format is a number"); 212 my $obj = bless {}, 'Some::Random::Class'; 213 is(strftime($obj, CORE::localtime), "$obj", "strftime() works if format is an object"); 214 my $warnings = ''; 215 local $SIG{__WARN__} = sub { $warnings .= $_[0] }; 216 is(strftime(undef, CORE::localtime), '', "strftime() works if format is undef"); 217 like($warnings, qr/^Use of uninitialized value in subroutine entry /, "strftime(undef, ...) produces expected warning"); 218} 219