Skip to content

Commit

Permalink
Merge 0c36ae8 into fa486af
Browse files Browse the repository at this point in the history
  • Loading branch information
@nwc10
nwc10 committed Jul 9, 2021
2 parents fa486af + 0c36ae8 commit 466b6a7
Show file tree
Hide file tree
Showing 19 changed files with 2,041 additions and 1,049 deletions.
2 changes: 2 additions & 0 deletions MANIFEST
View file
Expand Up @@ -4144,6 +4144,7 @@ ext/B/t/o.t See if O works
ext/B/t/optree_check.t test OptreeCheck apparatus
ext/B/t/optree_concise.t more B::Concise tests
ext/B/t/optree_constants.t B::Concise rendering of optimized constant subs
ext/B/t/optree_for.t for loops
ext/B/t/optree_misc.t misc optree tests
ext/B/t/optree_samples.t various basic codes: if for while
ext/B/t/optree_sort.t inplace sort optimization regression
Expand Down Expand Up @@ -5833,6 +5834,7 @@ t/op/filetest_stack_ok.t See if file tests leave their argument on the stack
t/op/filetest_t.t See if -t file test works
t/op/flip.t See if range operator works
t/op/for.t See if for loops work
t/op/for-many.t See if n-at-a-time for loops work
t/op/fork.t See if fork works
t/op/fresh_perl_utf8.t UTF8 tests for pads and gvs
t/op/getpid.t See if $$ and getppid work with threads
Expand Down
7 changes: 6 additions & 1 deletion ext/B/B/Concise.pm
View file
Expand Up @@ -852,9 +852,14 @@ sub concise_op {
# targ holds a reference count
my $refs = "ref" . ($h{targ} != 1 ? "s" : "");
$h{targarglife} = $h{targarg} = "$h{targ} $refs";
} elsif ($h{targ}) {
} elsif ($h{targ} && $h{name} ne 'iter') {
# for my ($q, $r, $s) () {} syntax hijacks the targ of the iter op,
# (which is the ->next of the enteriter) hence the special cases above
# and just below:
my $count = $h{name} eq 'padrange'
? ($op->private & $B::Op_private::defines{'OPpPADRANGE_COUNTMASK'})
: $h{name} eq 'enteriter'
? $op->next->targ + 1
: 1;
my (@targarg, @targarglife);
for my $i (0..$count-1) {
Expand Down
317 changes: 317 additions & 0 deletions ext/B/t/optree_for.t
View file
@@ -0,0 +1,317 @@
#!perl

BEGIN {
unshift @INC, 't';
require Config;
if (($Config::Config{'extensions'} !~ /\bB\b/) ){
print "1..0 # Skip -- Perl configured without B module\n";
exit 0;
}
if (!$Config::Config{useperlio}) {
print "1..0 # Skip -- need perlio to walk the optree\n";
exit 0;
}
}
use OptreeCheck;
use Config;
plan tests => 19;

pass("FOR LOOPS");

checkOptree ( name => 'for (@a)',
code => sub {for (@a) {}},
bcopts => '-exec',
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main 424 optree_for.t:14) v:>,<,%
2 <0> pushmark sM
3 <#> gv[*a] s
4 <1> rv2av[t2] sKRM/1
5 <#> gv[*_] s
6 <{> enteriter(next->8 last->b redo->7) KS/DEF
9 <0> iter s
a <|> and(other->7) K/1
7 <0> stub v
8 <0> unstack s
goto 9
b <2> leaveloop K/2
c <1> leavesub[1 ref] K/REFC,1
EOT_EOT
1 <;> nextstate(main 424 optree_for.t:14) v:>,<,%
2 <0> pushmark sM
3 <$> gv(*a) s
4 <1> rv2av[t1] sKRM/1
5 <$> gv(*_) s
6 <{> enteriter(next->8 last->b redo->7) KS/DEF
9 <0> iter s
a <|> and(other->7) K/1
7 <0> stub v
8 <0> unstack s
goto 9
b <2> leaveloop K/2
c <1> leavesub[1 ref] K/REFC,1
EONT_EONT

my @lexical;

checkOptree ( name => 'for (@lexical)',
code => sub {for (@lexical) {}},
bcopts => '-exec',
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main 424 optree_for.t:14) v:>,<,%
2 <0> pushmark sM
3 <0> padav[@lexical:FAKE::7] sRM
4 <#> gv[*_] s
5 <{> enteriter(next->7 last->a redo->6) KS/DEF
8 <0> iter s
9 <|> and(other->6) K/1
6 <0> stub v
7 <0> unstack s
goto 8
a <2> leaveloop K/2
b <1> leavesub[2 refs] K/REFC,1
EOT_EOT
1 <;> nextstate(main 424 optree_for.t:14) v:>,<,%
2 <0> pushmark sM
3 <0> padav[@lexical:FAKE::2] sRM
4 <$> gv(*_) s
5 <{> enteriter(next->7 last->a redo->6) KS/DEF
8 <0> iter s
9 <|> and(other->6) K/1
6 <0> stub v
7 <0> unstack s
goto 8
a <2> leaveloop K/2
b <1> leavesub[2 refs] K/REFC,1
EONT_EONT

checkOptree ( name => 'for $var (@a)',
code => sub {for $var (@a) {}},
bcopts => '-exec',
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main 1453 optree_for.t:68) v:{
2 <0> pushmark sM
3 <#> gv[*a] s
4 <1> rv2av[t3] sKRM/1
5 <#> gv[*var] s
6 <1> rv2gv sKRM/1
7 <{> enteriter(next->9 last->c redo->8) KS
a <0> iter s
b <|> and(other->8) K/1
8 <0> stub v
9 <0> unstack s
goto a
c <2> leaveloop KP/2
d <1> leavesub[1 ref] K/REFC,1
EOT_EOT
1 <;> nextstate(main 1453 optree_for.t:67) v:{
2 <0> pushmark sM
3 <$> gv(*a) s
4 <1> rv2av[t1] sKRM/1
5 <$> gv(*var) s
6 <1> rv2gv sKRM/1
7 <{> enteriter(next->9 last->c redo->8) KS
a <0> iter s
b <|> and(other->8) K/1
8 <0> stub v
9 <0> unstack s
goto a
c <2> leaveloop KP/2
d <1> leavesub[1 ref] K/REFC,1
EONT_EONT

checkOptree ( name => 'for my $var (@a)',
code => sub {for my $var (@a) {}},
bcopts => '-exec',
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main 1459 optree_for.t:90) v
2 <0> pushmark sM
3 <#> gv[*a] s
4 <1> rv2av[t3] sKRM/1
5 <{> enteriter(next->7 last->a redo->6)[$var:1460,1463] KS/LVINTRO
8 <0> iter s
9 <|> and(other->6) K/1
6 <0> stub v
7 <0> unstack s
goto 8
a <2> leaveloop K/2
b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
1 <;> nextstate(main 424 optree_for.t:14) v:>,<,%
2 <0> pushmark sM
3 <$> gv(*a) s
4 <1> rv2av[t2] sKRM/1
5 <{> enteriter(next->7 last->a redo->6)[$var:1460,1463] KS/LVINTRO
8 <0> iter s
9 <|> and(other->6) K/1
6 <0> stub v
7 <0> unstack s
goto 8
a <2> leaveloop K/2
b <1> leavesub[1 ref] K/REFC,1
EONT_EONT

checkOptree ( name => 'for our $var (@a)',
code => sub {for our $var (@a) {}},
bcopts => '-exec',
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main 1466 optree_for.t:100) v
2 <0> pushmark sM
3 <#> gv[*a] s
4 <1> rv2av[t4] sKRM/1
5 <#> gv[*var] s
6 <1> rv2gv sK/FAKE,1
7 <{> enteriter(next->9 last->c redo->8) KS/OURINTR
a <0> iter s
b <|> and(other->8) K/1
8 <0> stub v
9 <0> unstack s
goto a
c <2> leaveloop K/2
d <1> leavesub[1 ref] K/REFC,1
EOT_EOT
1 <;> nextstate(main 424 optree_for.t:111) v:>,<,%
2 <0> pushmark sM
3 <$> gv(*a) s
4 <1> rv2av[t2] sKRM/1
5 <$> gv(*var) s
6 <1> rv2gv sK/FAKE,1
7 <{> enteriter(next->9 last->c redo->8) KS/OURINTR
a <0> iter s
b <|> and(other->8) K/1
8 <0> stub v
9 <0> unstack s
goto a
c <2> leaveloop K/2
d <1> leavesub[1 ref] K/REFC,1
EONT_EONT

checkOptree ( name => 'for my ($var) (@a)',
code => sub {for my ($var) (@a) {}},
bcopts => '-exec',
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main 1466 optree_for.t:100) v
2 <0> pushmark sM
3 <#> gv[*a] s
4 <1> rv2av[t3] sKRM/1
5 <{> enteriter(next->7 last->a redo->6)[$var:1474,1477] KS
8 <0> iter s
9 <|> and(other->6) K/1
6 <0> stub v
7 <0> unstack s
goto 8
a <2> leaveloop K/2
b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
1 <;> nextstate(main 424 optree_for.t:111) v:>,<,%
2 <0> pushmark sM
3 <$> gv(*a) s
4 <1> rv2av[t2] sKRM/1
5 <{> enteriter(next->7 last->a redo->6)[$var:1474,1477] KS
8 <0> iter s
9 <|> and(other->6) K/1
6 <0> stub v
7 <0> unstack s
goto 8
a <2> leaveloop K/2
b <1> leavesub[1 ref] K/REFC,1
EONT_EONT

checkOptree ( name => 'for my ($var) (@lexical)',
code => sub {for my ($var) (@lexical) {}},
bcopts => '-exec',
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main 1466 optree_for.t:100) v
2 <0> pushmark sM
3 <0> padav[@lexical:FAKE::7] sRM
4 <{> enteriter(next->6 last->9 redo->5)[$var:1481,1484] KS
7 <0> iter s
8 <|> and(other->5) K/1
5 <0> stub v
6 <0> unstack s
goto 7
9 <2> leaveloop K/2
a <1> leavesub[2 refs] K/REFC,1
EOT_EOT
1 <;> nextstate(main 424 optree_for.t:111) v:>,<,%
2 <0> pushmark sM
3 <0> padav[@lexical:FAKE::2] sRM
4 <{> enteriter(next->6 last->9 redo->5)[$var:1481,1484] KS
7 <0> iter s
8 <|> and(other->5) K/1
5 <0> stub v
6 <0> unstack s
goto 7
9 <2> leaveloop K/2
a <1> leavesub[2 refs] K/REFC,1
EONT_EONT

checkOptree ( name => 'for my ($key, $value) (%h)',
code => sub {for my ($key, $value) (%h) {}},
bcopts => '-exec',
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main 1466 optree_for.t:100) v
2 <0> pushmark sM
3 <#> gv[*h] s
4 <1> rv2hv[t4] lKM
5 <{> enteriter(next->7 last->a redo->6)[$key:1488,1491; $value:1488,1491] K/LVINTRO
8 <0> iter s
9 <|> and(other->6) K/1
6 <0> stub v
7 <0> unstack s
goto 8
a <2> leaveloop K/2
b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
1 <;> nextstate(main 424 optree_for.t:111) v:>,<,%
2 <0> pushmark sM
3 <$> gv(*h) s
4 <1> rv2hv[t3] lKM
5 <{> enteriter(next->7 last->a redo->6)[$key:1488,1491; $value:1488,1491] K/LVINTRO
8 <0> iter s
9 <|> and(other->6) K/1
6 <0> stub v
7 <0> unstack s
goto 8
a <2> leaveloop K/2
b <1> leavesub[1 ref] K/REFC,1
EONT_EONT

checkOptree ( name => 'for my ($foo, $bar, $baz) (@a)',
code => sub {for my ($foo, $bar, $baz) (@a) {}},
bcopts => '-exec',
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main 1466 optree_for.t:100) v
2 <0> pushmark sM
3 <#> gv[*a] s
4 <1> rv2av[t5] sKRM/1
5 <{> enteriter(next->7 last->a redo->6)[$foo:1495,1498; $bar:1495,1498; $baz:1495,1498] KS/LVINTRO
8 <0> iter s
9 <|> and(other->6) K/1
6 <0> stub v
7 <0> unstack s
goto 8
a <2> leaveloop K/2
b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
1 <;> nextstate(main 424 optree_for.t:111) v:>,<,%
2 <0> pushmark sM
3 <$> gv(*a) s
4 <1> rv2av[t4] sKRM/1
5 <{> enteriter(next->7 last->a redo->6)[$foo:1495,1498; $bar:1495,1498; $baz:1495,1498] KS/LVINTRO
8 <0> iter s
9 <|> and(other->6) K/1
6 <0> stub v
7 <0> unstack s
goto 8
a <2> leaveloop K/2
b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
15 changes: 13 additions & 2 deletions lib/B/Deparse.pm
View file
Expand Up @@ -52,7 +52,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
MDEREF_SHIFT
);

$VERSION = '1.57';
$VERSION = '1.58';
use strict;
our $AUTOLOAD;
use warnings ();
Expand Down Expand Up @@ -3953,7 +3953,18 @@ sub loop_common {
} else {
$ary = $self->deparse($ary, 1);
}
if (null $var) {
my $iter_targ = $kid->first->first->targ;
if ($iter_targ) {
# for my ($foo, $bar) () stores the count (less 1) in the targ of
# the ITER op.
my @vars;
my $targ = $enter->targ;
while ($iter_targ-- >= 0) {
push @vars, $self->padname_sv($targ)->PVX;
++$targ;
}
$var = 'my (' . join(', ', @vars) . ')';
} elsif (null $var) {
$var = $self->pp_padsv($enter, 1, 1);
} elsif ($var->name eq "rv2gv") {
$var = $self->pp_rv2sv($var, 1);
Expand Down
10 changes: 10 additions & 0 deletions lib/B/Deparse.t
View file
Expand Up @@ -2530,6 +2530,16 @@ foreach \&a (sub { 9; } , sub { 10; } ) {
die;
}
####
my %hash;
foreach my ($key, $value) (%hash) {
study $_;
}
####
my @ducks;
foreach my ($tick, $trick, $track) (@ducks) {
study $_;
}
####
# join $foo, pos
my $foo;
$_ = join $foo, pos
Expand Down

0 comments on commit 466b6a7

Please sign in to comment.