[perl #12285] Fix str vs num inf/nan treatment

sprintf, pack and chr were treating 0+"Inf" and "Inf" differently,
even though they have the same string and numeric values.

pack was also croaking for 0+"Inf" passed to a string format.

1 files changed, 42 insertions, 40 deletions

diff --git a/pp_pack.c b/pp_pack.c
index 7928315eb1..039bd26e6a 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -2082,6 +2082,23 @@ S_sv_exp_grow(pTHX_ SV *sv, STRLEN needed) {
     return SvGROW(sv, len+extend+1);
 }
 
+static void
+S_sv_check_inf(pTHX_ SV *sv, I32 datumtype)
+{
+    SvGETMAGIC(sv);
+    if (UNLIKELY(Perl_isinfnansv(sv))) {
+	const I32 c = TYPE_NO_MODIFIERS(datumtype);
+	const NV nv = SvNV_nomg(sv);
+	if (c == 'w')
+	    Perl_croak(aTHX_ "Cannot compress %"NVgf" in pack", nv);
+	else
+	    Perl_croak(aTHX_ "Cannot pack %"NVgf" with '%c'", nv, (int) c);
+    }
+}
+
+#define SvIV_no_inf(sv,d) (S_sv_check_inf(aTHX_ sv,d), SvIV_nomg(sv))
+#define SvUV_no_inf(sv,d) (S_sv_check_inf(aTHX_ sv,d), SvUV_nomg(sv))
+
 STATIC
 SV **
 S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
@@ -2164,22 +2181,6 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 
         needs_swap = NEEDS_SWAP(datumtype);
 
-        fromstr = PEEKFROM;
-        if (SvNOK(fromstr)) {
-            const NV nv = SvNV(fromstr);
-            if (UNLIKELY(Perl_isinfnan(nv))) {
-                const I32 c = TYPE_NO_MODIFIERS(datumtype);
-                if (!strchr("fdFD", (char)c)) { /* floats are okay */
-                    if (c == 'w')
-                        Perl_croak(aTHX_
-                                   "Cannot compress %"NVgf" in pack", nv);
-                    else
-                        Perl_croak(aTHX_ "Cannot pack %"NVgf" with '%c'",
-                                   nv, (int) c);
-                }
-            }
-        }
-
 	/* Code inside the switch must take care to properly update
 	   cat (CUR length and '\0' termination) if it updated *cur and
 	   doesn't simply leave using break */
@@ -2201,7 +2202,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 		from = group ? start + group->strbeg : start;
 	    }
 	    fromstr = NEXTFROM;
-	    len = SvIV(fromstr);
+	    len = SvIV_no_inf(fromstr, datumtype);
 	    goto resize;
 	case '@' | TYPE_IS_SHRIEKING:
 	case '@':
@@ -2569,7 +2570,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		IV aiv;
 		fromstr = NEXTFROM;
-                aiv = SvIV(fromstr);
+                aiv = SvIV_no_inf(fromstr, datumtype);
 		if ((-128 > aiv || aiv > 127))
 		    Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
 				   "Character in 'c' format wrapped in pack");
@@ -2584,7 +2585,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		IV aiv;
 		fromstr = NEXTFROM;
-                aiv = SvIV(fromstr);
+                aiv = SvIV_no_inf(fromstr, datumtype);
 		if ((0 > aiv || aiv > 0xff))
 		    Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
 				   "Character in 'C' format wrapped in pack");
@@ -2600,7 +2601,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		UV auv;
 		fromstr = NEXTFROM;
-		auv = SvUV(fromstr);
+		auv = SvUV_no_inf(fromstr, datumtype);
 		if (in_bytes) auv = auv % 0x100;
 		if (utf8) {
 		  W_utf8:
@@ -2662,7 +2663,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		UV auv;
 		fromstr = NEXTFROM;
-		auv = SvUV(fromstr);
+		auv = SvUV_no_inf(fromstr, datumtype);
 		if (utf8) {
 		    U8 buffer[UTF8_MAXLEN], *endb;
 		    endb = uvchr_to_utf8_flags(buffer, auv,
@@ -2772,7 +2773,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		I16 ai16;
 		fromstr = NEXTFROM;
-		ai16 = (I16)SvIV(fromstr);
+		ai16 = (I16)SvIV_no_inf(fromstr, datumtype);
 		ai16 = PerlSock_htons(ai16);
                 PUSH16(utf8, cur, &ai16, FALSE);
 	    }
@@ -2782,7 +2783,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		I16 ai16;
 		fromstr = NEXTFROM;
-		ai16 = (I16)SvIV(fromstr);
+		ai16 = (I16)SvIV_no_inf(fromstr, datumtype);
 		ai16 = htovs(ai16);
                 PUSH16(utf8, cur, &ai16, FALSE);
 	    }
@@ -2792,7 +2793,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		unsigned short aushort;
 		fromstr = NEXTFROM;
-		aushort = SvUV(fromstr);
+		aushort = SvUV_no_inf(fromstr, datumtype);
                 PUSH_VAR(utf8, cur, aushort, needs_swap);
 	    }
             break;
@@ -2803,7 +2804,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		U16 au16;
 		fromstr = NEXTFROM;
-		au16 = (U16)SvUV(fromstr);
+		au16 = (U16)SvUV_no_inf(fromstr, datumtype);
                 PUSH16(utf8, cur, &au16, needs_swap);
 	    }
 	    break;
@@ -2812,7 +2813,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		short ashort;
 		fromstr = NEXTFROM;
-		ashort = SvIV(fromstr);
+		ashort = SvIV_no_inf(fromstr, datumtype);
                 PUSH_VAR(utf8, cur, ashort, needs_swap);
 	    }
             break;
@@ -2823,7 +2824,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		I16 ai16;
 		fromstr = NEXTFROM;
-		ai16 = (I16)SvIV(fromstr);
+		ai16 = (I16)SvIV_no_inf(fromstr, datumtype);
                 PUSH16(utf8, cur, &ai16, needs_swap);
 	    }
 	    break;
@@ -2832,7 +2833,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		unsigned int auint;
 		fromstr = NEXTFROM;
-		auint = SvUV(fromstr);
+		auint = SvUV_no_inf(fromstr, datumtype);
                 PUSH_VAR(utf8, cur, auint, needs_swap);
 	    }
 	    break;
@@ -2840,7 +2841,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		IV aiv;
 		fromstr = NEXTFROM;
-		aiv = SvIV(fromstr);
+		aiv = SvIV_no_inf(fromstr, datumtype);
                 PUSH_VAR(utf8, cur, aiv, needs_swap);
 	    }
 	    break;
@@ -2848,7 +2849,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		UV auv;
 		fromstr = NEXTFROM;
-		auv = SvUV(fromstr);
+		auv = SvUV_no_inf(fromstr, datumtype);
                 PUSH_VAR(utf8, cur, auv, needs_swap);
 	    }
 	    break;
@@ -2856,7 +2857,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
             while (len-- > 0) {
 		NV anv;
 		fromstr = NEXTFROM;
-		anv = SvNV(fromstr);
+		S_sv_check_inf(fromstr, datumtype);
+		anv = SvNV_nomg(fromstr);
 
 		if (anv < 0) {
 		    *cur = '\0';
@@ -2944,7 +2946,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		int aint;
 		fromstr = NEXTFROM;
-		aint = SvIV(fromstr);
+		aint = SvIV_no_inf(fromstr, datumtype);
                 PUSH_VAR(utf8, cur, aint, needs_swap);
 	    }
 	    break;
@@ -2953,7 +2955,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		U32 au32;
 		fromstr = NEXTFROM;
-		au32 = SvUV(fromstr);
+		au32 = SvUV_no_inf(fromstr, datumtype);
 		au32 = PerlSock_htonl(au32);
                 PUSH32(utf8, cur, &au32, FALSE);
 	    }
@@ -2963,7 +2965,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		U32 au32;
 		fromstr = NEXTFROM;
-		au32 = SvUV(fromstr);
+		au32 = SvUV_no_inf(fromstr, datumtype);
 		au32 = htovl(au32);
                 PUSH32(utf8, cur, &au32, FALSE);
 	    }
@@ -2973,7 +2975,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		unsigned long aulong;
 		fromstr = NEXTFROM;
-		aulong = SvUV(fromstr);
+		aulong = SvUV_no_inf(fromstr, datumtype);
                 PUSH_VAR(utf8, cur, aulong, needs_swap);
 	    }
 	    break;
@@ -2984,7 +2986,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		U32 au32;
 		fromstr = NEXTFROM;
-		au32 = SvUV(fromstr);
+		au32 = SvUV_no_inf(fromstr, datumtype);
                 PUSH32(utf8, cur, &au32, needs_swap);
 	    }
 	    break;
@@ -2993,7 +2995,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		long along;
 		fromstr = NEXTFROM;
-		along = SvIV(fromstr);
+		along = SvIV_no_inf(fromstr, datumtype);
                 PUSH_VAR(utf8, cur, along, needs_swap);
 	    }
 	    break;
@@ -3004,7 +3006,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
             while (len-- > 0) {
 		I32 ai32;
 		fromstr = NEXTFROM;
-		ai32 = SvIV(fromstr);
+		ai32 = SvIV_no_inf(fromstr, datumtype);
                 PUSH32(utf8, cur, &ai32, needs_swap);
 	    }
 	    break;
@@ -3013,7 +3015,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		Uquad_t auquad;
 		fromstr = NEXTFROM;
-		auquad = (Uquad_t) SvUV(fromstr);
+		auquad = (Uquad_t) SvUV_no_inf(fromstr, datumtype);
                 PUSH_VAR(utf8, cur, auquad, needs_swap);
 	    }
 	    break;
@@ -3021,7 +3023,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		Quad_t aquad;
 		fromstr = NEXTFROM;
-		aquad = (Quad_t)SvIV(fromstr);
+		aquad = (Quad_t)SvIV_no_inf(fromstr, datumtype);
                 PUSH_VAR(utf8, cur, aquad, needs_swap);
 	    }
 	    break;