[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.

4 files changed, 20 insertions, 3 deletions

diff --git a/op.c b/op.c
index 7396a19c59..d6cf1a281d 100644
--- 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 217cb56481..2c7db8383a 100644
--- 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 8666d8c924..da2212a142 100644
--- 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 cd66278b72..8d11b915c1 100644
--- 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/,