1#!./perl 2 3BEGIN { 4 unshift @INC, 't'; 5 require Config; 6 if (($Config::Config{'extensions'} !~ /\bB\b/) ){ 7 print "1..0 # Skip -- Perl configured without B module\n"; 8 exit 0; 9 } 10 require 'test.pl'; 11} 12 13$| = 1; 14use warnings; 15use strict; 16use B::Showlex (); 17 18plan tests => 15; 19 20my $verbose = @ARGV; # set if ANY ARGS 21 22my $path = join " ", map { qq["-I$_"] } @INC; 23 24my $o = `$^X $path "-MO=Showlex" -e "my \@one" 2>&1`; 25like ($o, qr/undef.*: \([^)]*\) \@one.*Nullsv.*AV/s, 26 "canonical usage works"); 27 28# v1.01 tests 29 30my ($na,$nb,$nc); # holds regex-strs 31my ($out, $newlex); # output, option-flag 32 33sub padrep { 34 my ($varname,$newlex) = @_; 35 return ($newlex) 36 ? '\(0x[0-9a-fA-F]+\) "\\'.$varname.'" = ' 37 : "\\\(0x[0-9a-fA-F]+\\\) \\$varname\n"; 38} 39 40for $newlex ('', '-newlex') { 41 42 $out = runperl ( switches => ["-MO=Showlex,$newlex"], 43 prog => 'my ($a,$b)', stderr => 1 ); 44 $na = padrep('$a',$newlex); 45 $nb = padrep('$b',$newlex); 46 like ($out, qr/1: $na/ms, 'found $a in "my ($a,$b)"'); 47 like ($out, qr/2: $nb/ms, 'found $b in "my ($a,$b)"'); 48 49 print $out if $verbose; 50 51 our $buf = 'arb startval'; 52 my $ak = B::Showlex::walk_output (\$buf); 53 54 my $walker = B::Showlex::compile( $newlex, sub{my($foo,$bar)} ); 55 $walker->(); 56 $na = padrep('$foo',$newlex); 57 $nb = padrep('$bar',$newlex); 58 like ($buf, qr/1: $na/ms, 'found $foo in "sub { my ($foo,$bar) }"'); 59 like ($buf, qr/2: $nb/ms, 'found $bar in "sub { my ($foo,$bar) }"'); 60 61 print $buf if $verbose; 62 63 $ak = B::Showlex::walk_output (\$buf); 64 65 my $src = 'sub { my ($scalar,@arr,%hash) }'; 66 my $sub = eval $src; 67 $walker = B::Showlex::compile($sub); 68 $walker->(); 69 $na = padrep('$scalar',$newlex); 70 $nb = padrep('@arr',$newlex); 71 $nc = padrep('%hash',$newlex); 72 like ($buf, qr/1: $na/ms, 'found $scalar in "'. $src .'"'); 73 like ($buf, qr/2: $nb/ms, 'found @arr in "'. $src .'"'); 74 like ($buf, qr/3: $nc/ms, 'found %hash in "'. $src .'"'); 75 76 print $buf if $verbose; 77 78 # fibonacci function under test 79 my $asub = sub { 80 my ($self,%props)=@_; 81 my $total; 82 { # inner block vars 83 my (@fib)=(1,2); 84 for (my $i=2; $i<10; $i++) { 85 $fib[$i] = $fib[$i-2] + $fib[$i-1]; 86 } 87 for my $i(0..10) { 88 $total += $i; 89 } 90 } 91 }; 92 $walker = B::Showlex::compile($asub, $newlex, -nosp); 93 $walker->(); 94 print $buf if $verbose; 95 96 $walker = B::Concise::compile($asub, '-exec'); 97 $walker->(); 98 99} 100