[perl #113470] Constant folding for pack

This takes the pessimistic approach of skipping it for any first argu-
ment that is not a plain non-magical PV, just in case there is a 'p'
or 'P' in the stringified form.

Otherwise it scans the PV for 'p' or 'P' and skips the folding if either
is present.

Then it falls through to the usual op-filtering logic.

I nearly made ‘pack;’ crash, so I added a test to bproto.t.

diff --git a/op.c b/op.c
index 7396a19..d6cf1a2 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3139,6 +3139,22 @@ S_fold_constants(pTHX_ register OP *o)
        if (IN_LOCALE_COMPILETIME)
            goto nope;
        break;
+    case OP_PACK:
+       if (!cLISTOPo->op_first->op_sibling
+         || cLISTOPo->op_first->op_sibling->op_type != OP_CONST)
+           goto nope;
+       {
+           SV * const sv = cSVOPx_sv(cLISTOPo->op_first->op_sibling);
+           if (!SvPOK(sv) || SvGMAGICAL(sv)) goto nope;
+           {
+               const char *s = SvPVX_const(sv);
+               while (s < SvEND(sv)) {
+                   if (*s == 'p' || *s == 'P') goto nope;
+                   s++;
+               }
+           }
+       }
+       break;
     case OP_REPEAT:
        if (o->op_private & OPpREPEAT_DOLIST) goto nope;
     }

diff --git a/opcode.h b/opcode.h
index 217cb56..2c7db83 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1847,7 +1847,7 @@ EXTCONST U32 PL_opargs[] = {
        0x00024401,     /* hslice */
        0x00004b00,     /* boolkeys */
        0x00091480,     /* unpack */
-       0x0002140d,     /* pack */
+       0x0002140f,     /* pack */
        0x00111408,     /* split */
        0x0002140d,     /* join */
        0x00002401,     /* list */

diff --git a/regen/opcodes b/regen/opcodes
index 8666d8c..da2212a 100644 (file)
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -237,7 +237,7 @@ boolkeys    boolkeys                ck_fun          %       H
 # Explosives and implosives.
 
 unpack         unpack                  ck_fun          u@      S S?
-pack           pack                    ck_fun          mst@    S L
+pack           pack                    ck_fun          fmst@   S L
 split          split                   ck_split        t@      S S S
 join           join or string          ck_join         mst@    S L
 

diff --git a/t/comp/bproto.t b/t/comp/bproto.t
index cd66278..8d11b91 100644 (file)
--- a/t/comp/bproto.t
+++ b/t/comp/bproto.t
@@ -8,7 +8,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..15\n";
+print "1..16\n";
 
 my $i = 1;
 
@@ -42,6 +42,7 @@ q[    defined(&foo, $bar);
 
 test_too_few($_) for split /\n/,
 q[     unpack;
+       pack;
 ];
 
 test_no_error($_) for split /\n/,