#!perl
BEGIN {
- chdir 't';
- @INC = ('../lib', '../ext/B/t');
- require './test.pl';
+ if ($ENV{PERL_CORE}){
+ chdir('t') if -d 't';
+ @INC = ('.', '../lib', '../ext/B/t');
+ } else {
+ unshift @INC, 't';
+ push @INC, "../../t";
+ }
+ require Config;
+ if (($Config::Config{'extensions'} !~ /\bB\b/) ){
+ print "1..0 # Skip -- Perl configured without B module\n";
+ exit 0;
+ }
+ # require 'test.pl'; # now done by OptreeCheck
}
# import checkOptree(), and %gOpts (containing test state)
use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
+use Config;
-plan tests => 24; # need to set based on testing state
+my $tests = 23;
+plan tests => $tests;
+SKIP: {
+skip "no perlio in this build", $tests unless $Config::Config{useperlio};
$SIG{__WARN__} = sub {
my $err = shift;
bcopts => '-basic',
code => sub{$a=$b+42},
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 7 <1> leavesub[\d+ refs?] K/REFC,1 ->(end)
+# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->7
# 1 <;> nextstate(foo bar) v ->2
# 6 <2> sassign sKS/2 ->7
-# 4 <2> add[t\d+] sK/2 ->5
+# 4 <2> add[t3] sK/2 ->5
# - <1> ex-rv2sv sK/1 ->3
# 2 <#> gvsv[*b] s ->3
# 3 <$> const[IV 42] s ->4
bcopts => '-exec',
code => sub{$a=$b+42},
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# goto -
# 1 <;> nextstate(main 61 optree_concise.t:139) v
# 2 <#> gvsv[*b] s
# 3 <$> const[IV 42] s
# 6 <2> sassign sKS/2
# 7 <1> leavesub[1 ref] K/REFC,1
EOT_EOT
-# goto -
# 1 <;> nextstate(main 61 optree_concise.t:139) v
# 2 <$> gvsv(*b) s
# 3 <$> const(IV 42) s
# 7 <1> leavesub[1 ref] K/REFC,1
EONT_EONT
-checkOptree ( name => 'tree reftext is messy cut-paste',
- skip => 1);
-
-
#################################
pass("B::Concise OPTION TESTS");
bcopts => '-base3',
code => sub{$a=$b+42},
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- goto -
1 <;> dbstate(main 24 optree_concise.t:132) v
2 <#> gvsv[*b] s
10 <$> const[IV 42] s
11 <2> add[t3] sK/2
12 <#> gvsv[*a] s
20 <2> sassign sKS/2
-21 <1> leavesub[2 refs] K/REFC,1
+21 <1> leavesub[1 ref] K/REFC,1
EOT_EOT
-# goto -
# 1 <;> nextstate(main 62 optree_concise.t:161) v
# 2 <$> gvsv(*b) s
# 10 <$> const(IV 42) s
bcopts => [qw/ -exec /],
code => sub{$a},
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- goto UNOP (0x82b0918)
COP (0x82b0d70) nextstate
PADOP (0x82b0d30) gvsv GV (0x82a818c) *a
UNOP (0x82b0e08) leavesub [1]
EOT_EOT
-# goto UNOP (0x8282310)
# COP (0x82828e0) nextstate
# SVOP (0x82828a0) gvsv GV (0x814692c) *a
# UNOP (0x8282938) leavesub [1]
pass("OPTIONS IN CMDLINE MODE");
-checkOptree ( name => 'cmdline invoke -basic works',
- prog => 'sort @a',
+checkOptree ( name => 'cmdline invoke -basic works',
+ prog => 'sort @a',
+ errs => [ 'Useless use of sort in void context at -e line 1.',
+ 'Name "main::a" used only once: possible typo at -e line 1.',
+ ],
#bcopts => '-basic', # default
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 7 <@> leave[1 ref] vKP/REFC ->(end)
# 4 <$> gv(*a) s ->5
EONT_EONT
-checkOptree ( name => 'cmdline invoke -exec works',
- prog => 'sort @a',
- bcopts => '-exec',
- expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+checkOptree ( name => 'cmdline invoke -exec works',
+ prog => 'sort @a',
+ errs => [ 'Useless use of sort in void context at -e line 1.',
+ 'Name "main::a" used only once: possible typo at -e line 1.',
+ ],
+ bcopts => '-exec',
+ expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1 <0> enter
2 <;> nextstate(main 1 -e:1) v
3 <0> pushmark s
# 7 <@> leave[1 ref] vKP/REFC
EONT_EONT
-checkOptree ( name => 'cmdline self-strict compile err',
- prog => 'use strict; sort @a',
- bcopts => [qw/ -basic -concise -exec /],
- expect => 'compilation errors',
- expect_nt => 'compilation errors');
-
-checkOptree ( name => 'error at -e line 1',
- prog => 'our @a; sort @a',
- bcopts => [qw/ -basic -concise -exec /],
- expect => 'at -e line 1',
- expect_nt => 'at -e line 1');
-
-checkOptree ( name => 'cmdline -basic -concise -exec works',
- prog => 'our @a; sort @a',
- bcopts => [qw/ -basic -concise -exec /],
- expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+;
+
+checkOptree
+ ( name => 'cmdline self-strict compile err using prog',
+ prog => 'use strict; sort @a',
+ bcopts => [qw/ -basic -concise -exec /],
+ errs => 'Global symbol "@a" requires explicit package name at -e line 1.',
+ expect => 'nextstate',
+ expect_nt => 'nextstate',
+ noanchors => 1, # allow simple expectations to work
+ );
+
+checkOptree
+ ( name => 'cmdline self-strict compile err using code',
+ code => 'use strict; sort @a',
+ bcopts => [qw/ -basic -concise -exec /],
+ errs => 'Global symbol "@a" requires explicit package name at .*? line 1.',
+ note => 'this test relys on a kludge which copies $@ to rendering when empty',
+ expect => 'Global symbol',
+ expect_nt => 'Global symbol',
+ noanchors => 1, # allow simple expectations to work
+ );
+
+checkOptree
+ ( name => 'cmdline -basic -concise -exec works',
+ prog => 'our @a; sort @a',
+ bcopts => [qw/ -basic -concise -exec /],
+ errs => ['Useless use of sort in void context at -e line 1.'],
+ expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <0> enter
# 2 <;> nextstate(main 1 -e:1) v
# 3 <#> gv[*a] s
. "(x(;~=> #extra)x)\n" # new 'variable' used here
, " (*( )*) goto #seq\n"
- , "(?(<#speq>)?)#exname#arg(?([#targarglife])?)"
+ , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
#. "(x(;~=> #extra)x)\n" # new 'variable' used here
);
$h->{arg} .= ' CALLBACK' if $h->{name} eq 'const';
$h->{extra} = '';
+ if ($lastnext and $$lastnext != $$op) {
+ $h->{goto} = ($h->{seq} eq '-')
+ ? 'unresolved' : $h->{seq};
+ }
+
# 2 style specific behaviors
if ($style eq 'relative') {
$h->{extra} = 'RELATIVE';
bcopts => [qw/ -concise -exec /],
code => sub{$a=$b+42},
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- goto -
1 <;> nextstate(main 76 optree_concise.t:337) v
2 <#> gvsv[*b] s
3 <$> const[IV 42] CALLBACK s
crossfail => 1,
#retry => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-7 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
-- <@> lineseq KP ->7 => RELATIVE
-1 <;> nextstate(main 49 optree_concise.t:309) v ->2 => RELATIVE
-6 <2> sassign sKS ->7 => RELATIVE
-4 <2> add[t3] sK ->5 => RELATIVE
-- <1> ex-rv2sv sK ->3 => RELATIVE
-2 <#> gvsv[*b] s ->3 => RELATIVE
-3 <$> const[IV 42] CALLBACK s ->4 => RELATIVE
-- <1> ex-rv2sv sKRM* ->6 => RELATIVE
-5 <#> gvsv[*a] s ->6 => RELATIVE
+7 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
+- <@> lineseq KP ->7 => RELATIVE
+1 <;> nextstate(main 49 optree_concise.t:309) v ->2 => RELATIVE
+6 <2> sassign sKS ->7 => RELATIVE
+4 <2> add[t3] sK ->5 => RELATIVE
+- <1> ex-rv2sv sK ->3 => RELATIVE
+2 <#> gvsv[*b] s ->3 => RELATIVE
+3 <$> const[IV 42] CALLBACK s ->4 => RELATIVE
+- <1> ex-rv2sv sKRM* ->6 => RELATIVE
+5 <#> gvsv[*a] s ->6 => RELATIVE
EOT_EOT
-# 7 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
-# - <@> lineseq KP ->7 => RELATIVE
-# 1 <;> nextstate(main 77 optree_concise.t:353) v ->2 => RELATIVE
-# 6 <2> sassign sKS ->7 => RELATIVE
-# 4 <2> add[t1] sK ->5 => RELATIVE
-# - <1> ex-rv2sv sK ->3 => RELATIVE
-# 2 <$> gvsv(*b) s ->3 => RELATIVE
-# 3 <$> const(IV 42) CALLBACK s ->4 => RELATIVE
-# - <1> ex-rv2sv sKRM* ->6 => RELATIVE
-# 5 <$> gvsv(*a) s ->6 => RELATIVE
+# 7 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
+# - <@> lineseq KP ->7 => RELATIVE
+# 1 <;> nextstate(main 77 optree_concise.t:353) v ->2 => RELATIVE
+# 6 <2> sassign sKS ->7 => RELATIVE
+# 4 <2> add[t1] sK ->5 => RELATIVE
+# - <1> ex-rv2sv sK ->3 => RELATIVE
+# 2 <$> gvsv(*b) s ->3 => RELATIVE
+# 3 <$> const(IV 42) CALLBACK s ->4 => RELATIVE
+# - <1> ex-rv2sv sKRM* ->6 => RELATIVE
+# 5 <$> gvsv(*a) s ->6 => RELATIVE
EONT_EONT
checkOptree ( name => "both -exec -relative",
code => sub{$a=$b+42},
crossfail => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- goto -
1 <;> nextstate(main 50 optree_concise.t:326) v
2 <#> gvsv[*b] s
3 <$> const[IV 42] CALLBACK s
bcopts => [qw/ -exec -scope /],
code => sub{$a=$b+42},
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- goto -
1 <;> nextstate(main 50 optree_concise.t:337) v
7 <1> leavesub[1 ref] K/REFC,1
EOT_EOT
- goto -
1 <;> nextstate(main 75 optree_concise.t:396) v
7 <1> leavesub[1 ref] K/REFC,1
EONT_EONT
1 <;> nextstate(main 76 optree_concise.t:407) v ->2
EONT_EONT
-
-__END__
+} #skip
projects / p5sagit/p5-mst-13.2.git / blobdiff