pack c/C on inf/nan.

[perl5.git] / pp_pack.c

diff --git a/pp_pack.c b/pp_pack.c
index a622d92..d35a5af 100644 (file)
--- 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;