This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Time::Local patch take 2
authorDave Rolsky <autarch@urth.org>
Mon, 22 Jan 2007 09:46:08 +0000 (03:46 -0600)
committerSteve Peters <steve@fisharerojo.org>
Tue, 23 Jan 2007 01:55:48 +0000 (01:55 +0000)
Message-ID: <Pine.LNX.4.64.0701220945040.28849@urth.org>

p4raw-id: //depot/perl@29931

lib/Time/Local.pm
lib/Time/Local.t

index 4c1957c..528f230 100644 (file)
@@ -7,7 +7,7 @@ use strict;
 use integer;
 
 use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK );
-$VERSION   = '1.13';
+$VERSION   = '1.15';
 
 @ISA       = qw( Exporter );
 @EXPORT    = qw( timegm timelocal );
@@ -111,7 +111,7 @@ sub timegm {
 
        my $md = $MonthDays[$month];
         ++$md
-            unless $month != 1 or $year % 4 or !( $year % 400 );
+            if $month == 1 && _is_leap_year($year);
 
         croak "Day '$mday' out of range 1..$md"  if $mday > $md or $mday < 1;
         croak "Hour '$hour' out of range 0..23"  if $hour > 23  or $hour < 0;
@@ -138,6 +138,14 @@ sub timegm {
            + ( SECS_PER_DAY * $days );
 }
 
+sub _is_leap_year {
+    return 0 if $_[0] % 4;
+    return 1 if $_[0] % 100;
+    return 0 if $_[0] % 400;
+
+    return 1;
+}
+
 sub timegm_nocheck {
     local $Options{no_range_check} = 1;
     return &timegm;
index 2ccea67..4ae7392 100755 (executable)
@@ -52,11 +52,20 @@ my @neg_time =
      [ 1950, 04, 12, 9, 30, 31 ],
     );
 
+# Leap year tests
+my @years =
+    (
+     [ 1900 => 0 ],
+     [ 1947 => 0 ],
+     [ 1996 => 1 ],
+     [ 2000 => 1 ],
+     [ 2100 => 0 ],
+    );
+
 # Use 3 days before the start of the epoch because with Borland on
 # Win32 it will work for -3600 _if_ your time zone is +01:00 (or
 # greater).
-my $neg_epoch_ok =     # take into account systems with unsigned time too
-    (defined ((localtime(-259200))[0]) and (localtime(-259200))[5] == 69) ? 1 : 0;
+my $neg_epoch_ok = defined ((localtime(-259200))[0]) ? 1 : 0;
 
 # use vmsish 'time' makes for oddness around the Unix epoch
 if ($^O eq 'VMS') {
@@ -67,7 +76,8 @@ if ($^O eq 'VMS') {
 my $tests = (@time * 12);
 $tests += @neg_time * 12;
 $tests += @bad_time;
-$tests += 6;
+$tests += @years;
+$tests += 5;
 $tests += 2 if $ENV{PERL_CORE};
 $tests += 8 if $ENV{MAINTAINER};
 
@@ -148,15 +158,19 @@ for (@bad_time) {
     ok($hour == 2 || $hour == 3, 'hour should be 2 or 3');
 }
 
+for my $p (@years) {
+    my ( $year, $is_leap_year ) = @$p;
+
+    my $string = $is_leap_year ? 'is' : 'is not';
+    is( Time::Local::_is_leap_year($year), $is_leap_year,
+        "$year $string a leap year" );
+}
+
 SKIP:
 {
-    skip 'this platform does not support negative epochs.', 2
+    skip 'this platform does not support negative epochs.', 1
         unless $neg_epoch_ok;
 
-    eval { timegm(0,0,0,29,1,1900) };
-    like($@, qr/Day '29' out of range 1\.\.28/,
-         'does not accept leap day in 1900');
-
     eval { timegm(0,0,0,29,1,1904) };
     is($@, '', 'no error with leap day of 1904');
 }