Re: [patch] teach B::Concise to see XS code

[p5sagit/p5-mst-13.2.git] / ext / B / t / optree_concise.t

diff --git a/ext/B/t/optree_concise.t b/ext/B/t/optree_concise.t
index b274409..b14af0d 100644 (file)
--- a/ext/B/t/optree_concise.t
+++ b/ext/B/t/optree_concise.t
@@ -1,23 +1,29 @@
 #!perl
 
 BEGIN {
-    chdir 't';
-    @INC = ('../lib', '../ext/B/t');
+    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';
+    # require 'test.pl'; # now done by OptreeCheck
 }
 
 # import checkOptree(), and %gOpts (containing test state)
 use OptreeCheck;       # ALSO DOES @ARGV HANDLING !!!!!!
 use Config;
 
-plan tests => 23;
+my $tests = 23;
+plan tests => $tests;
 SKIP: {
-skip "no perlio in this build", 24 unless $Config::Config{useperlio};
+skip "no perlio in this build", $tests unless $Config::Config{useperlio};
 
 $SIG{__WARN__} = sub {
     my $err = shift;
@@ -30,11 +36,11 @@ checkOptree ( name  => 'canonical example w -basic',
              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
@@ -202,8 +208,11 @@ EONT_EONT
 
 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)
@@ -223,10 +232,13 @@ EOT_EOT
 # 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
@@ -244,24 +256,35 @@ EOT_EOT
 # 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 /],
-             noanchors => 1,
-             expect    => 'compilation errors',
-             expect_nt => 'compilation errors');
-
-checkOptree ( name     => 'error at -e line 1',
-             prog      => 'our @a; sort @a',
-             bcopts    => [qw/ -basic -concise -exec /],
-             noanchors => 1,
-             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