From 69974ce61d7459da5eda22eb31d730128757db37 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sat, 31 Dec 2011 23:24:57 -0800 Subject: [perl #103492] Give lvalue cx to (s)printf args MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Or potential lvalue context, like function calls. The %n format code’s existence renders these two very much like func- tion calls, as they can modify their arguments. This allows sprintf("...%n", substr ...) to work. --- ext/B/t/optree_constants.t | 27 +++++++++++++++------------ op.c | 3 +++ opcode.h | 2 +- regen/opcodes | 2 +- t/io/print.t | 7 ++++++- t/op/sprintf.t | 1 + 6 files changed, 27 insertions(+), 15 deletions(-) diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t index c0b6f99553..7c109f0d85 100644 --- a/ext/B/t/optree_constants.t +++ b/ext/B/t/optree_constants.t @@ -211,25 +211,28 @@ my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT'); # - <@> lineseq KP ->9 # 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2 # 8 <@> prtf sK ->9 -# 2 <0> pushmark s ->3 -# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4 -# 4 <$> const[IV 42] s* ->5 -# 5 <$> const[PV "hithere"] s* ->6 -# 6 <$> const[NV 1.414213] s* ->7 -# 7 <$> const[NV 3.14159] s* ->8 +# 2 <0> pushmark sM ->3 +# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM ->4 +# 4 <$> const[IV 42] sM* ->5 +# 5 <$> const[PV "hithere"] sM* ->6 +# 6 <$> const[NV 1.414213] sM* ->7 +# 7 <$> const[NV 3.14159] sM* ->8 EOT_EOT # 9 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->9 # 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2 # 8 <@> prtf sK ->9 -# 2 <0> pushmark s ->3 -# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4 -# 4 <$> const(IV 42) s* ->5 -# 5 <$> const(PV "hithere") s* ->6 -# 6 <$> const(NV 1.414213) s* ->7 -# 7 <$> const(NV 3.14159) s* ->8 +# 2 <0> pushmark sM ->3 +# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") sM ->4 +# 4 <$> const(IV 42) sM* ->5 +# 5 <$> const(PV "hithere") sM* ->6 +# 6 <$> const(NV 1.414213) sM* ->7 +# 7 <$> const(NV 3.14159) sM* ->8 EONT_EONT +if($] < 5.015) { + s/M(?=\*? ->)//g for $expect, $expect_nt; +} if($] < 5.009) { # 5.8.x's use constant has larger types foreach ($expect, $expect_nt) { diff --git a/op.c b/op.c index 7f217e70f4..44f3e186b0 100644 --- a/op.c +++ b/op.c @@ -1731,6 +1731,8 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) assert( (o->op_flags & OPf_WANT) != OPf_WANT_VOID ); + if (type == OP_PRTF || type == OP_SPRINTF) type = OP_ENTERSUB; + switch (o->op_type) { case OP_UNDEF: localize = 0; @@ -8295,6 +8297,7 @@ Perl_ck_listiob(pTHX_ OP *o) if (!kid) op_append_elem(o->op_type, o, newDEFSVOP()); + if (o->op_type == OP_PRTF) return modkids(listkids(o), OP_PRTF); return listkids(o); } diff --git a/opcode.h b/opcode.h index 709e92c431..5f242a01a3 100644 --- a/opcode.h +++ b/opcode.h @@ -1430,7 +1430,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */ Perl_ck_fun, /* vec */ Perl_ck_index, /* index */ Perl_ck_index, /* rindex */ - Perl_ck_fun, /* sprintf */ + Perl_ck_lfun, /* sprintf */ Perl_ck_fun, /* formline */ Perl_ck_fun, /* ord */ Perl_ck_fun, /* chr */ diff --git a/regen/opcodes b/regen/opcodes index 353bcc68d8..23f6d2852a 100644 --- a/regen/opcodes +++ b/regen/opcodes @@ -199,7 +199,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 fmst@ S L +sprintf sprintf ck_lfun fmst@ 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/io/print.t b/t/io/print.t index 321eb1e85b..00ee7fb591 100644 --- a/t/io/print.t +++ b/t/io/print.t @@ -10,7 +10,7 @@ BEGIN { use strict 'vars'; -print "1..21\n"; +print "1..23\n"; my $foo = 'STDOUT'; print $foo "ok 1\n"; @@ -66,3 +66,8 @@ if (!exists &Errno::EBADF) { map print(+()), ('')x68; print "ok 21\n"; } + +# printf with %n +my $n = "abc"; +printf "ok 22%n - not really a test; just printing\n", substr $n,1,1; +print "not " x ($n ne "a5c") . "ok 23 - printf with %n (got $n)\n"; diff --git a/t/op/sprintf.t b/t/op/sprintf.t index b8c8bced4c..de1079e2d7 100644 --- a/t/op/sprintf.t +++ b/t/op/sprintf.t @@ -436,6 +436,7 @@ __END__ >%l< >''< >%l INVALID< >%m< >''< >%m INVALID< >%s< >sprintf('%%n%n %d', $n, $n)< >%n 2< >Slight sneakiness to test %n< +>%s< >$n="abc"; sprintf(' %n%s', substr($n,1,1), $n)< > a1c< >%n w/magic< >%o< >2**32-1< >37777777777< >%+o< >2**32-1< >37777777777< >%#o< >2**32-1< >037777777777< -- cgit v1.2.1