| Subject: | [PATCH] Fix for 5.21.5 |
‘method’ and ‘method_named’ ops are now of class methop, not unop/svop.
list and pushmark are void nulled in void context. (Nulled listops have always been reported by B as unops.)
anoncode is now wrapped in srefgen instead of refgen.
join is now subject to constant folding.
| Subject: | open_XKZRdzen.txt |
diff -rup DBIx-Perlish-0.63-Ab60Ek-orig/lib/DBIx/Perlish/Parse.pm DBIx-Perlish-0.63-Ab60Ek/lib/DBIx/Perlish/Parse.pm
--- DBIx-Perlish-0.63-Ab60Ek-orig/lib/DBIx/Perlish/Parse.pm 2014-10-27 03:43:27.000000000 -0700
+++ DBIx-Perlish-0.63-Ab60Ek/lib/DBIx/Perlish/Parse.pm 2014-10-27 03:44:39.000000000 -0700
@@ -52,6 +52,7 @@ gen_is("null");
gen_is("op");
gen_is("padop");
gen_is("svop");
+gen_is("methop");
gen_is("unop");
gen_is("pmop");
@@ -70,6 +71,17 @@ sub is_const
}
}
+sub is_anoncode
+{
+ my ($op) = @_;
+ return unless is_unop($op) && $op->name =~ /^s?refgen\z/;
+ $op = $op->first if is_unop($op->first, "null");
+ $op = $op->first;
+ $op = $op->op_sibling if is_pushmark_or_padrange($op);
+ return unless is_svop($op, "anoncode");
+ return $op;
+}
+
# "want" helpers
sub gen_want
@@ -125,7 +137,8 @@ sub want_const
sub want_variable_method
{
my ($S, $op) = @_;
- return unless is_unop($op, "method");
+ return unless is_unop($op) || is_methop($op)
+ and $op->name eq "method";
$op = $op->first;
return unless is_null($op->sibling);
my ($name, $ok) = get_value($S, $op, soft => 1);
@@ -133,15 +146,22 @@ sub want_variable_method
return $name;
}
+sub get_meth_sv
+{
+ my ($op) = @_;
+ is_svop($op) ? $op->sv : $op->meth_sv;
+}
+
sub want_method
{
my ($S, $op) = @_;
- unless (is_svop($op, "method_named")) {
+ unless (is_svop($op) || is_methop($op)
+ and $op->name eq "method_named") {
my $r = want_variable_method($S, $op);
bailout $S, "method call syntax expected" unless $r;
return $r;
}
- my $sv = $op->sv;
+ my $sv = get_meth_sv($op);
if (!$$sv) {
$sv = $S->{padlist}->[1]->ARRAYelt($op->targ);
}
@@ -153,12 +173,11 @@ sub want_method
sub get_all_children
{
my ($op) = @_;
- my $c = $op->children;
my @op;
- return @op unless $c;
push @op, $op->first;
- while (--$c) {
- push @op, $op[-1]->sibling;
+ return if is_null($op[-1]);
+ while (!is_null(my $sib = $op[-1]->sibling)) {
+ push @op, $sib;
}
@op;
}
@@ -402,7 +422,8 @@ sub try_parse_attr_assignment
my @attr = grep { length($_) } split /(?:[\(\)])/, $attr;
return unless @attr;
$op = $op->sibling;
- return unless is_svop($op, "method_named");
+ return unless is_svop($op) || is_methop($op)
+ and $op->name eq "method_named";
return unless want_method($S, $op, "import");
if ($realname) {
if (lc $attr[0] eq "table") {
@@ -677,11 +698,7 @@ sub try_get_dbfetch
return if is_null($dbfetch);
return unless is_null($dbfetch->sibling);
- return unless is_unop($rg, "refgen");
- $rg = $rg->first if is_unop($rg->first, "null");
- return unless is_pushmark_or_padrange($rg->first);
- my $codeop = $rg->first->sibling;
- return unless is_svop($codeop, "anoncode");
+ return unless my $codeop = is_anoncode($rg);
$dbfetch = $dbfetch->first if is_unop($dbfetch->first, "null");
$dbfetch = $dbfetch->first;
@@ -869,11 +886,7 @@ sub try_funcall
return if $p{only_normal_funcs};
return unless @args == 1 || @args == 2;
my $rg = $args[0];
- return unless is_unop($rg, "refgen");
- $rg = $rg->first if is_unop($rg->first, "null");
- return unless is_pushmark_or_padrange($rg->first);
- my $codeop = $rg->first->sibling;
- return unless is_svop($codeop, "anoncode");
+ return unless my $codeop = is_anoncode($rg);
return unless $S->{operation} eq "select";
my $cv = $codeop->sv;
if (!$$cv) {
@@ -905,11 +918,7 @@ sub try_funcall
return if $p{only_normal_funcs};
return unless @args == 1;
my $rg = $args[0];
- return unless is_unop($rg, "refgen");
- $rg = $rg->first if is_unop($rg->first, "null");
- return unless is_pushmark_or_padrange($rg->first);
- my $codeop = $rg->first->sibling;
- return unless is_svop($codeop, "anoncode");
+ return unless my $codeop = is_anoncode($rg);
my $sql = handle_subselect($S, $codeop, returns_dont_care => 1);
return "exists ($sql)";
} elsif ($func eq "sql") {
@@ -1765,7 +1774,7 @@ sub parse_op
} elsif (is_unop($op, "leavesub")) {
parse_op($S, $op->first);
} elsif (is_unop($op, "null")) {
- parse_op($S, $op->first);
+ parse_list($S, $op);
} elsif (is_unop($op, "defined")) {
where_or_having($S, scalar parse_term($S, $op));
} elsif (is_op($op, "padsv")) {
@@ -1812,6 +1821,9 @@ sub parse_op
push @{$S->{sets}}, parse_selfmod($S, $op->first, "- 1");
} elsif (is_listop($op, "exec")) {
$S->{seen_exec}++;
+ } elsif (is_svop($op, "const") && eval { $op->folded }) {
+ # Assume this was join 1,2,3 and got folded.
+ bailout $S, "not a valid join() syntax";
} else {
bailout $S, "don't quite know what to do with op \"" . $op->name . "\"";
}