#!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;
}
}
use OptreeCheck;
use Config;
plan tests => 8;
SKIP: {
skip "no perlio in this build", 4 unless $Config::Config{useperlio};
# The regression this was testing is that the first aelemfast, derived
# from a lexical array, is supposed to be a BASEOP "<0>", while the
# second, from a global, is an SVOP "<$>" or a PADOP "<#>" depending
# on threading. In buggy versions, both showed up as SVOPs/PADOPs. See
# B.xs:cc_opclass() for the relevant code.
# All this is much simpler, now that aelemfast_lex has been broken out from
# aelemfast
checkOptree ( name => 'OP_AELEMFAST opclass',
code => sub { my @x; our @y; $x[0] + $y[0]},
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# a <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->a
# 1 <;> nextstate(main 634 optree_misc.t:25) v:>,<,% ->2
# 2 <0> padav[@x:634,636] vM/LVINTRO ->3
# 3 <;> nextstate(main 635 optree_misc.t:25) v:>,<,% ->4
# 5 <1> rv2av[t4] vK/OURINTR,1 ->6
# 4 <#> gv[*y] s ->5
# 6 <;> nextstate(main 636 optree_misc.t:25) v:>,<,%,{ ->7
# 9 <2> add[t6] sK/2 ->a
# - <1> ex-aelem sK/2 ->8
# 7 <0> aelemfast_lex[@x:634,636] sR ->8
# - <0> ex-const s ->-
# - <1> ex-aelem sK/2 ->9
# - <1> ex-rv2av sKR/1 ->-
# 8 <#> aelemfast[*y] s ->9
# - <0> ex-const s ->-
EOT_EOT
# a <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->a
# 1 <;> nextstate(main 634 optree_misc.t:27) v:>,<,% ->2
# 2 <0> padav[@x:634,636] vM/LVINTRO ->3
# 3 <;> nextstate(main 635 optree_misc.t:27) v:>,<,% ->4
# 5 <1> rv2av[t3] vK/OURINTR,1 ->6
# 4 <$> gv(*y) s ->5
# 6 <;> nextstate(main 636 optree_misc.t:27) v:>,<,%,{ ->7
# 9 <2> add[t4] sK/2 ->a
# - <1> ex-aelem sK/2 ->8
# 7 <0> aelemfast_lex[@x:634,636] sR ->8
# - <0> ex-const s ->-
# - <1> ex-aelem sK/2 ->9
# - <1> ex-rv2av sKR/1 ->-
# 8 <$> aelemfast(*y) s ->9
# - <0> ex-const s ->-
EONT_EONT
checkOptree ( name => 'PMOP children',
code => sub { $foo =~ s/(a)/$1/ },
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->5
# 1 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->2
# 4 </> subst(/"(a)"/) KS ->5
# - <1> ex-rv2sv sKRM/1 ->3
# 2 <#> gvsv[*foo] s ->3
# - <1> ex-rv2sv sK/1 ->4
# 3 <#> gvsv[*1] s ->4
EOT_EOT
# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->5
# 1 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->2
# 4 </> subst(/"(a)"/) KS ->5
# - <1> ex-rv2sv sKRM/1 ->3
# 2 <$> gvsv(*foo) s ->3
# - <1> ex-rv2sv sK/1 ->4
# 3 <$> gvsv(*1) s ->4
EONT_EONT
} #skip
my $t = <<'EOT_EOT';
# 8 <@> leave[1 ref] vKP/REFC ->(end)
# 1 <0> enter ->2
# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3
# 7 <2> sassign vKS/2 ->8
# 5 <@> index[t2] sK/2 ->6
# - <0> ex-pushmark s ->3
# 3 <$> const[PV "foo"] s ->4
# 4 <$> const[PVMG "foo"] s ->5
# - <1> ex-rv2sv sKRM*/1 ->7
# 6 <#> gvsv[*_] s ->7
EOT_EOT
my $nt = <<'EONT_EONT';
# 8 <@> leave[1 ref] vKP/REFC ->(end)
# 1 <0> enter ->2
# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3
# 7 <2> sassign vKS/2 ->8
# 5 <@> index[t1] sK/2 ->6
# - <0> ex-pushmark s ->3
# 3 <$> const(PV "foo") s ->4
# 4 <$> const(PVMG "foo") s ->5
# - <1> ex-rv2sv sKRM*/1 ->7
# 6 <$> gvsv(*_) s ->7
EONT_EONT
if ($] < 5.009) {
$t =~ s/GV /BM /;
$nt =~ s/GV /BM /;
}
checkOptree ( name => 'index and PVBM',
prog => '$_ = index q(foo), q(foo)',
strip_open_hints => 1,
expect => $t, expect_nt => $nt);
my $tmpfile = tempfile();
open my $fh, '>', $tmpfile or die "Cannot open $tmpfile: $!";
print $fh "no warnings;format =\n@<<<\n\$a\n@>>>\n\@b\n.";
close $fh;
checkOptree ( name => 'formats',
bcopts => 'STDOUT',
progfile => $tmpfile,
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# main::STDOUT (FORMAT):
# c <1> leavewrite[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->c
# 1 <;> nextstate(main 1 -:4) v:>,<,% ->2
# 5 <@> formline vK/2 ->6
# 2 <0> pushmark s ->3
# 3 <$> const[PV "@<<<\n"] s ->4
# - <@> lineseq lK ->5
# - <0> ex-nextstate v ->4
# - <1> ex-rv2sv sK/1 ->-
# 4 <#> gvsv[*a] s ->5
# 6 <;> nextstate(main 1 -:6) v:>,<,% ->7
# b <@> formline sK/2 ->c
# 7 <0> pushmark s ->8
# 8 <$> const[PV "@>>>\n"] s ->9
# - <@> lineseq lK ->b
# - <0> ex-nextstate v ->9
# a <1> rv2av[t3] lK/1 ->b
# 9 <#> gv[*b] s ->a
EOT_EOT
# main::STDOUT (FORMAT):
# c <1> leavewrite[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->c
# 1 <;> nextstate(main 1 -:4) v:>,<,% ->2
# 5 <@> formline vK/2 ->6
# 2 <0> pushmark s ->3
# 3 <$> const(PV "@<<<\n") s ->4
# - <@> lineseq lK ->5
# - <0> ex-nextstate v ->4
# - <1> ex-rv2sv sK/1 ->-
# 4 <$> gvsv(*a) s ->5
# 6 <;> nextstate(main 1 -:6) v:>,<,% ->7
# b <@> formline sK/2 ->c
# 7 <0> pushmark s ->8
# 8 <$> const(PV "@>>>\n") s ->9
# - <@> lineseq lK ->b
# - <0> ex-nextstate v ->9
# a <1> rv2av[t3] lK/1 ->b
# 9 <$> gv(*b) s ->a
EONT_EONT
unlink $tmpfile;