infnan: store the nan payload error in an optional SV

1 files changed, 18 insertions, 20 deletions

diff --git a/numeric.c b/numeric.c
index a1e8aeaed1..6a578e1a04 100644
--- a/numeric.c
+++ b/numeric.c
@@ -708,7 +708,7 @@ Do not assume any portability of the NaN semantics.
 =cut
 */
 void
-Perl_nan_payload_set(pTHX_ NV *nvp, const void *bytes, STRLEN byten, bool signaling)
+Perl_nan_payload_set(pTHX_ NV *nvp, SV* svp, const void *bytes, STRLEN byten, bool signaling)
 {
     /* How many bits we can set in the payload.
      *
@@ -773,8 +773,9 @@ Perl_nan_payload_set(pTHX_ NV *nvp, const void *bytes, STRLEN byten, bool signal
         *hibyte &= ~mask;
     }
     if (overflow) {
-        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
-                       "NaN payload overflowed %d bits", NV_NAN_BITS);
+        if (svp) {
+            sv_setpvf(svp, "NaN payload overflowed %d bits", NV_NAN_BITS);
+        }
     }
     nan_signaling_set(nvp, signaling);
 }
@@ -791,7 +792,7 @@ If you want the parse the "nan" part you need to use grok_nan().
 =cut
 */
 const char *
-Perl_grok_nan_payload(pTHX_ const char* s, const char* send, bool signaling, int *flags, NV* nvp)
+Perl_grok_nan_payload(pTHX_ const char* s, const char* send, bool signaling, int *flags, NV* nvp, SV* svp)
 {
     U8 bytes[MAX_NV_BYTES];
     STRLEN byten = 0;
@@ -809,9 +810,7 @@ Perl_grok_nan_payload(pTHX_ const char* s, const char* send, bool signaling, int
 
     if (*t != ')') {
         U8 bytes[1] = { 0 };
-        nan_payload_set(nvp, bytes, 1, signaling);
-        Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT),
-                       "NaN payload \"%s\" invalid", orig);
+        nan_payload_set(nvp, svp, bytes, 1, signaling);
         return t;
     }
 
@@ -930,14 +929,13 @@ Perl_grok_nan_payload(pTHX_ const char* s, const char* send, bool signaling, int
         bytes[byten++] = 0;
     }
 
-    if (overflow) {
-        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
-                       "NaN payload \"%s\" overflowed %d bits",
-                       orig, NV_NAN_BITS);
-    }
-    if (bogus) {
-        Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT),
-                       "NaN payload \"%s\" invalid", orig);
+    if (svp) {
+        if (bogus) {
+            sv_setpvf(svp, "NaN payload \"%s\" invalid",orig);
+        } else if (overflow) {
+            sv_setpvf(svp, "NaN payload \"%s\" overflowed %d bits",
+                      orig, NV_NAN_BITS);
+        }
     }
 
     if (s == send) {
@@ -946,7 +944,7 @@ Perl_grok_nan_payload(pTHX_ const char* s, const char* send, bool signaling, int
     }
 
     if (nvp) {
-        nan_payload_set(nvp, bytes, byten, signaling);
+        nan_payload_set(nvp, svp, bytes, byten, signaling);
     }
 
     return s;
@@ -967,7 +965,7 @@ The "..." is parsed with grok_nan_payload().
 =cut
 */
 const char *
-Perl_grok_nan(pTHX_ const char* s, const char* send, int *flags, NV* nvp)
+Perl_grok_nan(pTHX_ const char* s, const char* send, int *flags, NV* nvp, SV* svp)
 {
     bool signaling = FALSE;
 
@@ -998,7 +996,7 @@ Perl_grok_nan(pTHX_ const char* s, const char* send, int *flags, NV* nvp)
         }
 
         if (*s == '(') {
-            const char *n = grok_nan_payload(s, send, signaling, flags, nvp);
+            const char *n = grok_nan_payload(s, send, signaling, flags, nvp, svp);
             if (n == send) return NULL;
             s = n;
             if (*s != ')') {
@@ -1008,7 +1006,7 @@ Perl_grok_nan(pTHX_ const char* s, const char* send, int *flags, NV* nvp)
         } else {
             if (nvp) {
                 U8 bytes[1] = { 0 };
-                nan_payload_set(nvp, bytes, 1, signaling);
+                nan_payload_set(nvp, svp, bytes, 1, signaling);
             }
 
             while (s < send && isSPACE(*s)) s++;
@@ -1139,7 +1137,7 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send, NV* nvp)
     }
     else {
         /* Maybe NAN of some sort */
-        const char *n = grok_nan(s, send, &flags, nvp);
+        const char *n = grok_nan(s, send, &flags, nvp, NULL);
         if (n == NULL) return 0;
         s = n;
     }