In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/511123483773b6f7ed07860443437bc45ecd4ead?hp=aba33b8a16881a79d8ef8ab7e7786e35cb84e6ae>
- Log -----------------------------------------------------------------
commit 511123483773b6f7ed07860443437bc45ecd4ead
Author: Father Chrysostomos <spr...@cpan.org>
Date: Wed Jul 4 18:25:33 2012 -0700
Increase $B::Concise::VERSION to 0.91
M ext/B/B/Concise.pm
commit 01050d49181679ee39712302d1af475c0d7549a4
Author: Father Chrysostomos <spr...@cpan.org>
Date: Wed Jul 4 18:22:09 2012 -0700
[perl #78064] print(const || bare) and const folding
Constant folding should not be able to change the meaning of print
followed by || or && or ?: with barewords as operands.
The previous commit recorded which constant ops are the result of con-
stant folding (including collapsing of conditionals).
This commit uses that information (OpCONST_FOLDED) to fix this.
M op.c
M t/comp/fold.t
commit cc2ebcd790252079cb9b33d2eef133701a7eb63e
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Apr 30 18:18:03 2012 -0700
Record folded constants in the op tree
M dump.c
M ext/B/B/Concise.pm
M ext/B/t/optree_constants.t
M ext/B/t/optree_samples.t
M op.c
M op.h
M toke.c
-----------------------------------------------------------------------
Summary of changes:
dump.c | 3 ++
ext/B/B/Concise.pm | 6 ++--
ext/B/t/optree_constants.t | 52 ++++++++++++++++++++++----------------------
ext/B/t/optree_samples.t | 4 +-
op.c | 10 ++++++-
op.h | 1 +
t/comp/fold.t | 16 ++++++++++++-
toke.c | 2 +-
8 files changed, 59 insertions(+), 35 deletions(-)
diff --git a/dump.c b/dump.c
index b5240fb..ad3b960 100644
--- a/dump.c
+++ b/dump.c
@@ -745,6 +745,7 @@ const struct flag_to_name op_const_names[] = {
{OPpCONST_SHORTCIRCUIT, ",SHORTCIRCUIT"},
{OPpCONST_STRICT, ",STRICT"},
{OPpCONST_ENTERED, ",ENTERED"},
+ {OPpCONST_FOLDED, ",FOLDED"},
{OPpCONST_BARE, ",BARE"}
};
@@ -2923,6 +2924,8 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const
OP *o)
sv_catpv(tmpsv, ",STRICT");
if (o->op_private & OPpCONST_ENTERED)
sv_catpv(tmpsv, ",ENTERED");
+ if (o->op_private & OPpCONST_FOLDED)
+ sv_catpv(tmpsv, ",FOLDED");
}
else if (o->op_type == OP_FLIP) {
if (o->op_private & OPpFLIP_LINENUM)
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 26fb34d..0dd9670 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp
use Exporter (); # use #5
-our $VERSION = "0.90";
+our $VERSION = "0.91";
our @ISA = qw(Exporter);
our @EXPORT_OK = qw( set_style set_style_standard add_callback
concise_subref concise_cv concise_main
@@ -635,8 +635,8 @@ $priv{$_}{16} = "TARGMY"
"exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority",
"setpriority", "time", "sleep");
$priv{$_}{4} = "REVERSED" for ("enteriter", "iter");
-@{$priv{"const"}}{2,4,8,16,64} =
- ("NOVER","SHORT","STRICT","ENTERED","BARE");
+@{$priv{"const"}}{2,4,8,16,64,128} =
+ ("NOVER","SHORT","STRICT","ENTERED","BARE","FOLD");
$priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM";
$priv{"list"}{64} = "GUESSED";
$priv{"delete"}{64} = "SLICE";
diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t
index ebcf042..a986193 100644
--- a/ext/B/t/optree_constants.t
+++ b/ext/B/t/optree_constants.t
@@ -110,12 +110,12 @@ for $func (sort keys %$want) {
3 <1> leavesub[2 refs] K/REFC,1 ->(end)
- <\@> lineseq KP ->3
1 <;> dbstate(main 833 (eval 44):1) v ->2
-2 <\$> const[$want->{$func}[0] $want->{$func}[1]] s* ->3
+2 <\$> const[$want->{$func}[0] $want->{$func}[1]] s*/FOLD ->3
EOT_EOT
3 <1> leavesub[2 refs] K/REFC,1 ->(end)
- <\@> lineseq KP ->3
1 <;> dbstate(main 833 (eval 44):1) v ->2
-2 <\$> const($want->{$func}[0] $want->{$func}[1]) s* ->3
+2 <\$> const($want->{$func}[0] $want->{$func}[1]) s*/FOLD ->3
EONT_EONT
}
@@ -143,14 +143,14 @@ checkOptree ( name => 'myyes() as coderef',
# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
# 5 <@> print vK ->6
# 3 <0> pushmark s ->4
-# 4 <$> const[SPECIAL sv_yes] s* ->5
+# 4 <$> const[SPECIAL sv_yes] s*/FOLD ->5
EOT_EOT
# 6 <@> leave[1 ref] vKP/REFC ->(end)
# 1 <0> enter ->2
# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
# 5 <@> print vK ->6
# 3 <0> pushmark s ->4
-# 4 <$> const(SPECIAL sv_yes) s* ->5
+# 4 <$> const(SPECIAL sv_yes) s*/FOLD ->5
EONT_EONT
@@ -167,14 +167,14 @@ checkOptree ( name => 'myno() as coderef',
# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
# 5 <@> print vK ->6
# 3 <0> pushmark s ->4
-# 4 <$> const[SPECIAL sv_no] s* ->5
+# 4 <$> const[SPECIAL sv_no] s*/FOLD ->5
EOT_EOT
# 6 <@> leave[1 ref] vKP/REFC ->(end)
# 1 <0> enter ->2
# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
# 5 <@> print vK ->6
# 3 <0> pushmark s ->4
-# 4 <$> const(SPECIAL sv_no) s* ->5
+# 4 <$> const(SPECIAL sv_no) s*/FOLD ->5
EONT_EONT
@@ -212,22 +212,22 @@ my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
# 8 <@> prtf sK ->9
# 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
+# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM/FOLD ->4
+# 4 <$> const[IV 42] sM*/FOLD ->5
+# 5 <$> const[PV "hithere"] sM*/FOLD ->6
+# 6 <$> const[NV 1.414213] sM*/FOLD ->7
+# 7 <$> const[NV 3.14159] sM*/FOLD ->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 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
+# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") sM/FOLD ->4
+# 4 <$> const(IV 42) sM*/FOLD ->5
+# 5 <$> const(PV "hithere") sM*/FOLD ->6
+# 6 <$> const(NV 1.414213) sM*/FOLD ->7
+# 7 <$> const(NV 3.14159) sM*/FOLD ->8
EONT_EONT
if($] < 5.015) {
@@ -257,14 +257,14 @@ checkOptree ( name => 'arithmetic constant folding
in print',
# 1 <;> nextstate(main 937 (eval 53):1) v ->2
# 4 <@> print sK ->5
# 2 <0> pushmark s ->3
-# 3 <$> const[IV 6] s ->4
+# 3 <$> const[IV 6] s/FOLD ->4
EOT_EOT
# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->5
# 1 <;> nextstate(main 937 (eval 53):1) v ->2
# 4 <@> print sK ->5
# 2 <0> pushmark s ->3
-# 3 <$> const(IV 6) s ->4
+# 3 <$> const(IV 6) s/FOLD ->4
EONT_EONT
checkOptree ( name => 'string constant folding in print',
@@ -276,14 +276,14 @@ checkOptree ( name => 'string constant folding in
print',
# 1 <;> nextstate(main 942 (eval 55):1) v ->2
# 4 <@> print sK ->5
# 2 <0> pushmark s ->3
-# 3 <$> const[PV "foobar"] s ->4
+# 3 <$> const[PV "foobar"] s/FOLD ->4
EOT_EOT
# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->5
# 1 <;> nextstate(main 942 (eval 55):1) v ->2
# 4 <@> print sK ->5
# 2 <0> pushmark s ->3
-# 3 <$> const(PV "foobar") s ->4
+# 3 <$> const(PV "foobar") s/FOLD ->4
EONT_EONT
checkOptree ( name => 'boolean or folding',
@@ -321,7 +321,7 @@ checkOptree ( name => 'lc*,uc*,gt,lt,ge,le,cmp',
# - <@> lineseq KP ->r
# 1 <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
# 4 <2> sassign vKS/2 ->5
-# 2 <$> const[PV "FOO.Bar.low.lOW"] s ->3
+# 2 <$> const[PV "FOO.Bar.low.lOW"] s/FOLD ->3
# - <1> ex-rv2sv sKRM*/1 ->4
# 3 <#> gvsv[*s] s ->4
# 5 <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
@@ -345,13 +345,13 @@ checkOptree ( name => 'lc*,uc*,gt,lt,ge,le,cmp',
# m <0> pushmark s ->n
# n <$> const[PV "b-cmp-a"] s ->o
# p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
-# q <$> const[PVNV 0] s/SHORT ->r
+# q <$> const[PVNV 0] s/FOLD,SHORT ->r
EOT_EOT
# r <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->r
# 1 <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
# 4 <2> sassign vKS/2 ->5
-# 2 <$> const(PV "FOO.Bar.low.lOW") s ->3
+# 2 <$> const(PV "FOO.Bar.low.lOW") s/FOLD ->3
# - <1> ex-rv2sv sKRM*/1 ->4
# 3 <$> gvsv(*s) s ->4
# 5 <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
@@ -375,7 +375,7 @@ EOT_EOT
# m <0> pushmark s ->n
# n <$> const(PV "b-cmp-a") s ->o
# p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
-# q <$> const(SPECIAL sv_no) s/SHORT ->r
+# q <$> const(SPECIAL sv_no) s/FOLD,SHORT ->r
EONT_EONT
checkOptree ( name => 'mixed constant folding, with explicit braces',
@@ -387,14 +387,14 @@ checkOptree ( name => 'mixed constant folding,
with explicit braces',
# 1 <;> nextstate(main 977 (eval 28):1) v ->2
# 4 <@> print sK ->5
# 2 <0> pushmark s ->3
-# 3 <$> const[PV "foobar5"] s ->4
+# 3 <$> const[PV "foobar5"] s/FOLD ->4
EOT_EOT
# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->5
# 1 <;> nextstate(main 977 (eval 28):1) v ->2
# 4 <@> print sK ->5
# 2 <0> pushmark s ->3
-# 3 <$> const(PV "foobar5") s ->4
+# 3 <$> const(PV "foobar5") s/FOLD ->4
EONT_EONT
__END__
diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t
index 3e0b7f8..5db514c 100644
--- a/ext/B/t/optree_samples.t
+++ b/ext/B/t/optree_samples.t
@@ -617,14 +617,14 @@ checkOptree ( name => '-e use constant j =>
qq{junk}; print j',
# 1 <0> enter
# 2 <;> nextstate(main 71 -e:1) v:>,<,%,{
# 3 <0> pushmark s
-# 4 <$> const[PV "junk"] s*
+# 4 <$> const[PV "junk"] s*/FOLD
# 5 <@> print vK
# 6 <@> leave[1 ref] vKP/REFC
EOT_EOT
# 1 <0> enter
# 2 <;> nextstate(main 71 -e:1) v:>,<,%,{
# 3 <0> pushmark s
-# 4 <$> const(PV "junk") s*
+# 4 <$> const(PV "junk") s*/FOLD
# 5 <@> print vK
# 6 <@> leave[1 ref] vKP/REFC
EONT_EONT
diff --git a/op.c b/op.c
index 311f5a0..e353d5c 100644
--- a/op.c
+++ b/op.c
@@ -3329,7 +3329,7 @@ S_fold_constants(pTHX_ register OP *o)
if (type == OP_RV2GV)
newop = newGVOP(OP_GV, 0, MUTABLE_GV(sv));
else
- newop = newSVOP(OP_CONST, 0, MUTABLE_SV(sv));
+ newop = newSVOP(OP_CONST, OPpCONST_FOLDED<<8, MUTABLE_SV(sv));
op_getmad(o,newop,'f');
return newop;
@@ -4849,6 +4849,7 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
svop->op_sv = sv;
svop->op_next = (OP*)svop;
svop->op_flags = (U8)flags;
+ svop->op_private = (U8)(0 | (flags >> 8));
if (PL_opargs[type] & OA_RETSCALAR)
scalar((OP*)svop);
if (PL_opargs[type] & OA_TARGET)
@@ -5850,6 +5851,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP**
otherp)
|| other->op_type == OP_TRANS)
/* Mark the op as being unbindable with =~ */
other->op_flags |= OPf_SPECIAL;
+ else if (other->op_type == OP_CONST)
+ other->op_private |= OPpCONST_FOLDED;
return other;
}
else {
@@ -6007,6 +6010,8 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP
*falseop)
|| live->op_type == OP_TRANS || live->op_type == OP_TRANSR)
/* Mark the op as being unbindable with =~ */
live->op_flags |= OPf_SPECIAL;
+ else if (live->op_type == OP_CONST)
+ live->op_private |= OPpCONST_FOLDED;
return live;
}
NewOp(1101, logop, 1, LOGOP);
@@ -8816,7 +8821,8 @@ Perl_ck_listiob(pTHX_ OP *o)
if (kid && o->op_flags & OPf_STACKED)
kid = kid->op_sibling;
else if (kid && !kid->op_sibling) { /* print HANDLE; */
- if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
+ if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE
+ && !(kid->op_private & OPpCONST_FOLDED)) {
o->op_flags |= OPf_STACKED; /* make it a filehandle */
kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
cLISTOPo->op_first->op_sibling = kid;
diff --git a/op.h b/op.h
index 6bc6c82..1d4f571 100644
--- a/op.h
+++ b/op.h
@@ -258,6 +258,7 @@ Deprecated. Use C<GIMME_V> instead.
#define OPpCONST_STRICT 8 /* bareword subject to strict
'subs' */
#define OPpCONST_ENTERED 16 /* Has been entered as symbol. */
#define OPpCONST_BARE 64 /* Was a bare word (filehandle?). */
+#define OPpCONST_FOLDED 128 /* Result of constant folding */
/* Private for OP_FLIP/FLOP */
#define OPpFLIP_LINENUM 64 /* Range arg potentially a line
num. */
diff --git a/t/comp/fold.t b/t/comp/fold.t
index ec95f1a..69d1903 100644
--- a/t/comp/fold.t
+++ b/t/comp/fold.t
@@ -4,7 +4,7 @@
# we've not yet verified that use works.
# use strict;
-print "1..19\n";
+print "1..23\n";
my $test = 0;
# Historically constant folding was performed by evaluating the ops, and if
@@ -118,3 +118,17 @@ is ($@, '', 'no error');
ok scalar $jing =~ (0 || y/fo//),
'lone y/// is not bound via =~ after || folding';
}
+
+# [perl #78064] or print
+package other { # hide the "ok" sub
+ BEGIN { $^W = 0 }
+ print 0 ? not_ok : ok;
+ print " ", ++$test, " - print followed by const ? BEAR : BEAR\n";
+ print 1 ? ok : not_ok;
+ print " ", ++$test, " - print followed by const ? BEAR : BEAR (again)\n";
+ print 1 && ok;
+ print " ", ++$test, " - print followed by const && BEAR\n";
+ print 0 || ok;
+ print " ", ++$test, " - print followed by const || URSINE\n";
+ BEGIN { $^W = 1 }
+}
diff --git a/toke.c b/toke.c
index ddd4319..1fa09d1 100644
--- a/toke.c
+++ b/toke.c
@@ -6912,7 +6912,7 @@ Perl_yylex(pTHX)
op_free(rv2cv_op);
SvREFCNT_dec(((SVOP*)pl_yylval.opval)->op_sv);
((SVOP*)pl_yylval.opval)->op_sv =
SvREFCNT_inc_simple(sv);
- pl_yylval.opval->op_private = 0;
+ pl_yylval.opval->op_private = OPpCONST_FOLDED;
pl_yylval.opval->op_flags |= OPf_SPECIAL;
TOKEN(WORD);
}
--
Perl5 Master Repository
