Upgrade to Time::Local 1.07_94

p4raw-id: //depot/perl@21935

2 files changed, 165 insertions, 77 deletions

diff --git a/lib/Time/Local.pm b/lib/Time/Local.pm
index c38d07ca60..6b38c303ae 100644
--- a/lib/Time/Local.pm
+++ b/lib/Time/Local.pm
@@ -7,7 +7,8 @@ use strict;
 use integer;
 
 use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK );
-$VERSION    = '1.07';
+$VERSION    = '1.07_94';
+$VERSION    = eval $VERSION;
 @ISA	= qw( Exporter );
 @EXPORT	= qw( timegm timelocal );
 @EXPORT_OK	= qw( timegm_nocheck timelocal_nocheck );
@@ -22,10 +23,23 @@ my $NextCentury  = $ThisYear - $ThisYear % 100;
 my $Century      = $NextCentury - 100;
 my $SecOff       = 0;
 
-my (%Options, %Cheat);
+my (%Options, %Cheat, %Min, %Max);
+my ($MinInt, $MaxInt);
 
-my $MaxInt = ((1<<(8 * $Config{intsize} - 2))-1)*2 + 1;
-my $MaxDay = int(($MaxInt-43200)/86400)-1;
+if ($^O eq 'MacOS') {
+    # time_t is unsigned...
+    $MaxInt = (1 << (8 * $Config{intsize})) - 1;
+    $MinInt = 0;
+} else {
+    $MaxInt = ((1 << (8 * $Config{intsize} - 2))-1)*2 + 1;
+    $MinInt = -$MaxInt - 1;
+}
+
+$Max{Day} = ($MaxInt >> 1) / 43200;
+$Min{Day} = ($MinInt)? -($Max{Day}+1) : 0;
+
+$Max{Sec} =  $MaxInt - 86400 * $Max{Day};
+$Min{Sec} =  $MinInt - 86400 * $Min{Day};
 
 # Determine the EPOC day for this machine
 my $Epoc = 0;
@@ -37,7 +51,6 @@ if ($^O eq 'vos') {
 elsif ($^O eq 'MacOS') {
   no integer;
 
-  $MaxDay *=2 if $^O eq 'MacOS';  # time_t unsigned ... quick hack?
   # MacOS time() is seconds since 1 Jan 1904, localtime
   # so we need to calculate an offset to apply later
   $Epoc = 693901;
@@ -68,6 +81,17 @@ sub _timegm {
 }
 
 
+sub _zoneadjust {
+    my ($day, $sec, $time) = @_;
+
+    $sec = $sec + _timegm(localtime($time)) - $time;
+    if ($sec >= 86400) { $day++; $sec -= 86400; }
+    if ($sec <  0)     { $day--; $sec += 86400; }
+
+    ($day, $sec);
+}
+
+
 sub timegm {
     my ($sec,$min,$hour,$mday,$month,$year) = @_;
 
@@ -81,7 +105,7 @@ sub timegm {
     unless ($Options{no_range_check}) {
 	if (abs($year) >= 0x7fff) {
 	    $year += 1900;
-	    croak "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)";
+	    croak "Cannot handle date ($sec, $min, $hour, $mday, $month, *$year*)";
 	}
 
 	croak "Month '$month' out of range 0..11" if $month > 11 or $month < 0;
@@ -96,17 +120,23 @@ sub timegm {
     }
 
     my $days = _daygm(undef, undef, undef, $mday, $month, $year);
-
-    unless ($Options{no_range_check} or abs($days) < $MaxDay) {
+    my $xsec = $sec + $SecOff + 60*$min + 3600*$hour;
+
+    unless ($Options{no_range_check}
+        or  ($days > $Min{Day} or $days == $Min{Day} and $xsec >= $Min{Sec})
+       and  ($days < $Max{Day} or $days == $Max{Day} and $xsec <= $Max{Sec}))
+    {
+        warn "Day too small - $days > $Min{Day}\n" if $days < $Min{Day};
+        warn "Day too big - $days > $Max{Day}\n" if $days > $Max{Day};
+        warn "Sec too small - $days < $Min{Sec}\n" if $days < $Min{Sec};
+        warn "Sec too big - $days > $Max{Sec}\n" if $days > $Max{Sec};
 	$year += 1900;
 	croak "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)";
     }
 
-    $sec += $SecOff + 60*$min + 3600*$hour;
-
     no integer;
 
-    $sec + 86400*$days;
+    $xsec + 86400 * $days;
 }
 
 
@@ -117,14 +147,23 @@ sub timegm_nocheck {
 
 
 sub timelocal {
-    no integer;
+    # Adjust Max/Min allowed times to fit local time zone and call timegm
+    local ($Max{Day}, $Max{Sec}) = _zoneadjust($Max{Day}, $Max{Sec}, $MaxInt);
+    local ($Min{Day}, $Min{Sec}) = _zoneadjust($Min{Day}, $Min{Sec}, $MinInt);
     my $ref_t = &timegm;
-    my $loc_t = _timegm(localtime($ref_t));
+
+    # Calculate first guess with a one-day delta to avoid localtime overflow
+    my $delta = ($_[5] < 100)? 86400 : -86400;
+    my $loc_t = _timegm(localtime( $ref_t + $delta )) - $delta;
 
     # Is there a timezone offset from GMT or are we done
     my $zone_off = $ref_t - $loc_t
 	or return $loc_t;
 
+    # This hack is needed to always pick the first matching time
+    # during a DST change when time would otherwise be ambiguous
+    $zone_off -= 3600 if ($delta > 0 && $ref_t >= 3600);
+
     # Adjust for timezone
     $loc_t = $ref_t + $zone_off;
 
@@ -135,12 +174,12 @@ sub timelocal {
     # Adjust for DST change
     $loc_t += $dst_off;
 
+    return $loc_t if $dst_off >= 0;
+
     # for a negative offset from GMT, and if the original date
     # was a non-extent gap in a forward DST jump, we should
     # now have the wrong answer - undo the DST adjust;
 
-    return $loc_t if $zone_off <= 0;
-
     my ($s,$m,$h) = localtime($loc_t);
     $loc_t -= $dst_off if $s != $_[0] || $m != $_[1] || $h != $_[2];
 
@@ -244,6 +283,29 @@ from Dec 1901 to Jan 2038.
 Both timelocal() and timegm() croak if given dates outside the supported
 range.
 
+=head2 Ambiguous Local Times (DST)
+
+Because of DST changes, there are many time zones where the same local
+time occurs for two different UTC times on the same day.  For example,
+in the "Europe/Paris" time zone, the local time of 2001-10-28 02:30:00
+can represent either 2001-10-28 00:30:00 UTC, B<or> 2001-10-28
+01:30:00 UTC.
+
+When given an ambiguous local time, the timelocal() function should
+always return the epoch for the I<earlier> of the two possible UTC
+times.
+
+=head2 Negative Epoch Values
+
+Negative epoch (time_t) values are not officially supported by the
+POSIX standards, so this module's tests do not test them.  On some
+systems, they are known not to work.  These include MacOS (pre-OSX)
+and Win32.
+
+On systems which do support negative epoch values, this module should
+be able to cope with dates before the start of the epoch, down the
+minimum value of time_t for the system.
+
 =head1 IMPLEMENTATION
 
 These routines are quite efficient and yet are always guaranteed to agree
@@ -264,8 +326,6 @@ also be correct.
 
 The whole scheme for interpreting two-digit years can be considered a bug.
 
-The proclivity to croak() is probably a bug.
-
 =head1 SUPPORT
 
 Support for this module is provided via the perl5-porters@perl.org
diff --git a/lib/Time/Local.t b/lib/Time/Local.t
index 809dd92e1d..c4b7827e66 100755
--- a/lib/Time/Local.t
+++ b/lib/Time/Local.t
@@ -7,12 +7,15 @@ BEGIN {
   }
 }
 
+use strict;
+
+use Test;
 use Time::Local;
 
 # Set up time values to test
-@time =
+my @time =
   (
-   #year,mon,day,hour,min,sec 
+   #year,mon,day,hour,min,sec
    [1970,  1,  2, 00, 00, 00],
    [1980,  2, 28, 12, 00, 00],
    [1980,  2, 29, 12, 00, 00],
@@ -30,73 +33,57 @@ use Time::Local;
 # use vmsish 'time' makes for oddness around the Unix epoch
 if ($^O eq 'VMS') { $time[0][2]++ }
 
-my $tests = @time * 2 + 4;
+my $tests = (@time * 12) + 6;
 $tests += 2 if $ENV{PERL_CORE};
+$tests += 3 if $ENV{MAINTAINER};
 
-print "1..$tests\n";
+plan tests => $tests;
 
-$count = 1;
 for (@time) {
     my($year, $mon, $mday, $hour, $min, $sec) = @$_;
     $year -= 1900;
-    $mon --;
-    if ($^O eq 'vos' && $count == 1) {
-     print "ok $count -- skipping 1970 test on VOS.\n";
+    $mon--;
+
+    if ($^O eq 'vos' && $year == 70) {
+        skip(1, "skipping 1970 test on VOS.\n") for 1..6;
     } else {
-     my $time = timelocal($sec,$min,$hour,$mday,$mon,$year);
-     # print scalar(localtime($time)), "\n";
-     my($s,$m,$h,$D,$M,$Y) = localtime($time);
-
-     if ($s == $sec &&
-	 $m == $min &&
-	 $h == $hour &&
-	 $D == $mday &&
-	 $M == $mon &&
-	 $Y == $year
-        ) {
-	 print "ok $count\n";
-     } else {
-      print "not ok $count\n";
-     }
+        my $time = timelocal($sec,$min,$hour,$mday,$mon,$year);
+
+        my($s,$m,$h,$D,$M,$Y) = localtime($time);
+
+        ok($s, $sec, 'second');
+        ok($m, $min, 'minute');
+        ok($h, $hour, 'hour');
+        ok($D, $mday, 'day');
+        ok($M, $mon, 'month');
+        ok($Y, $year, 'year');
     }
-    $count++;
 
-    # Test gmtime function
-    if ($^O eq 'vos' && $count == 2) {
-        print "ok $count -- skipping 1970 test on VOS.\n";
+    if ($^O eq 'vos' && $year == 70) {
+        skip(1, "skipping 1970 test on VOS.\n") for 1..6;
     } else {
-     $time = timegm($sec,$min,$hour,$mday,$mon,$year);
-     ($s,$m,$h,$D,$M,$Y) = gmtime($time);
-
-     if ($s == $sec &&
-	 $m == $min &&
-	 $h == $hour &&
-	 $D == $mday &&
-	 $M == $mon &&
-	 $Y == $year
-        ) {
-	 print "ok $count\n";
-     } else {
-      print "not ok $count\n";
-     }
+        my $time = timelocal($sec,$min,$hour,$mday,$mon,$year);
+
+        my($s,$m,$h,$D,$M,$Y) = localtime($time);
+
+        ok($s, $sec, 'second');
+        ok($m, $min, 'minute');
+        ok($h, $hour, 'hour');
+        ok($D, $mday, 'day');
+        ok($M, $mon, 'month');
+        ok($Y, $year, 'year');
     }
-    $count++;
 }
 
-#print "Testing that the differences between a few dates makes sense...\n";
-
-timelocal(0,0,1,1,0,90) - timelocal(0,0,0,1,0,90) == 3600
-  or print "not ";
-print "ok ", $count++, "\n";
+ok(timelocal(0,0,1,1,0,90) - timelocal(0,0,0,1,0,90), 3600,
+   'one hour difference between two calls to timelocal');
 
-timelocal(1,2,3,1,0,100) - timelocal(1,2,3,31,11,99) == 24 * 3600 
-  or print "not ";
-print "ok ", $count++, "\n";
+ok(timelocal(1,2,3,1,0,100) - timelocal(1,2,3,31,11,99), 24 * 3600,
+   'one day difference between two calls to timelocal');
 
 # Diff beween Jan 1, 1980 and Mar 1, 1980 = (31 + 29 = 60 days)
-timegm(0,0,0, 1, 2, 80) - timegm(0,0,0, 1, 0, 80) == 60 * 24 * 3600
-  or print "not ";
-print "ok ", $count++, "\n";
+ok(timegm(0,0,0, 1, 2, 80) - timegm(0,0,0, 1, 0, 80), 60 * 24 * 3600,
+   '60 day difference between two calls to timegm');
 
 # bugid #19393
 # At a DST transition, the clock skips forward, eg from 01:59:59 to
@@ -107,17 +94,58 @@ print "ok ", $count++, "\n";
     my $hour = (localtime(timelocal(0, 0, 2, 7, 3, 102)))[2];
     # testers in US/Pacific should get 3,
     # other testers should get 2
-    print "not " unless $hour == 2 || $hour == 3;
-    print "ok ", $main::count++, "\n";
+    ok($hour == 2 || $hour == 3, 1, 'hour should be 2 or 3');
+}
+
+# round trip was broken for edge cases
+ok(sprintf('%x', timegm(gmtime(0x7fffffff))), sprintf('%x', 0x7fffffff),
+   '0x7fffffff round trip through gmtime then timegm');
+
+ok(sprintf('%x', timelocal(localtime(0x7fffffff))), sprintf('%x', 0x7fffffff),
+   '0x7fffffff round trip through localtime then timelocal');
+
+if ($ENV{MAINTAINER}) {
+    eval { require POSIX; POSIX::tzset() };
+    if ($@) {
+        skip("Cannot call POSIX::tzset() on this platform\n") for 1..3;
+    }
+    else {
+        local $ENV{TZ} = 'Europe/Vienna';
+        POSIX::tzset();
+
+        # 2001-10-28 02:30:00 - could be either summer or standard time,
+        # prefer earlier of the two, in this case summer
+        my $time = timelocal(0, 30, 2, 28, 9, 101);
+        ok($time, 1004229000,
+           'timelocal prefers earlier epoch in the presence of a DST change');
+
+        local $ENV{TZ} = 'America/Chicago';
+        POSIX::tzset();
+
+        # Same local time in America/Chicago.  There is transition here as
+        # well.
+        $time = timelocal(0, 30, 1, 28, 9, 101);
+        ok($time, 1004250600,
+           'timelocal prefers earlier epoch in the presence of a DST change');
+
+        local $ENV{TZ} = 'Australia/Sydney';
+        POSIX::tzset();
+
+        # 2001-03-25 02:30:00 in Australia/Sydney.  This is the transition
+        # _to_ summer time.  The southern hemisphere transitions are
+        # opposite those of the northern.
+        $time = timelocal(0, 30, 2, 25, 2, 101);
+        ok($time, 985447800,
+           'timelocal prefers earlier epoch in the presence of a DST change');
+    }
 }
 
 if ($ENV{PERL_CORE}) {
-  #print "Testing timelocal.pl module too...\n";
   package test;
   require 'timelocal.pl';
-  timegm(0,0,0,1,0,80) == main::timegm(0,0,0,1,0,80) or print "not ";
-  print "ok ", $main::count++, "\n";
+  ::ok(timegm(0,0,0,1,0,80), main::timegm(0,0,0,1,0,80),
+     'timegm in timelocal.pl');
 
-  timelocal(1,2,3,4,5,88) == main::timelocal(1,2,3,4,5,88) or print "not ";
-  print "ok ", $main::count++, "\n";
+  ::ok(timelocal(1,2,3,4,5,88), main::timelocal(1,2,3,4,5,88),
+     'timelocal in timelocal.pl');
 }