Disable constant folding of sprintf

Message-ID: <lr8xv56p0d.fsf_-_@caliper.activestate.com>

p4raw-id: //depot/perl@26236

5 files changed, 14 insertions, 7 deletions

diff --git a/op.c b/op.c
index 8fd946aaed..6c32f66b90 100644
--- a/op.c
+++ b/op.c
@@ -2058,7 +2058,6 @@ Perl_fold_constants(pTHX_ register OP *o)
 	/* XXX might want a ck_negate() for this */
 	cUNOPo->op_first->op_private &= ~OPpCONST_STRICT;
 	break;
-    case OP_SPRINTF:
     case OP_UCFIRST:
     case OP_LCFIRST:
     case OP_UC:
diff --git a/opcode.h b/opcode.h
index 7cd088e8fb..587c138199 100644
--- a/opcode.h
+++ b/opcode.h
@@ -1611,7 +1611,7 @@ EXT const U32 PL_opargs[] = {
 	0x0022281c,	/* vec */
 	0x0122291c,	/* index */
 	0x0122291c,	/* rindex */
-	0x0004280f,	/* sprintf */
+	0x0004280d,	/* sprintf */
 	0x00042805,	/* formline */
 	0x0001379e,	/* ord */
 	0x0001378e,	/* chr */
diff --git a/opcode.pl b/opcode.pl
index ae7ee666d7..898a248aa7 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -691,7 +691,7 @@ vec		vec			ck_fun		ist@	S S S
 index		index			ck_index	isT@	S S S?
 rindex		rindex			ck_index	isT@	S S S?
 
-sprintf		sprintf			ck_fun		mfst@	S L
+sprintf		sprintf			ck_fun		mst@	S L
 formline	formline		ck_fun		ms@	S L
 ord		ord			ck_fun		ifsTu%	S?
 chr		chr			ck_fun		fsTu%	S?
diff --git a/t/lib/warnings/sv b/t/lib/warnings/sv
index a9636e0cf7..1f66a8db6c 100644
--- a/t/lib/warnings/sv
+++ b/t/lib/warnings/sv
@@ -299,12 +299,12 @@ $a = sprintf "%" ;
 printf F "%\x02" ;
 $a = sprintf "%\x02" ;
 EXPECT
-Invalid conversion in sprintf: "%z" at - line 5.
-Invalid conversion in sprintf: end of string at - line 7.
-Invalid conversion in sprintf: "%\002" at - line 9.
 Invalid conversion in printf: "%z" at - line 4.
+Invalid conversion in sprintf: "%z" at - line 5.
 Invalid conversion in printf: end of string at - line 6.
+Invalid conversion in sprintf: end of string at - line 7.
 Invalid conversion in printf: "%\002" at - line 8.
+Invalid conversion in sprintf: "%\002" at - line 9.
 ########
 # sv.c
 use warnings 'misc' ;
diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index 669938b86b..079df9314b 100644
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }   
 
-plan tests => 3;
+plan tests => 4;
 
 is(
     sprintf("%.40g ",0.01),
@@ -26,3 +26,11 @@ is(
 		q(width calculation under utf8 upgrade)
 	);
 }
+
+# Used to mangle PL_sv_undef
+fresh_perl_is(
+    'print sprintf "xxx%n\n"; print undef',
+    'Modification of a read-only value attempted at - line 1.',
+    { switches => [ '-w' ] },
+    q(%n should not be able to modify read-only constants),
+)