Don't try to calculate a time over the conservative failure boundary.

Otherwise gmtime(2**66) will cause a very, very, very long loop and
DOS Perl.

Add a test that very, very large times don't send gmtime and localtime into a loop

Had to fix some revealed mistakes in op/time.t when warnings were turned on.

Fix Time::gmtime and Time::localtime tests to match the new limits of gm/localtime.

diff --git a/MANIFEST b/MANIFEST
index 7339570..9c779e2 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4487,6 +4487,7 @@ t/op/threads.t                    Misc. tests for perl features with threads
 t/op/tiearray.t                        See if tie for arrays works
 t/op/tiehandle.t               See if tie for handles works
 t/op/tie.t                     See if tie/untie functions work
+t/op/time_loop.t               Test that very large values don't hang gmtime and localtime.
 t/op/time.t                    See if time functions work
 t/op/tr.t                      See if tr works
 t/op/undef.t                   See if undef works

diff --git a/lib/Time/gmtime.t b/lib/Time/gmtime.t
index 9c77f81..b784096 100644 (file)
--- a/lib/Time/gmtime.t
+++ b/lib/Time/gmtime.t
@@ -9,10 +9,10 @@ BEGIN {
 
 my(@times, @methods);
 BEGIN {
-    @times   = (-2**62, -2**50, -2**33, -2**31-1, -1, 0, 1, 2**31-1, 2**33, 2**50, 2**62, time);
+    @times   = (-2**55, -2**50, -2**33, -2**31-1, -1, 0, 1, 2**31-1, 2**33, 2**50, 2**55, time);
     @methods = qw(sec min hour mday mon year wday yday isdst);
 
-    plan tests => (@times * @methods) + 1;
+    plan tests => (@times * (@methods + 1)) + 1;
 
     use_ok Time::gmtime;
 }
@@ -21,6 +21,7 @@ for my $time (@times) {
     my $gmtime = gmtime $time;          # This is the OO gmtime.
     my @gmtime = CORE::gmtime $time;    # This is the gmtime function
 
+    is @gmtime, 9, "gmtime($time)";
     for my $method (@methods) {
         is $gmtime->$method, shift @gmtime, "gmtime($time)->$method";
     }

diff --git a/lib/Time/localtime.t b/lib/Time/localtime.t
index f300343..0b020fc 100644 (file)
--- a/lib/Time/localtime.t
+++ b/lib/Time/localtime.t
@@ -9,10 +9,10 @@ BEGIN {
 
 my(@times, @methods);
 BEGIN {
-    @times   = (-2**62, -2**50, -2**33, -2**31-1, -1, 0, 1, 2**31-1, 2**33, 2**50, 2**62, time);
+    @times   = (-2**55, -2**50, -2**33, -2**31-1, -1, 0, 1, 2**31-1, 2**33, 2**50, 2**55, time);
     @methods = qw(sec min hour mday mon year wday yday isdst);
 
-    plan tests => (@times * @methods) + 1;
+    plan tests => (@times * (@methods + 1)) + 1;
 
     use_ok Time::localtime;
 }
@@ -21,6 +21,7 @@ for my $time (@times) {
     my $localtime = localtime $time;          # This is the OO localtime.
     my @localtime = CORE::localtime $time;    # This is the localtime function
 
+    is @localtime, 9, "localtime($time)";
     for my $method (@methods) {
         is $localtime->$method, shift @localtime, "localtime($time)->$method";
     }

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index f80bdcd..5436042 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1851,9 +1851,17 @@ earlier in the line, and you really meant a "less than".
 
 =item gmtime(%.0f) too large
 
-(W overflow) You called C<gmtime> with an number that was beyond the 64-bit
-range that it accepts, and some rounding resulted. This warning is also
-triggered with nan (the special not-a-number value).
+(W overflow) You called C<gmtime> with an number that was larger than
+it can reliably handle and C<gmtime> probably returned the wrong
+date. This warning is also triggered with nan (the special
+not-a-number value).
+
+=item gmtime(%.0f) too small
+
+(W overflow) You called C<gmtime> with an number that was smaller than
+it can reliably handle and C<gmtime> probably returned the wrong
+date. This warning is also triggered with nan (the special
+not-a-number value).
 
 =item Got an error from DosAllocMem
 
@@ -2289,8 +2297,17 @@ L<perlfunc/listen>.
 
 =item localtime(%.0f) too large
 
-(W overflow) You called C<localtime> with an number that was beyond the
-64-bit range that it accepts, and some rounding resulted. This warning is also triggered with nan (the special not-a-number value).
+(W overflow) You called C<localtime> with an number that was larger
+than it can reliably handle and C<localtime> probably returned the
+wrong date. This warning is also triggered with nan (the special
+not-a-number value).
+
+=item localtime(%.0f) too small
+
+(W overflow) You called C<localtime> with an number that was smaller
+than it can reliably handle and C<localtime> probably returned the
+wrong date. This warning is also triggered with nan (the special
+not-a-number value).
 
 =item Lookbehind longer than %d not implemented in regex m/%s/
 

diff --git a/pp_sys.c b/pp_sys.c
index 8b5fccb..e7cdb59 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4485,6 +4485,15 @@ PP(pp_tms)
 #endif /* HAS_TIMES */
 }
 
+/* The 32 bit int year limits the times we can represent to these
+   boundaries with a few days wiggle room to account for time zone
+   offsets
+*/
+/* Sat Jan  3 00:00:00 -2147481748 */
+#define TIME_LOWER_BOUND -67768100567755200.0
+/* Sun Dec 29 12:00:00  2147483647 */
+#define TIME_UPPER_BOUND  67767976233316800.0
+
 PP(pp_gmtime)
 {
     dVAR;
@@ -4513,10 +4522,22 @@ PP(pp_gmtime)
        }
     }
 
-    if (PL_op->op_type == OP_LOCALTIME)
-        err = S_localtime64_r(&when, &tmbuf);
-    else
-       err = S_gmtime64_r(&when, &tmbuf);
+    if ( TIME_LOWER_BOUND > when ) {
+       Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+                      "%s(%.0f) too small", opname, when);
+       err = NULL;
+    }
+    else if( when > TIME_UPPER_BOUND ) {
+       Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+                      "%s(%.0f) too large", opname, when);
+       err = NULL;
+    }
+    else {
+       if (PL_op->op_type == OP_LOCALTIME)
+           err = S_localtime64_r(&when, &tmbuf);
+       else
+           err = S_gmtime64_r(&when, &tmbuf);
+    }
 
     if (err == NULL) {
        /* XXX %lld broken for quads */

diff --git a/t/op/time.t b/t/op/time.t
index 5515634..84eaf75 100644 (file)
--- a/t/op/time.t
+++ b/t/op/time.t
@@ -1,4 +1,4 @@
-#!./perl
+#!./perl -w
 
 BEGIN {
     chdir 't' if -d 't';
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 56;
+plan tests => 62;
 
 # These tests make sure, among other things, that we don't end up
 # burning tons of CPU for dates far in the future.
@@ -36,9 +36,9 @@ ok($i >= 2_000_000, 'very basic times test');
 ($xsec,$foo) = localtime($now);
 $localyday = $yday;
 
-isnt($sec, $xsec),      'localtime() list context';
-ok $mday,               '  month day';
-ok $year,               '  year';
+isnt($sec, $xsec,      'localtime() list context');
+ok $mday,              '  month day';
+ok $year,              '  year';
 
 ok(localtime() =~ /^(Sun|Mon|Tue|Wed|Thu|Fri|Sat)[ ]
                     (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ]
@@ -66,9 +66,9 @@ ok($hour != $hour2,                             'changes to $ENV{TZ} respected')
 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($beg);
 ($xsec,$foo) = localtime($now);
 
-isnt($sec, $xsec),      'gmtime() list conext';
-ok $mday,               '  month day';
-ok $year,               '  year';
+isnt($sec, $xsec,      'gmtime() list conext');
+ok $mday,              '  month day';
+ok $year,              '  year';
 
 my $day_diff = $localyday - $yday;
 ok( grep({ $day_diff == $_ } (0, 1, -1, 364, 365, -364, -365)),
@@ -142,12 +142,12 @@ ok(gmtime() =~ /^(Sun|Mon|Tue|Wed|Thu|Fri|Sat)[ ]
 {
     eval {
         $SIG{__WARN__} = sub { die @_; };
-        localtime(1.23);
+        is( (localtime(1296000.23))[5] + 1900, 1970 );
     };
     is($@, '', 'Ignore fractional time');
     eval {
         $SIG{__WARN__} = sub { die @_; };
-        gmtime(1.23);
+        is( (gmtime(1.23))[5] + 1900, 1970 );
     };
     is($@, '', 'Ignore fractional time');
 }
@@ -174,3 +174,29 @@ ok(gmtime() =~ /^(Sun|Mon|Tue|Wed|Thu|Fri|Sat)[ ]
         is $have, $want, "year check, localtime($time)";
     }
 }
+
+
+# Test that Perl warns properly when it can't handle a time.
+{
+    my $warning;
+    local $SIG{__WARN__} = sub { $warning .= join "\n", @_; };
+
+    my $big_time   = 2**60;
+    my $small_time = -2**60;
+
+    $warning = '';
+    my $date = gmtime($big_time);
+    like $warning, qr/^gmtime(.*) too large/;
+
+    $warning = '';
+    $date = localtime($big_time);
+    like $warning, qr/^localtime(.*) too large/;
+
+    $warning = '';
+    $date = gmtime($small_time);
+    like $warning, qr/^gmtime(.*) too small/;
+
+    $warning = '';
+    $date = localtime($small_time);
+    like $warning, qr/^localtime(.*) too small/;
+}

diff --git a/t/op/time_loop.t b/t/op/time_loop.t
new file mode 100644 (file)
index 0000000..6f4acdc
--- /dev/null
+++ b/t/op/time_loop.t
@@ -0,0 +1,16 @@
+#!perl -w
+
+# d95a2ea538e6c332f36c34ca45b78d6ad93c3a1f allowed times greater than
+# 2**63 to be handed to gm/localtime() which caused an internal overflow
+# and an excessively long loop.  Test this does not happen.
+
+use strict;
+
+BEGIN { require './test.pl'; }
+
+plan tests => 2;
+watchdog(2);
+
+local $SIG{__WARN__} = sub {};
+is gmtime(2**69),    undef;
+is localtime(2**69), undef;