From dd9a6ccfcb1b5e26680c14c1663ea9fac4480690 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Fri, 13 Jul 2012 18:10:38 -0700
Subject: [PATCH 1/1] [perl #113470] Constant folding for pack
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

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.
---
 op.c            | 16 ++++++++++++++++
 opcode.h        |  2 +-
 regen/opcodes   |  2 +-
 t/comp/bproto.t |  3 ++-
 4 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/op.c b/op.c
index 7396a19..d6cf1a2 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 217cb56..2c7db83 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 8666d8c..da2212a 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 cd66278..8d11b91 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/,
-- 
1.8.3.1