From d8bd3d828a02f8df716063d9980b8b9af539ca42 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Thu, 25 Dec 2014 09:57:07 -0800
Subject: [PATCH] [perl #123495] Stop gmtime(nan) from crashing

We were getting a time struct like this:

$12 = {
  tm_sec = -2147483588,
  tm_min = 2147483647,
  tm_hour = -2147483624,
  tm_mday = -2147483647,
  tm_mon = 11,
  tm_year = 69,
  tm_wday = -2147483641,
  tm_yday = -2147483314,
  tm_isdst = 0,
  tm_gmtoff = 0,
  tm_zone = 0x1004f6bb6 "UTC"
}

which resulted in dayname[tmbuf.tm_wday] reading past the beginning
of the array.  We should check for nan explicitly instead of falling
through to the time calculations.
---
 pp_sys.c              |  8 +++++++-
 t/lib/warnings/pp_sys | 18 ++++++++++++++++++
 t/op/time.t           |  8 +++++++-
 3 files changed, 32 insertions(+), 2 deletions(-)

diff --git a/pp_sys.c b/pp_sys.c
index 4fce7ca..da69cb0 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4607,11 +4607,16 @@ PP(pp_gmtime)
     }
     else {
 	NV input = Perl_floor(POPn);
+	const bool isnan = Perl_isnan(input);
 	when = (Time64_T)input;
-	if (when != input) {
+	if (UNLIKELY(isnan || when != input)) {
 	    /* diag_listed_as: gmtime(%f) too large */
 	    Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
 			   "%s(%.0" NVff ") too large", opname, input);
+	    if (isnan) {
+		err = NULL;
+		goto failed;
+	    }
 	}
     }
 
@@ -4637,6 +4642,7 @@ PP(pp_gmtime)
     if (err == NULL) {
 	/* diag_listed_as: gmtime(%f) failed */
 	/* XXX %lld broken for quads */
+      failed:
 	Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
 		       "%s(%.0" NVff ") failed", opname, when);
     }
diff --git a/t/lib/warnings/pp_sys b/t/lib/warnings/pp_sys
index a4f4aba..0dce57f 100644
--- a/t/lib/warnings/pp_sys
+++ b/t/lib/warnings/pp_sys
@@ -105,6 +105,10 @@
 
   Non-string passed as bitmask			[pp_sselect]
 
+  %s too large					[pp_gmtime]
+
+  %s failed					[pp_gmtime]
+
 __END__
 # pp_sys.c [pp_untie]
 use warnings 'untie' ;
@@ -903,3 +907,17 @@ telldir() attempted on invalid dirhandle $ｆｏｏ at - line 20.
 seekdir() attempted on invalid dirhandle $ｆｏｏ at - line 21.
 rewinddir() attempted on invalid dirhandle $ｆｏｏ at - line 22.
 closedir() attempted on invalid dirhandle $ｆｏｏ at - line 23.
+########
+
+# pp_sys.c [pp_gmtime]
+gmtime("NaN");
+localtime("NaN");
+use warnings "overflow";
+gmtime("NaN");
+localtime("NaN");
+
+EXPECT
+gmtime(NaN) too large at - line 6.
+gmtime(NaN) failed at - line 6.
+localtime(NaN) too large at - line 7.
+localtime(NaN) failed at - line 7.
diff --git a/t/op/time.t b/t/op/time.t
index 734b838..f5ce339 100644
--- a/t/op/time.t
+++ b/t/op/time.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 70;
+plan tests => 72;
 
 # These tests make sure, among other things, that we don't end up
 # burning tons of CPU for dates far in the future.
@@ -238,3 +238,9 @@ SKIP: { #rt #73040
     like $warning, qr/^localtime\($small_time_f\) too small/;
     like $warning, qr/^localtime\($small_time_f\) failed/m;
 }
+
+{
+    local $^W;
+    is scalar gmtime("NaN"), undef, '[perl #123495] gmtime(NaN)';
+    is scalar localtime("NaN"), undef, 'localtime(NaN)';
+}
-- 
1.8.3.1