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

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

diff --git a/ext/B/t/concise.t b/ext/B/t/concise.t
index 1a25112..55a813d 100644 (file)
--- a/ext/B/t/concise.t
+++ b/ext/B/t/concise.t
@@ -13,10 +13,12 @@ BEGIN {
         print "1..0 # Skip -- Perl configured without B module\n";
         exit 0;
     }
-    require 'test.pl';
+    require 'test.pl';         # we use runperl from 'test.pl', so can't use Test::More
+    sub diag { print "# @_\n" } # but this is still handy
+
 }
 
-plan tests => 142;
+plan tests => 147;
 
 require_ok("B::Concise");
 
@@ -43,7 +45,7 @@ $out = runperl(
     prog => q{$a=$b && print q/foo/},
     stderr => 1,
 );
-
+#diag($out);
 like($out, qr/print/, "'-exec' option output has print opcode");
 
 ######## API tests v.60 
@@ -120,13 +122,21 @@ is ($@, '', "set_style accepts 3 style-format args");
 
 eval { set_style (@stylespec) };
 like ($@, qr/expecting 3 style-format args/,
-    "set_style rejects bad style-format args");
+      "set_style rejects bad style-format args");
 
 #### for content with doc'd options
 
 our($a, $b);
 my $func = sub{ $a = $b+42 };  # canonical example asub
 
+sub render {
+    walk_output(\my $out);
+    eval { B::Concise::compile(@_)->() };
+    # diag "rendering $@\n";
+    return ($out, $@) if wantarray;
+    return $out;
+}
+
 SKIP: {
     # tests output to GLOB, using perlio feature directly
     skip "no perlio on this build", 122
@@ -139,10 +149,7 @@ SKIP: {
                  -base10 -bigendian -littleendian
                  );
     foreach $opt (@options) {
-       walk_output(\my $out);
-       my $treegen = B::Concise::compile($opt, $func);
-       $treegen->();
-       #print "foo:$out\n";
+       ($out) = render($opt, $func);
        isnt($out, '', "got output with option $opt");
     }
     
@@ -163,7 +170,7 @@ SKIP: {
     $treegen->();
     ok($buf, "walk_output to GLOB, output seen");
     
-    ## Test B::Concise::compile error checking
+    ## test B::Concise::compile error checking
     
     # call compile on non-CODE ref items
     if (0) {
@@ -175,7 +182,7 @@ SKIP: {
            eval { B::Concise::compile('-basic', $ref)->() };
            like ($@, qr/^err: not a coderef: $typ/,
                  "compile detects $typ-ref where expecting subref");
-           # is($out,'', "no output when errd"); # announcement prints
+           is($out,'', "no output when errd"); # announcement prints
        }
     }
     
@@ -183,16 +190,48 @@ SKIP: {
     # in debugger, it should look like:
     #  1  CODE(0x84840cc)
     #      -> &CODE(0x84840cc) in ???
-    sub nosuchfunc;
-    eval {  B::Concise::compile('-basic', \&nosuchfunc)->()  };
-    like ($@, qr/^err: coderef has no START/,
-         "compile detects CODE-ref w/o actual code");
-
-    foreach my $opt (qw( -concise -exec )) {
-       eval { B::Concise::compile($opt,'non_existent_function')->() };
-       like ($@, qr/unknown function \(main::non_existent_function\)/,
-             "'$opt' reports non-existent-function properly");
+
+    my ($res,$err);
+    TODO: {
+       local $TODO = "\tdoes this handling make sense ?";
+
+       sub declared_only;
+       ($res,$err) = render('-basic', \&declared_only);
+       like ($res, qr/coderef CODE\(0x[0-9a-fA-F]+\) has no START/,
+             "'sub decl_only' seen as having no START");
+
+       sub defd_empty {};
+       ($res,$err) = render('-basic', \&defd_empty);
+       is(scalar split(/\n/, $res), 3,
+          "'sub defd_empty {}' seen as 3 liner");
+
+       is(1, $res =~ /leavesub/ && $res =~ /nextstate/,
+          "'sub defd_empty {}' seen as 2 ops: leavesub,nextstate");
+
+       ($res,$err) = render('-basic', \&not_even_declared);
+       like ($res, qr/coderef CODE\(0x[0-9a-fA-F]+\) has no START/,
+             "'\&not_even_declared' seen as having no START");
+
+       {
+           package Bar;
+           our $AUTOLOAD = 'garbage';
+           sub AUTOLOAD { print "# in AUTOLOAD: $AUTOLOAD\n" }
+       }
+       ($res,$err) = render('-basic', Bar::auto_func);
+       like ($res, qr/unknown function \(Bar::auto_func\)/,
+             "Bar::auto_func seen as unknown function");
+
+       ($res,$err) = render('-basic', \&Bar::auto_func);
+       like ($res, qr/coderef CODE\(0x[0-9a-fA-F]+\) has no START/,
+             "'\&Bar::auto_func' seen as having no START");
+
+       ($res,$err) = render('-basic', \&Bar::AUTOLOAD);
+       like ($res, qr/called Bar::AUTOLOAD/, "found body of Bar::AUTOLOAD");
+
     }
+    ($res,$err) = render('-basic', Foo::bar);
+    like ($res, qr/unknown function \(Foo::bar\)/,
+         "BC::compile detects fn-name as unknown function");
 
     # v.62 tests