lib/Time/Local.t

   1 #!./perl
   2
   3 BEGIN {
   4   if ($ENV{PERL_CORE}){
   5     chdir('t') if -d 't';
   6     @INC = ('.', '../lib');
   7   }
   8 }
   9
  10 use strict;
  11
  12 use Config;
  13 use Test;
  14 use Time::Local;
  15
  16 # Set up time values to test
  17 my @time =
  18   (
  19    #year,mon,day,hour,min,sec
  20    [1970,  1,  2, 00, 00, 00],
  21    [1980,  2, 28, 12, 00, 00],
  22    [1980,  2, 29, 12, 00, 00],
  23    [1999, 12, 31, 23, 59, 59],
  24    [2000,  1,  1, 00, 00, 00],
  25    [2010, 10, 12, 14, 13, 12],
  26    # leap day
  27    [2020,  2, 29, 12, 59, 59],
  28    [2030,  7,  4, 17, 07, 06],
  29 # The following test fails on a surprising number of systems
  30 # so it is commented out. The end of the Epoch for a 32-bit signed
  31 # implementation of time_t should be Jan 19, 2038  03:14:07 UTC.
  32 #  [2038,  1, 17, 23, 59, 59],     # last full day in any tz
  33   );
  34
  35 my @bad_time =
  36     (
  37      # month too large
  38      [1995, 13, 01, 01, 01, 01],
  39      # day too large
  40      [1995, 02, 30, 01, 01, 01],
  41      # hour too large
  42      [1995, 02, 10, 25, 01, 01],
  43      # minute too large
  44      [1995, 02, 10, 01, 60, 01],
  45      # second too large
  46      [1995, 02, 10, 01, 01, 60],
  47     );
  48
  49 my @neg_time =
  50     (
  51      # test negative epochs for systems that handle it
  52      [ 1969, 12, 31, 16, 59, 59 ],
  53      [ 1950, 04, 12, 9, 30, 31 ],
  54     );
  55
  56 my $neg_epoch_ok = defined ((localtime(-3600))[0]) ? 1 : 0;
  57
  58 # use vmsish 'time' makes for oddness around the Unix epoch
  59 if ($^O eq 'VMS') {
  60     $time[0][2]++;
  61     $neg_epoch_ok = 0; # time_t is unsigned
  62 }
  63
  64 my $tests = (@time * 12);
  65 $tests += @neg_time * 12;
  66 $tests += @bad_time;
  67 $tests += 8;
  68 $tests += 2 if $ENV{PERL_CORE};
  69 $tests += 5 if $ENV{MAINTAINER};
  70
  71 plan tests => $tests;
  72
  73 for (@time, @neg_time) {
  74     my($year, $mon, $mday, $hour, $min, $sec) = @$_;
  75     $year -= 1900;
  76     $mon--;
  77
  78     if ($^O eq 'vos' && $year == 70) {
  79         skip(1, "skipping 1970 test on VOS.\n") for 1..6;
  80     } elsif ($year < 70 && ! $neg_epoch_ok) {
  81         skip(1, "skipping negative epoch.\n") for 1..6;
  82     } else {
  83         my $year_in = $year < 70 ? $year + 1900 : $year;
  84         my $time = timelocal($sec,$min,$hour,$mday,$mon,$year_in);
  85
  86         my($s,$m,$h,$D,$M,$Y) = localtime($time);
  87
  88         ok($s, $sec, 'timelocal second');
  89         ok($m, $min, 'timelocal minute');
  90         ok($h, $hour, 'timelocal hour');
  91         ok($D, $mday, 'timelocal day');
  92         ok($M, $mon, 'timelocal month');
  93         ok($Y, $year, 'timelocal year');
  94     }
  95
  96     if ($^O eq 'vos' && $year == 70) {
  97         skip(1, "skipping 1970 test on VOS.\n") for 1..6;
  98     } elsif ($year < 70 && ! $neg_epoch_ok) {
  99         skip(1, "skipping negative epoch.\n") for 1..6;
 100     } else {
 101         my $year_in = $year < 70 ? $year + 1900 : $year;
 102         my $time = timegm($sec,$min,$hour,$mday,$mon,$year_in);
 103
 104         my($s,$m,$h,$D,$M,$Y) = gmtime($time);
 105
 106         ok($s, $sec, 'timegm second');
 107         ok($m, $min, 'timegm minute');
 108         ok($h, $hour, 'timegm hour');
 109         ok($D, $mday, 'timegm day');
 110         ok($M, $mon, 'timegm month');
 111         ok($Y, $year, 'timegm year');
 112     }
 113 }
 114
 115 for (@bad_time) {
 116     my($year, $mon, $mday, $hour, $min, $sec) = @$_;
 117     $year -= 1900;
 118     $mon--;
 119
 120     eval { timegm($sec,$min,$hour,$mday,$mon,$year) };
 121
 122     ok($@, qr/.*out of range.*/, 'invalid time caused an error');
 123 }
 124
 125 ok(timelocal(0,0,1,1,0,90) - timelocal(0,0,0,1,0,90), 3600,
 126    'one hour difference between two calls to timelocal');
 127
 128 ok(timelocal(1,2,3,1,0,100) - timelocal(1,2,3,31,11,99), 24 * 3600,
 129    'one day difference between two calls to timelocal');
 130
 131 # Diff beween Jan 1, 1980 and Mar 1, 1980 = (31 + 29 = 60 days)
 132 ok(timegm(0,0,0, 1, 2, 80) - timegm(0,0,0, 1, 0, 80), 60 * 24 * 3600,
 133    '60 day difference between two calls to timegm');
 134
 135 # bugid #19393
 136 # At a DST transition, the clock skips forward, eg from 01:59:59 to
 137 # 03:00:00. In this case, 02:00:00 is an invalid time, and should be
 138 # treated like 03:00:00 rather than 01:00:00 - negative zone offsets used
 139 # to do the latter
 140 {
 141     my $hour = (localtime(timelocal(0, 0, 2, 7, 3, 102)))[2];
 142     # testers in US/Pacific should get 3,
 143     # other testers should get 2
 144     ok($hour == 2 || $hour == 3, 1, 'hour should be 2 or 3');
 145 }
 146
 147 if ($neg_epoch_ok) {
 148     eval { timegm(0,0,0,29,1,1900) };
 149     ok($@, qr/Day '29' out of range 1\.\.28/);
 150
 151     eval { timegm(0,0,0,29,1,1904) };
 152     ok($@, '');
 153 } else {
 154     skip(1, "skipping negative epoch.\n") for 1..2;
 155 }
 156
 157 # round trip was broken for edge cases
 158 if ($^O eq "aix" && $Config{osvers} =~ m/^4\.3\./) {
 159     skip( 1, "No fix expected for edge case test for $_ on AIX 4.3") for qw( timegm timelocal );
 160 } else {
 161     ok(sprintf('%x', timegm(gmtime(0x7fffffff))), sprintf('%x', 0x7fffffff),
 162        '0x7fffffff round trip through gmtime then timegm');
 163
 164     ok(sprintf('%x', timelocal(localtime(0x7fffffff))), sprintf('%x', 0x7fffffff),
 165        '0x7fffffff round trip through localtime then timelocal');
 166 }
 167
 168 if ($ENV{MAINTAINER}) {
 169     eval { require POSIX; POSIX::tzset() };
 170     if ($@) {
 171         skip( 1, "Cannot call POSIX::tzset() on this platform\n" ) for 1..3;
 172     }
 173     else {
 174         local $ENV{TZ} = 'Europe/Vienna';
 175         POSIX::tzset();
 176
 177         # 2001-10-28 02:30:00 - could be either summer or standard time,
 178         # prefer earlier of the two, in this case summer
 179         my $time = timelocal(0, 30, 2, 28, 9, 101);
 180         ok($time, 1004229000,
 181            'timelocal prefers earlier epoch in the presence of a DST change');
 182
 183         local $ENV{TZ} = 'America/Chicago';
 184         POSIX::tzset();
 185
 186         # Same local time in America/Chicago.  There is a transition
 187         # here as well.
 188         $time = timelocal(0, 30, 1, 28, 9, 101);
 189         ok($time, 1004250600,
 190            'timelocal prefers earlier epoch in the presence of a DST change');
 191
 192         $time = timelocal(0, 30, 2, 1, 3, 101);
 193         ok($time, 986113800,
 194            'timelocal for non-existent time gives you the time one hour later');
 195
 196         local $ENV{TZ} = 'Australia/Sydney';
 197         POSIX::tzset();
 198
 199         # 2001-03-25 02:30:00 in Australia/Sydney.  This is the transition
 200         # _to_ summer time.  The southern hemisphere transitions are
 201         # opposite those of the northern.
 202         $time = timelocal(0, 30, 2, 25, 2, 101);
 203         ok($time, 985447800,
 204            'timelocal prefers earlier epoch in the presence of a DST change');
 205
 206         $time = timelocal(0, 30, 2, 28, 9, 101);
 207         ok($time, 1004200200,
 208            'timelocal for non-existent time gives you the time one hour later');
 209     }
 210 }
 211
 212 if ($ENV{PERL_CORE}) {
 213   package test;
 214   require 'timelocal.pl';
 215
 216   # need to get ok() from main package
 217   ::ok(timegm(0,0,0,1,0,80), main::timegm(0,0,0,1,0,80),
 218      'timegm in timelocal.pl');
 219
 220   ::ok(timelocal(1,2,3,4,5,88), main::timelocal(1,2,3,4,5,88),
 221      'timelocal in timelocal.pl');
 222 }