1#!./perl 2 3# Verify that B::Concise properly reports whether functions are XS, 4# perl, or optimized constant subs. 5 6BEGIN { 7 unshift @INC, 't'; 8 require Config; 9 if (($Config::Config{'extensions'} !~ /\bB\b/) ){ 10 print "1..0 # Skip -- Perl configured without B module\n"; 11 exit 0; 12 } 13} 14 15use Carp; 16use Test::More 'no_plan'; 17 18require_ok("B::Concise"); 19 20my %matchers = 21 ( constant => qr{ (?-x: is a constant sub, optimized to a \w+) 22 |(?-x: exists in stash, but has no START) }x, 23 XS => qr/ is XS code/, 24 perl => qr/ (next|db)state/, 25 core => qr/ coreargs/, # CORE:: subs have no nextstate 26 noSTART => qr/ has no START/, 27); 28 29use constant a_constant => 3; 30use constant a_list_constant => 4,5,6; 31 32my @subs_to_test = ( 33 'a stub' => noSTART => \&baz, 34 'a Perl sub' => perl => sub { foo(); bar (); }, 35 'a constant Perl sub' => constant => sub () { 3 }, 36 'a constant constant' => constant => \&a_constant, 37 'a list constant' => constant => \&a_list_constant, 38 'an XSUB' => XS => \&utf8::encode, 39 'a CORE:: sub' => core => \&CORE::lc, 40); 41 42############ 43 44B::Concise::compile('-nobanner'); # set a silent default 45 46while (@subs_to_test) { 47 my ($func_name, $want, $sub) = splice @subs_to_test, 0, 3; 48 49 croak "unknown type $want: $func_name\n" 50 unless defined $matchers{$want}; 51 52 my ($buf, $err) = render($sub); 53 my $res = like($buf, $matchers{$want}, "$want sub:\t $func_name"); 54 55 unless ($res) { 56 # Test failed. Report type that would give success. 57 for my $m (keys %matchers) { 58 diag ("$name is of type $m"), last if $buf =~ $matchers{$m}; 59 } 60 } 61} 62 63sub render { 64 my ($func_name) = @_; 65 66 B::Concise::reset_sequence(); 67 B::Concise::walk_output(\my $buf); 68 69 my $walker = B::Concise::compile($func_name); 70 eval { $walker->() }; 71 diag("err: $@ $buf") if $@; 72 diag("verbose: $buf") if $opts{V}; 73 74 return ($buf, $@); 75} 76 77__END__ 78