fix O_CREAT without O_TRUNC in cpan/autodie/t/utf8_open.t

[perl5.git] / t / op / time.t

diff --git a/t/op/time.t b/t/op/time.t
index 2ea1733..4ac7f5b 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,13 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 44;
+plan tests => 66;
+
+# These tests make sure, among other things, that we don't end up
+# burning tons of CPU for dates far in the future.
+# watchdog() makes sure that the test script eventually exits if
+# the tests are triggering the failing behavior
+watchdog(15);
 
 ($beguser,$begsys) = times;
 
@@ -30,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)[ ]
@@ -44,7 +50,7 @@ ok(localtime() =~ /^(Sun|Mon|Tue|Wed|Thu|Fri|Sat)[ ]
 SKIP: {
     # This conditional of "No tzset()" is stolen from ext/POSIX/t/time.t
     skip "No tzset()", 1
-        if $^O eq "MacOS" || $^O eq "VMS" || $^O eq "cygwin" ||
+        if $^O eq "VMS" || $^O eq "cygwin" ||
            $^O eq "djgpp" || $^O eq "MSWin32" || $^O eq "dos" ||
            $^O eq "interix";
 
@@ -60,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)),
@@ -134,14 +140,98 @@ ok(gmtime() =~ /^(Sun|Mon|Tue|Wed|Thu|Fri|Sat)[ ]
 
 # Test floating point args
 {
-    eval {
-        $SIG{__WARN__} = sub { die @_; };
-        localtime(1.23);
-    };
-    is($@, '', 'Ignore fractional time');
-    eval {
-        $SIG{__WARN__} = sub { die @_; };
-        gmtime(1.23);
-    };
-    is($@, '', 'Ignore fractional time');
+    warning_is(sub {is( (localtime(1296000.23))[5] + 1900, 1970 )},
+              undef, 'Ignore fractional time');
+    warning_is(sub {is( (gmtime(1.23))[5] + 1900, 1970 )},
+              undef, 'Ignore fractional time');
+}
+
+
+# Some sanity tests for the far, far future and far, far past
+{
+    my %time2year = (
+        -2**52  => -142711421,
+        -2**48  => -8917617,
+        -2**46  => -2227927,
+         2**46  => 2231866,
+         2**48  => 8921556,
+         2**52  => 142715360,
+    );
+
+    for my $time (sort keys %time2year) {
+        my $want = $time2year{$time};
+
+        my $have = (gmtime($time))[5] + 1900;
+        is $have, $want, "year check, gmtime($time)";
+
+        $have = (localtime($time))[5] + 1900;
+        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/;
+}
+
+SKIP: { #rt #73040
+    # these are from the definitions of TIME_LOWER_BOUND AND TIME_UPPER_BOUND
+    my $smallest = -67768100567755200.0;
+    my $biggest = 67767976233316800.0;
+
+    # offset to a value that will fail
+    my $small_time = $smallest - 200;
+    my $big_time = $biggest + 200;
+
+    # check they're representable - typically means NV is
+    # long double
+    if ($small_time + 200 != $smallest
+       || $small_time == $smallest
+        || $big_time - 200 != $biggest
+       || $big_time == $biggest) {
+       skip "Can't represent test values", 4;
+    }
+    my $small_time_f = sprintf("%.0f", $small_time);
+    my $big_time_f = sprintf("%.0f", $big_time);
+
+    # check the numbers in the warning are correct
+    my $warning;
+    local $SIG{__WARN__} = sub { $warning .= join "\n", @_; };
+    $warning = '';
+    my $date = gmtime($big_time);
+    like $warning, qr/^gmtime\($big_time_f\) too large/;
+
+    $warning = '';
+    $date = localtime($big_time);
+    like $warning, qr/^localtime\($big_time_f\) too large/;
+
+    $warning = '';
+    $date = gmtime($small_time);
+    like $warning, qr/^gmtime\($small_time_f\) too small/;
+
+    $warning = '';
+    $date = localtime($small_time);
+    like $warning, qr/^localtime\($small_time_f\) too small/;
+  
 }