skip "no perlio in this build", $tests
unless $Config::Config{useperlio};
+my @open_todo;
+sub open_todo {
+ if (((caller 0)[10]||{})->{open}) {
+ @open_todo = (skip => "\$^OPEN is set");
+ }
+}
+open_todo;
pass("REGEX TEST HARNESS SELFTEST");
checkOptree ( name => 'fixup nextstate (in reftext)',
bcopts => '-exec',
code => sub {my $a},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <;> nextstate( NOTE THAT THIS CAN BE ANYTHING ) v
# 2 <0> padsv[$a:54,55] M/LVINTRO
bcopts => '-exec',
#fail => 1, # uncomment to see real padsv args: [$a:491,492]
code => sub {my $a},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <;> nextstate(main 56 optree_concise.t:96) v
# 2 <0> padsv[$a:56,57] M/LVINTRO
code => sub{$a=$b+42},
crossfail => 1,
debug => 1,
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->7
#################################
pass("CANONICAL B::Concise EXAMPLE");
+my @open_todo;
+sub open_todo {
+ if (((caller 0)[10]||{})->{open}) {
+ @open_todo = (skip => "\$^OPEN is set");
+ }
+}
+open_todo;
+
checkOptree ( name => 'canonical example w -basic',
bcopts => '-basic',
code => sub{$a=$b+42},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->7
checkOptree ( name => 'canonical example w -exec',
bcopts => '-exec',
code => sub{$a=$b+42},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <;> nextstate(main 61 optree_concise.t:139) v:{
# 2 <#> gvsv[*b] s
checkOptree ( name => '-base3 sticky-exec',
bcopts => '-base3',
code => sub{$a=$b+42},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> dbstate(main 24 optree_concise.t:132) v:{
2 <#> gvsv[*b] s
checkOptree ( name => 'sticky-base3, -basic over sticky-exec',
bcopts => '-basic',
code => sub{$a=$b+42},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
21 <1> leavesub[1 ref] K/REFC,1 ->(end)
- <@> lineseq KP ->21
checkOptree ( name => '-base4',
bcopts => [qw/ -basic -base4 /],
code => sub{$a=$b+42},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
13 <1> leavesub[1 ref] K/REFC,1 ->(end)
- <@> lineseq KP ->13
bcopts => [qw/ -basic -base36 /],
code => sub{$a},
crossfail => 1,
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
3 <1> leavesub[1 ref] K/REFC,1 ->(end)
- <@> lineseq KP ->3
'Name "main::a" used only once: possible typo at -e line 1.',
],
#bcopts => '-basic', # default
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 7 <@> leave[1 ref] vKP/REFC ->(end)
# 1 <0> enter ->2
'Name "main::a" used only once: possible typo at -e line 1.',
],
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <0> enter
2 <;> nextstate(main 1 -e:1) v:{
prog => 'our @a; sort @a',
bcopts => [qw/ -basic -concise -exec /],
errs => ['Useless use of sort in void context at -e line 1.'],
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <0> enter
# 2 <;> nextstate(main 1 -e:1) v:{
checkOptree ( name => 'callback used, independent of style',
bcopts => [qw/ -concise -exec /],
code => sub{$a=$b+42},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main 76 optree_concise.t:337) v:{
2 <#> gvsv[*b] s
SKIP: {
skip "no perlio in this build", $tests unless $Config::Config{useperlio};
+my @open_todo;
+sub open_todo {
+ if (((caller 0)[10]||{})->{open}) {
+ @open_todo = (skip => "\$^OPEN is set");
+ }
+}
+open_todo;
+
#################################
use constant { # see also t/op/gv.t line 282
checkOptree ( name => 'call many in a print statement',
code => \&printem,
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->9
SKIP: {
skip "no perlio in this build", 1 unless $Config::Config{useperlio};
+my @open_todo;
+sub open_todo {
+ if (((caller 0)[10]||{})->{open}) {
+ @open_todo = (skip => "\$^OPEN is set");
+ }
+}
+open_todo;
+
# The regression this is 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
checkOptree ( name => 'OP_AELEMFAST opclass',
code => sub { my @x; our @y; $x[0] + $y[0]},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# a <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->a
pass("IF,THEN,ELSE, ?:");
+my @open_todo;
+sub open_todo {
+ if (((caller 0)[10]||{})->{open}) {
+ @open_todo = (skip => "\$^OPEN is set");
+ }
+}
+open_todo;
+
checkOptree ( name => '-basic sub {if shift print then,else}',
bcopts => '-basic',
code => sub { if (shift) { print "then" }
else { print "else" }
},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->9
if ($a) { print "foo" }
else { print "bar" }
},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# d <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->d
code => sub { if (shift) { print "then" }
else { print "else" }
},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <;> nextstate(main 426 optree.t:16) v
# 2 <#> gv[*_] s
if ($a) { print "foo" }
else { print "bar" }
},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <;> nextstate(main 423 optree.t:16) v
# 2 <#> gv[*_] s
checkOptree ( name => '-exec sub { print (shift) ? "foo" : "bar" }',
code => sub { print (shift) ? "foo" : "bar" },
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <;> nextstate(main 428 optree.t:31) v
# 2 <0> pushmark s
checkOptree ( name => '-exec sub { foreach (1..10) {print "foo $_"} }',
code => sub { foreach (1..10) {print "foo $_"} },
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <;> nextstate(main 443 optree.t:158) v
# 2 <0> pushmark s
checkOptree ( name => '-basic sub { print "foo $_" foreach (1..10) }',
code => sub { print "foo $_" foreach (1..10) },
bcopts => '-basic',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# h <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->h
checkOptree ( name => '-exec -e foreach (1..10) {print qq{foo $_}}',
prog => 'foreach (1..10) {print qq{foo $_}}',
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <0> enter
# 2 <;> nextstate(main 2 -e:1) v
checkOptree ( name => '-exec sub { print "foo $_" foreach (1..10) }',
code => sub { print "foo $_" foreach (1..10) },
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <;> nextstate(main 445 optree.t:167) v
# 2 <;> nextstate(main 445 optree.t:167) v
checkOptree ( name => '-e use constant j => qq{junk}; print j',
prog => 'use constant j => qq{junk}; print j',
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <0> enter
# 2 <;> nextstate(main 71 -e:1) v:{
pass("SORT OPTIMIZATION");
+my @open_todo;
+sub open_todo {
+ if (((caller 0)[10]||{})->{open}) {
+ @open_todo = (skip => "\$^OPEN is set");
+ }
+}
+open_todo;
+
checkOptree ( name => 'sub {sort @a}',
code => sub {sort @a},
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <;> nextstate(main 424 optree_sort.t:14) v
# 2 <0> pushmark s
'Name "main::a" used only once: possible typo at -e line 1.',
],
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <0> enter
2 <;> nextstate(main 1 -e:1) v:{
checkOptree ( name => 'sub {@a = sort @a}',
code => sub {@a = sort @a},
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main -438 optree.t:244) v
2 <0> pushmark s
checkOptree ( name => '@a = sort @a',
prog => '@a = sort @a',
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <0> enter
2 <;> nextstate(main 1 -e:1) v:{
checkOptree ( name => 'sub {@a = sort @a; reverse @a}',
code => sub {@a = sort @a; reverse @a},
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main -438 optree.t:286) v
2 <0> pushmark s
prog => '@a = sort @a; reverse @a',
errs => ['Useless use of reverse in void context at -e line 1.'],
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <0> enter
2 <;> nextstate(main 1 -e:1) v:{
checkOptree ( name => 'sub {my @a; @a = sort @a}',
code => sub {my @a; @a = sort @a},
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main -437 optree.t:254) v
2 <0> padav[@a:-437,-436] vM/LVINTRO
checkOptree ( name => 'my @a; @a = sort @a',
prog => 'my @a; @a = sort @a',
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <0> enter
2 <;> nextstate(main 1 -e:1) v:{
code => sub {my @a; @a = sort @a; push @a, 1},
bcopts => '-exec',
debug => 0,
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main -437 optree.t:325) v
2 <0> padav[@a:-437,-436] vM/LVINTRO
code => sub {my @a; @a = sort @a; 1},
bcopts => '-exec',
debug => 0,
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main -437 optree.t:325) v
2 <0> padav[@a:-437,-436] vM/LVINTRO
. "propagated to 5.8.x")
if $] < 5.009;
+my @open_todo;
+sub open_todo {
+ if (((caller 0)[10]||{})->{open}) {
+ @open_todo = (skip => "\$^OPEN is set");
+ }
+}
+open_todo;
checkOptree ( name => 'BEGIN',
bcopts => 'BEGIN',
prog => $src,
@warnings_todo,
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# BEGIN 1:
# b <1> leavesub[1 ref] K/REFC,1 ->(end)
checkOptree ( name => 'END',
bcopts => 'END',
prog => $src,
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# END 1:
# 4 <1> leavesub[1 ref] K/REFC,1 ->(end)
checkOptree ( name => 'CHECK',
bcopts => 'CHECK',
prog => $src,
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# CHECK 1:
# 4 <1> leavesub[1 ref] K/REFC,1 ->(end)
bcopts => 'INIT',
#todo => 'get working',
prog => $src,
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# INIT 1:
# 4 <1> leavesub[1 ref] K/REFC,1 ->(end)
bcopts => [qw/ BEGIN END INIT CHECK -exec /],
prog => $src,
@warnings_todo,
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# BEGIN 1:
# 1 <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
pass("OPTIMIZER TESTS - VAR INITIALIZATION");
+my @open_todo;
+sub open_todo {
+ if (((caller 0)[10]||{})->{open}) {
+ @open_todo = (skip => "\$^OPEN is set");
+ }
+}
+open_todo;
+
checkOptree ( name => 'sub {my $a}',
bcopts => '-exec',
code => sub {my $a},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <;> nextstate(main 45 optree.t:23) v
# 2 <0> padsv[$a:45,46] M/LVINTRO
checkOptree ( name => '-exec sub {my $a}',
bcopts => '-exec',
code => sub {my $a},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <;> nextstate(main 49 optree.t:52) v
# 2 <0> padsv[$a:49,50] M/LVINTRO
checkOptree ( name => 'sub {our $a}',
bcopts => '-exec',
code => sub {our $a},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main 21 optree.t:47) v
2 <#> gvsv[*a] s/OURINTR
checkOptree ( name => 'sub {local $a}',
bcopts => '-exec',
code => sub {local $a},
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main 23 optree.t:57) v:{
2 <#> gvsv[*a] s/LVINTRO
checkOptree ( name => 'my $a',
prog => 'my $a',
bcopts => '-basic',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 4 <@> leave[1 ref] vKP/REFC ->(end)
# 1 <0> enter ->2
checkOptree ( name => 'our $a',
prog => 'our $a',
bcopts => '-basic',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
4 <@> leave[1 ref] vKP/REFC ->(end)
1 <0> enter ->2
prog => 'local $a',
errs => ['Name "main::a" used only once: possible typo at -e line 1.'],
bcopts => '-basic',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
4 <@> leave[1 ref] vKP/REFC ->(end)
1 <0> enter ->2
checkOptree ( name => 'sub {my $a=undef}',
code => sub {my $a=undef},
bcopts => '-basic',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
5 <1> leavesub[1 ref] K/REFC,1 ->(end)
- <@> lineseq KP ->5
code => sub {our $a=undef},
note => 'the global must be reset',
bcopts => '-basic',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
5 <1> leavesub[1 ref] K/REFC,1 ->(end)
- <@> lineseq KP ->5
code => sub {local $a=undef},
note => 'local not used enough to bother',
bcopts => '-basic',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
5 <1> leavesub[1 ref] K/REFC,1 ->(end)
- <@> lineseq KP ->5
checkOptree ( name => 'my $a=undef',
prog => 'my $a=undef',
bcopts => '-basic',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
6 <@> leave[1 ref] vKP/REFC ->(end)
1 <0> enter ->2
prog => 'our $a=undef',
note => 'global must be reassigned',
bcopts => '-basic',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
6 <@> leave[1 ref] vKP/REFC ->(end)
1 <0> enter ->2
errs => ['Name "main::a" used only once: possible typo at -e line 1.'],
note => 'locals are rare, probly not worth doing',
bcopts => '-basic',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
6 <@> leave[1 ref] vKP/REFC ->(end)
1 <0> enter ->2
checkOptree ( name => 'sub {my $a=()}',
code => sub {my $a=()},
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main -439 optree.t:105) v
2 <0> stub sP
code => sub {our $a=()},
#todo => 'probly not worth doing',
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main 31 optree.t:177) v:{
2 <0> stub sP
code => sub {local $a=()},
#todo => 'probly not worth doing',
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <;> nextstate(main 33 optree.t:190) v:{
2 <0> stub sP
checkOptree ( name => 'my $a=()',
prog => 'my $a=()',
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <0> enter
2 <;> nextstate(main 1 -e:1) v:{
prog => 'our $a=()',
#todo => 'probly not worth doing',
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <0> enter
2 <;> nextstate(main 1 -e:1) v:{
errs => ['Name "main::a" used only once: possible typo at -e line 1.'],
#todo => 'probly not worth doing',
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <0> enter
2 <;> nextstate(main 1 -e:1) v:{
prog => 'my ($a,$b)=()',
#todo => 'probly not worth doing',
bcopts => '-exec',
+ @open_todo,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <0> enter
# 2 <;> nextstate(main 1 -e:1) v:{
BEGIN {
print "not " if exists $^H{foo};
print "ok 1 - \$^H{foo} doesn't exist initially\n";
- print "not " if $^H & 0x00020000;
- print "ok 2 - \$^H doesn't contain HINT_LOCALIZE_HH initially\n";
+ if (${^OPEN}) {
+ print "not " unless $^H & 0x00020000;
+ print "ok 2 - \$^H contains HINT_LOCALIZE_HH initially with ${^OPEN}\n";
+ } else {
+ print "not " if $^H & 0x00020000;
+ print "ok 2 - \$^H doesn't contain HINT_LOCALIZE_HH initially\n";
+ }
}
{
# simulate a pragma -- don't forget HINT_LOCALIZE_HH
CHECK {
print "not " if exists $^H{foo};
print "ok 9 - \$^H{foo} doesn't exist when compilation complete\n";
- print "not " if $^H & 0x00020000;
- print "ok 10 - \$^H doesn't contain HINT_LOCALIZE_HH when compilation complete\n";
+ if (${^OPEN}) {
+ print "not " unless $^H & 0x00020000;
+ print "ok 10 - \$^H contains HINT_LOCALIZE_HH when compilation complete with ${^OPEN}\n";
+ } else {
+ print "not " if $^H & 0x00020000;
+ print "ok 10 - \$^H doesn't contain HINT_LOCALIZE_HH when compilation complete\n";
+ }
}
print "not " if exists $^H{foo};
print "ok 11 - \$^H{foo} doesn't exist at runtime\n";
- print "not " if $^H & 0x00020000;
- print "ok 12 - \$^H doesn't contain HINT_LOCALIZE_HH at run-time\n";
+ if (${^OPEN}) {
+ print "not " unless $^H & 0x00020000;
+ print "ok 12 - \$^H contains HINT_LOCALIZE_HH at run-time with ${^OPEN}\n";
+ } else {
+ print "not " if $^H & 0x00020000;
+ print "ok 12 - \$^H doesn't contain HINT_LOCALIZE_HH at run-time\n";
+ }
# op_entereval should keep the pragmas it was compiled with
eval q*
print "not " if $^H{foo} ne "a";
BEGIN {
print "not " if exists $^H{foo};
print "ok 7 - \$^H{foo} doesn't exist while finishing compilation\n";
- print "not " if $^H & 0x00020000;
- print "ok 8 - \$^H doesn't contain HINT_LOCALIZE_HH while finishing compilation\n";
+ if (${^OPEN}) {
+ print "not " unless $^H & 0x00020000;
+ print "ok 8 - \$^H contains HINT_LOCALIZE_HH while finishing compilation with ${^OPEN}\n";
+ } else {
+ print "not " if $^H & 0x00020000;
+ print "ok 8 - \$^H doesn't contain HINT_LOCALIZE_HH while finishing compilation\n";
+ }
}
require 'test.pl';