ext/POSIX/t/time.t

   1 #!perl -w
   2
   3 use strict;
   4
   5 use Config;
   6 use POSIX;
   7 use Test::More tests => 41;
   8
   9 # go to UTC to avoid DST issues around the world when testing.  SUS3 says that
  10 # null should get you UTC, but some environments want the explicit names.
  11 # Those with a working tzset() should be able to use the TZ below.
  12 $ENV{TZ} = "UTC0UTC";
  13
  14 SKIP: {
  15     # It looks like POSIX.xs claims that only VMS and Mac OS traditional
  16     # don't have tzset().  Win32 works to call the function, but it doesn't
  17     # actually do anything.  Cygwin works in some places, but not others.  The
  18     # other Win32's below are guesses.
  19     skip "No tzset()", 2
  20        if $^O eq "MacOS" || $^O eq "VMS" || $^O eq "cygwin" || $^O eq "djgpp" ||
  21           $^O eq "MSWin32" || $^O eq "dos" || $^O eq "interix";
  22     tzset();
  23     my @tzname = tzname();
  24     like($tzname[0], qr/(GMT|UTC)/i, "tzset() to GMT/UTC");
  25     SKIP: {
  26         skip "Mac OS X/Darwin doesn't handle this", 1 if $^O =~ /darwin/i;
  27         like($tzname[1], qr/(GMT|UTC)/i, "The whole year?");
  28     }
  29 }
  30
  31 if ($^O eq "hpux" && $Config{osvers} >= 11.3) {
  32     # HP does not support UTC0UTC and/or GMT0GMT, as they state that this is
  33     # legal syntax but as it has no DST rule, it cannot be used. That is the
  34     # conclusion of bug
  35     # QXCR1000896916: Some timezone valuesfailing on 11.31 that work on 11.23
  36     $ENV{TZ} = "UTC";
  37 }
  38
  39 # asctime and ctime...Let's stay below INT_MAX for 32-bits and
  40 # positive for some picky systems.
  41
  42 is(asctime(CORE::localtime(0)), ctime(0), "asctime() and ctime() at zero");
  43 is(asctime(POSIX::localtime(0)), ctime(0), "asctime() and ctime() at zero");
  44 is(asctime(CORE::localtime(12345678)), ctime(12345678),
  45    "asctime() and ctime() at 12345678");
  46 is(asctime(POSIX::localtime(12345678)), ctime(12345678),
  47    "asctime() and ctime() at 12345678");
  48
  49 # Careful!  strftime() is locale sensitive.  Let's take care of that
  50 my $orig_loc = setlocale(LC_TIME, "C") || die "Cannot setlocale() to C:  $!";
  51 my $jan_16 = 15 * 86400;
  52 is(ctime($jan_16), strftime("%a %b %d %H:%M:%S %Y\n", CORE::localtime($jan_16)),
  53         "get ctime() equal to strftime()");
  54 is(ctime($jan_16), strftime("%a %b %d %H:%M:%S %Y\n", POSIX::localtime($jan_16)),
  55         "get ctime() equal to strftime()");
  56 is(strftime("%Y\x{5e74}%m\x{6708}%d\x{65e5}", CORE::gmtime($jan_16)),
  57    "1970\x{5e74}01\x{6708}16\x{65e5}",
  58    "strftime() can handle unicode chars in the format string");
  59 is(strftime("%Y\x{5e74}%m\x{6708}%d\x{65e5}", POSIX::gmtime($jan_16)),
  60    "1970\x{5e74}01\x{6708}16\x{65e5}",
  61    "strftime() can handle unicode chars in the format string");
  62
  63 my $ss = chr 223;
  64 unlike($ss, qr/\w/, 'Not internally UTF-8 encoded');
  65 is(ord strftime($ss, CORE::localtime), 223,
  66    'Format string has correct character');
  67 is(ord strftime($ss, POSIX::localtime(time)),
  68    223, 'Format string has correct character');
  69 unlike($ss, qr/\w/, 'Still not internally UTF-8 encoded');
  70
  71 SKIP: {
  72     skip "No strptime()", 22 if $Config{d_strptime} ne 'define';
  73
  74     my @time = POSIX::strptime("2011-12-18 12:34:56", "%Y-%m-%d %H:%M:%S");
  75     is_deeply(\@time, [56, 34, 12, 18, 12-1, 2011-1900, 0, 351, 0], 'strptime() all 6 fields');
  76
  77     @time = POSIX::strptime("2011-12-18", "%Y-%m-%d", 1, 23, 4);
  78     is_deeply(\@time, [1, 23, 4, 18, 12-1, 2011-1900, 0, 351, 0], 'strptime() all date fields with passed time');
  79
  80     @time = POSIX::strptime("2011-12-18", "%Y-%m-%d");
  81     is_deeply(\@time, [undef, undef, undef, 18, 12-1, 2011-1900, 0, 351, 0], 'strptime() all date fields with no time');
  82
  83     # tm_year == 6 => 1906, which is a negative time_t. Lets use 106 as 2006 instead
  84     @time = POSIX::strptime("12:34:56", "%H:%M:%S", 1, 2, 3, 4, 5, 106);
  85     is_deeply(\@time, [56, 34, 12, 4, 5, 106, 0, 154, 1], 'strptime() all time fields with passed date');
  86
  87     @time = POSIX::strptime("July 4", "%b %d");
  88     is_deeply([@time[3,4]], [4, 7-1], 'strptime() partial yields correct mday/mon');
  89
  90     @time = POSIX::strptime("Foobar", "%H:%M:%S");
  91     is(scalar @time, 0, 'strptime() invalid input yields empty list');
  92
  93     my $str;
  94     @time = POSIX::strptime(\($str = "01:02:03"), "%H:%M:%S", -1,-1,-1, 1,0,70);
  95     is_deeply(\@time, [3, 2, 1, 1, 0, 70, 4, 0, 0], 'strptime() parses SCALAR ref');
  96     is(pos($str), 8, 'strptime() sets pos() magic on SCALAR ref');
  97
  98     $str = "Text with 2012-12-01 datestamp";
  99     pos($str) = 10;
 100     @time = POSIX::strptime(\$str, "%Y-%m-%d", 0, 0, 0);
 101     is_deeply(\@time, [0, 0, 0, 1, 12-1, 2012-1900, 6, 335, 0], 'strptime() starts SCALAR ref at pos()');
 102     is(pos($str), 20, 'strptime() updates pos() magic on SCALAR ref');
 103
 104     {
 105         # Latin-1 vs. UTF-8 strings
 106         my $date = "2012\x{e9}02\x{e9}01";
 107         utf8::upgrade my $date_U = $date;
 108         my $fmt = "%Y\x{e9}%m\x{e9}%d";
 109         utf8::upgrade my $fmt_U = $fmt;
 110
 111         my @want = (undef, undef, undef, 1, 2-1, 2012-1900, 3, 31, 0);
 112
 113         is_deeply([POSIX::strptime($date_U, $fmt  )], \@want, 'strptime() UTF-8 date, legacy fmt');
 114         is_deeply([POSIX::strptime($date,   $fmt_U)], \@want, 'strptime() legacy date, UTF-8 fmt');
 115         is_deeply([POSIX::strptime($date_U, $fmt_U)], \@want, 'strptime() UTF-8 date, UTF-8 fmt');
 116
 117         my $str = "\x{ea} $date \x{ea}";
 118         pos($str) = 2;
 119
 120         is_deeply([POSIX::strptime(\$str, $fmt_U)], \@want, 'strptime() legacy data SCALAR ref, UTF-8 fmt');
 121         is(pos($str), 12, 'pos() of legacy data SCALAR after strptime() UTF-8 fmt');
 122
 123         utf8::upgrade my $str_U = $str;
 124         pos($str_U) = 2;
 125
 126         is_deeply([POSIX::strptime(\$str_U, $fmt)], \@want, 'strptime() UTF-8 data SCALAR ref, legacy fmt');
 127         is(pos($str_U), 12, 'pos() of UTF-8 data SCALAR after strptime() legacy fmt');
 128
 129         # High (>U+FF) strings
 130         my $date_UU = "2012\x{1234}02\x{1234}01";
 131         my $fmt_UU  = "%Y\x{1234}%m\x{1234}%d";
 132
 133         is_deeply([POSIX::strptime($date_UU, $fmt_UU)], \@want, 'strptime() on non-Latin-1 Unicode');
 134     }
 135
 136     eval { POSIX::strptime({}, "format") };
 137     like($@, qr/not a reference to a mutable scalar/, 'strptime() dies on HASH ref');
 138
 139     eval { POSIX::strptime(\"boo", "format") };
 140     like($@, qr/not a reference to a mutable scalar/, 'strptime() dies on const literal ref');
 141
 142     eval { POSIX::strptime(qr/boo!/, "format") };
 143     like($@, qr/not a reference to a mutable scalar/, 'strptime() dies on Regexp');
 144
 145     $str = bless [], "WithStringOverload";
 146     {
 147         package WithStringOverload;
 148         use overload '""' => sub { return "2012-02-01" };
 149     }
 150
 151     @time = POSIX::strptime($str, "%Y-%m-%d", 0, 0, 0);
 152     is_deeply(\@time, [0, 0, 0, 1, 2-1, 2012-1900, 3, 31, 0], 'strptime() allows object with string overload');
 153 }
 154
 155 setlocale(LC_TIME, $orig_loc) || die "Cannot setlocale() back to orig: $!";
 156
 157 # clock() seems to have different definitions of what it does between POSIX
 158 # and BSD.  Cygwin, Win32, and Linux lean the BSD way.  So, the tests just
 159 # check the basics.
 160 like(clock(), qr/\d*/, "clock() returns a numeric value");
 161 cmp_ok(clock(), '>=', 0, "...and it returns something >= 0");
 162
 163 SKIP: {
 164     skip "No difftime()", 1 if $Config{d_difftime} ne 'define';
 165     is(difftime(2, 1), 1, "difftime()");
 166 }
 167
 168 SKIP: {
 169     skip "No mktime()", 2 if $Config{d_mktime} ne 'define';
 170     my $time = time();
 171     is(mktime(CORE::localtime($time)), $time, "mktime()");
 172     is(mktime(POSIX::localtime($time)), $time, "mktime()");
 173 }