sR |OP* |search_const |NN OP *o
sR |OP* |new_logop |I32 type|I32 flags|NN OP **firstp|NN OP **otherp
s |void |simplify_sort |NN OP *o
+s |void |null_listop_in_list_context |NN OP* o
s |SV* |gv_ename |NN GV *gv
sRn |bool |scalar_mod_type|NULLOK const OP *o|I32 type
s |OP * |my_kid |NULLOK OP *o|NULLOK OP *attrs|NN OP **imopsp
#define new_logop(a,b,c,d) S_new_logop(aTHX_ a,b,c,d)
#define no_bareword_allowed(a) S_no_bareword_allowed(aTHX_ a)
#define no_fh_allowed(a) S_no_fh_allowed(aTHX_ a)
+#define null_listop_in_list_context(a) S_null_listop_in_list_context(aTHX_ a)
#define op_integerize(a) S_op_integerize(aTHX_ a)
#define op_std_init(a) S_op_std_init(aTHX_ a)
#define pmtrans(a,b,c) S_pmtrans(aTHX_ a,b,c)
# 8 <0> enter l
# 9 <;> nextstate(main 475 (eval 10):1) v:{
# a <0> pushmark s
-# b <0> pushmark s
-# c <#> gvsv[*_] s
-# d <#> gv[*getkey] s/EARLYCV
-# e <1> entersub[t5] lKS/TARG
-# f <#> gvsv[*_] s
-# g <@> list lK
-# h <@> leave lKP
+# b <#> gvsv[*_] s
+# c <#> gv[*getkey] s/EARLYCV
+# d <1> entersub[t5] lKS/TARG
+# e <#> gvsv[*_] s
+# f <@> leave lKP
# goto 7
-# i <0> pushmark s
-# j <#> gv[*hash] s
-# k <1> rv2hv[t2] lKRM*/1 < 5.019006
-# k <1> rv2hv lKRM*/1 >=5.019006
-# l <2> aassign[t10] KS/COMMON
-# m <1> leavesub[1 ref] K/REFC,1
+# g <0> pushmark s
+# h <#> gv[*hash] s
+# i <1> rv2hv[t2] lKRM*/1 < 5.019006
+# i <1> rv2hv lKRM*/1 >=5.019006
+# j <2> aassign[t10] KS/COMMON
+# k <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 560 (eval 15):1) v:{
# 2 <0> pushmark s
# 8 <0> enter l
# 9 <;> nextstate(main 559 (eval 15):1) v:{
# a <0> pushmark s
-# b <0> pushmark s
-# c <$> gvsv(*_) s
-# d <$> gv(*getkey) s/EARLYCV
-# e <1> entersub[t2] lKS/TARG
-# f <$> gvsv(*_) s
-# g <@> list lK
-# h <@> leave lKP
+# b <$> gvsv(*_) s
+# c <$> gv(*getkey) s/EARLYCV
+# d <1> entersub[t2] lKS/TARG
+# e <$> gvsv(*_) s
+# f <@> leave lKP
# goto 7
-# i <0> pushmark s
-# j <$> gv(*hash) s
-# k <1> rv2hv[t1] lKRM*/1 < 5.019006
-# k <1> rv2hv lKRM*/1 >=5.019006
-# l <2> aassign[t5] KS/COMMON
-# m <1> leavesub[1 ref] K/REFC,1
+# g <0> pushmark s
+# h <$> gv(*hash) s
+# i <1> rv2hv[t1] lKRM*/1 < 5.019006
+# i <1> rv2hv lKRM*/1 >=5.019006
+# j <2> aassign[t5] KS/COMMON
+# k <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 8 <0> enter l
# 9 <;> nextstate(main 500 (eval 22):1) v:{
# a <0> pushmark s
-# b <0> pushmark s
-# c <#> gvsv[*_] s
-# d <#> gv[*getkey] s/EARLYCV
-# e <1> entersub[t5] lKS/TARG
-# f <#> gvsv[*_] s
-# g <@> list lK
-# h <@> leave lKP
+# b <#> gvsv[*_] s
+# c <#> gv[*getkey] s/EARLYCV
+# d <1> entersub[t5] lKS/TARG
+# e <#> gvsv[*_] s
+# f <@> leave lKP
# goto 7
-# i <0> pushmark s
-# j <#> gv[*h] s
-# k <1> rv2hv[t2] lKRM*/1 < 5.019006
-# k <1> rv2hv lKRM*/1 >=5.019006
-# l <2> aassign[t10] KS/COMMON
-# m <1> leavesub[1 ref] K/REFC,1
+# g <0> pushmark s
+# h <#> gv[*h] s
+# i <1> rv2hv[t2] lKRM*/1 < 5.019006
+# i <1> rv2hv lKRM*/1 >=5.019006
+# j <2> aassign[t10] KS/COMMON
+# k <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 501 (eval 22):1) v:{
# 2 <0> pushmark s
# 8 <0> enter l
# 9 <;> nextstate(main 500 (eval 22):1) v:{
# a <0> pushmark s
-# b <0> pushmark s
-# c <$> gvsv(*_) s
-# d <$> gv(*getkey) s/EARLYCV
-# e <1> entersub[t2] lKS/TARG
-# f <$> gvsv(*_) s
-# g <@> list lK
-# h <@> leave lKP
+# b <$> gvsv(*_) s
+# c <$> gv(*getkey) s/EARLYCV
+# d <1> entersub[t2] lKS/TARG
+# e <$> gvsv(*_) s
+# f <@> leave lKP
# goto 7
-# i <0> pushmark s
-# j <$> gv(*h) s
-# k <1> rv2hv[t1] lKRM*/1 < 5.019006
-# k <1> rv2hv lKRM*/1 >=5.019006
-# l <2> aassign[t5] KS/COMMON
-# m <1> leavesub[1 ref] K/REFC,1
+# g <0> pushmark s
+# h <$> gv(*h) s
+# i <1> rv2hv[t1] lKRM*/1 < 5.019006
+# i <1> rv2hv lKRM*/1 >=5.019006
+# j <2> aassign[t5] KS/COMMON
+# k <1> leavesub[1 ref] K/REFC,1
EONT_EONT
checkOptree ( name => '%h=(); for $_(@a){$h{getkey($_)} = $_}',
return "eval {\n\t" . $self->pp_leave(@_) . "\n\b}";
}
+sub _op_is_or_was {
+ my ($op, $expect_type) = @_;
+ my $type = $op->type;
+ return($type == $expect_type
+ || ($type == OP_NULL && $op->targ == $expect_type));
+}
+
sub pp_null {
my $self = shift;
my($op, $cx) = @_;
if (class($op) eq "OP") {
# old value is lost
return $self->{'ex_const'} if $op->targ == OP_CONST;
- } elsif ($op->first->name eq "pushmark") {
+ } elsif ($op->first->name eq 'pushmark'
+ or $op->first->name eq 'null'
+ && $op->first->targ == OP_PUSHMARK
+ && _op_is_or_was($op, OP_LIST)) {
return $self->pp_list($op, $cx);
} elsif ($op->first->name eq "enter") {
return $self->pp_leave($op, $cx);
case OP_RVALUES:
return;
}
+
+ /* Don't warn if we have a nulled list either. */
+ if (kid->op_type == OP_NULL && kid->op_targ == OP_LIST)
+ return;
+
assert(kid->op_sibling);
name = S_op_varname(aTHX_ kid->op_sibling);
if (!name) /* XS module fiddling with the op tree */
S_scalar_slice_warning(aTHX_ o);
case OP_KVHSLICE:
+ kid = cLISTOPo->op_first->op_sibling;
if (/* I bet there's always a pushmark... */
- (kid = cLISTOPo->op_first->op_sibling)->op_type != OP_LIST
- && kid->op_type != OP_CONST)
+ OP_TYPE_ISNT_AND_WASNT_NN(kid, OP_LIST)
+ && OP_TYPE_ISNT_NN(kid, OP_CONST))
+ {
break;
+ }
key_op = (SVOP*)(kid->op_type == OP_CONST
? kid
(state $a, my $b, our $c, $d, undef) = ... */
}
} else if (lop->op_type == OP_UNDEF ||
- lop->op_type == OP_PUSHMARK) {
+ OP_TYPE_IS_OR_WAS(lop, OP_PUSHMARK)) {
/* undef may be interesting in
(state $a, undef, state $c) */
} else {
/* For state variable assignment, kkid is a list op whose op_last
is a padsv. */
if ((kkid->op_type == OP_PADSV ||
- (kkid->op_type == OP_LIST &&
+ (OP_TYPE_IS_OR_WAS(kkid, OP_LIST) &&
(kkid = cLISTOPx(kkid)->op_last)->op_type == OP_PADSV
)
)
#define IS_AND_OP(o) (o->op_type == OP_AND)
#define IS_OR_OP(o) (o->op_type == OP_OR)
+STATIC void
+S_null_listop_in_list_context(pTHX_ OP *o)
+{
+ PERL_ARGS_ASSERT_NULL_LISTOP_IN_LIST_CONTEXT;
+
+ /* This is an OP_LIST in list context. That means we
+ * can ditch the OP_LIST and the OP_PUSHMARK within. */
+
+ OP *kid = cLISTOPo->op_first;
+ /* Find the end of the chain of OPs executed within the OP_LIST. */
+ while (kid->op_next != o) {
+ assert(kid);
+ kid = kid->op_next;
+ }
+
+ kid->op_next = o->op_next; /* patch list out of exec chain */
+ op_null(cUNOPo->op_first); /* NULL the pushmark */
+ op_null(o); /* NULL the list */
+}
+
/* A peephole optimizer. We visit the ops in the order they're to execute.
* See the comments at the top of this file for more details about when
* peep() is called */
clear this again. */
o->op_opt = 1;
PL_op = o;
+
+
+ /* The following will have the OP_LIST and OP_PUSHMARK
+ * patched out later IF the OP_LIST is in list context.
+ * So in that case, we can set the this OP's op_next
+ * to skip to after the OP_PUSHMARK:
+ * a THIS -> b
+ * d list -> e
+ * b pushmark -> c
+ * c whatever -> d
+ * e whatever
+ * will eventually become:
+ * a THIS -> c
+ * - ex-list -> -
+ * - ex-pushmark -> -
+ * c whatever -> e
+ * e whatever
+ */
+ {
+ OP *sibling;
+ OP *other_pushmark;
+ if (OP_TYPE_IS(o->op_next, OP_PUSHMARK)
+ && (sibling = o->op_sibling)
+ && sibling->op_type == OP_LIST
+ /* This KIDS check is likely superfluous since OP_LIST
+ * would otherwise be an OP_STUB. */
+ && sibling->op_flags & OPf_KIDS
+ && (sibling->op_flags & OPf_WANT) == OPf_WANT_LIST
+ && (other_pushmark = cLISTOPx(sibling)->op_first)
+ /* Pointer equality also effectively checks that it's a
+ * pushmark. */
+ && other_pushmark == o->op_next)
+ {
+ o->op_next = other_pushmark->op_next;
+ null_listop_in_list_context(sibling);
+ }
+ }
+
switch (o->op_type) {
case OP_DBSTATE:
PL_curcop = ((COP*)o); /* for warnings */
*/
assert(followop);
if (gimme == OPf_WANT_VOID) {
- if (followop->op_type == OP_LIST
+ if (OP_TYPE_IS_OR_WAS(followop, OP_LIST)
&& gimme == (followop->op_flags & OPf_WANT)
&& ( followop->op_next->op_type == OP_NEXTSTATE
|| followop->op_next->op_type == OP_DBSTATE))
#define PERL_ARGS_ASSERT_NO_FH_ALLOWED \
assert(o)
+STATIC void S_null_listop_in_list_context(pTHX_ OP* o)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_NULL_LISTOP_IN_LIST_CONTEXT \
+ assert(o)
+
PERL_STATIC_INLINE OP* S_op_integerize(pTHX_ OP *o)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_OP_INTEGERIZE \