X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/148f39b7de6eae9ddd59e0b0aff691d6abea7aca..1f4ef0f182b07bd3c970ed636971821c8f754668:/pp_pack.c

diff --git a/pp_pack.c b/pp_pack.c
index a622d92..d35a5af 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -337,7 +337,6 @@ uni_to_bytes(pTHX_ const char **s, const char *end, const char *buf, int buf_len
 STATIC bool
 next_uni_uu(pTHX_ const char **s, const char *end, I32 *out)
 {
-    dVAR;
     STRLEN retlen;
     const UV val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen, UTF8_CHECK_ONLY);
     if (val >= 0x100 || !ISUUCHAR(val) ||
@@ -567,8 +566,7 @@ S_group_end(pTHX_ const char *patptr, const char *patend, char ender)
     }
     Perl_croak(aTHX_ "No group ending character '%c' found in template",
                ender);
-    /* NOTREACHED */
-    NOT_REACHED;
+    NOT_REACHED; /* NOTREACHED */
 }
 
 
@@ -863,7 +861,7 @@ Perl_unpackstring(pTHX_ const char *pat, const char *patend, const char *s, cons
 STATIC I32
 S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const char *strend, const char **new_s )
 {
-    dVAR; dSP;
+    dSP;
     SV *sv = NULL;
     const I32 start_sp_offset = SP - PL_stack_base;
     howlen_t howlen;
@@ -1843,7 +1841,6 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 
 PP(pp_unpack)
 {
-    dVAR;
     dSP;
     dPOPPOPssrl;
     I32 gimme = GIMME_V;
@@ -1976,7 +1973,6 @@ The engine implementing pack() Perl function.
 void
 Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, SV **beglist, SV **endlist )
 {
-    dVAR;
     tempsym_t sym;
 
     PERL_ARGS_ASSERT_PACKLIST;
@@ -2078,7 +2074,6 @@ STATIC
 SV **
 S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 {
-    dVAR;
     tempsym_t lookahead;
     I32 items  = endlist - beglist;
     bool found = next_symbol(symptr);
@@ -2545,7 +2540,15 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		IV aiv;
 		fromstr = NEXTFROM;
-		aiv = SvIV(fromstr);
+                if (SvNOK(fromstr) && Perl_isinfnan(SvNV(fromstr))) {
+                    /* 255 is a pretty arbitrary choice, but with
+                     * inf/-inf/nan and 256 bytes there is not much room. */
+                    aiv = 255;
+		    Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+				   "Character in 'c' format overflow in pack");
+                }
+                else
+                    aiv = SvIV(fromstr);
 		if ((-128 > aiv || aiv > 127))
 		    Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
 				   "Character in 'c' format wrapped in pack");
@@ -2560,7 +2563,14 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		IV aiv;
 		fromstr = NEXTFROM;
-		aiv = SvIV(fromstr);
+                if (SvNOK(fromstr) && Perl_isinfnan(SvNV(fromstr))) {
+                    /* See the 'c' case. */
+                    aiv = 255;
+		    Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+				   "Character in 'C' format overflow in pack");
+                }
+                else
+                    aiv = SvIV(fromstr);
 		if ((0 > aiv || aiv > 0xff))
 		    Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
 				   "Character in 'C' format wrapped in pack");
@@ -3093,7 +3103,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 
 PP(pp_pack)
 {
-    dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+    dSP; dMARK; dORIGMARK; dTARGET;
     SV *cat = TARG;
     STRLEN fromlen;
     SV *pat_sv = *++MARK;