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 Config; 17use B::Showlex (); 18 19plan tests => 15; 20 21my $verbose = @ARGV; # set if ANY ARGS 22 23my $a; 24 25my $path = join " ", map { qq["-I$_"] } @INC; 26my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define'; 27 28if ($is_thread) { 29 ok "# use5005threads: test skipped\n"; 30} else { 31 $a = `$^X $path "-MO=Showlex" -e "my \@one" 2>&1`; 32 like ($a, qr/undef.*: \([^)]*\) \@one.*Nullsv.*AV/s, 33 "canonical usage works"); 34} 35 36# v1.01 tests 37 38my ($na,$nb,$nc); # holds regex-strs 39my ($out, $newlex); # output, option-flag 40 41sub padrep { 42 my ($varname,$newlex) = @_; 43 return ($newlex) 44 ? '\(0x[0-9a-fA-F]+\) "\\'.$varname.'" = ' 45 : "\\\(0x[0-9a-fA-F]+\\\) \\$varname\n"; 46} 47 48for $newlex ('', '-newlex') { 49 50 $out = runperl ( switches => ["-MO=Showlex,$newlex"], 51 prog => 'my ($a,$b)', stderr => 1 ); 52 $na = padrep('$a',$newlex); 53 $nb = padrep('$b',$newlex); 54 like ($out, qr/1: $na/ms, 'found $a in "my ($a,$b)"'); 55 like ($out, qr/2: $nb/ms, 'found $b in "my ($a,$b)"'); 56 57 print $out if $verbose; 58 59SKIP: { 60 skip "no perlio in this build", 5 61 unless $Config::Config{useperlio}; 62 63 our $buf = 'arb startval'; 64 my $ak = B::Showlex::walk_output (\$buf); 65 66 my $walker = B::Showlex::compile( $newlex, sub{my($foo,$bar)} ); 67 $walker->(); 68 $na = padrep('$foo',$newlex); 69 $nb = padrep('$bar',$newlex); 70 like ($buf, qr/1: $na/ms, 'found $foo in "sub { my ($foo,$bar) }"'); 71 like ($buf, qr/2: $nb/ms, 'found $bar in "sub { my ($foo,$bar) }"'); 72 73 print $buf if $verbose; 74 75 $ak = B::Showlex::walk_output (\$buf); 76 77 my $src = 'sub { my ($scalar,@arr,%hash) }'; 78 my $sub = eval $src; 79 $walker = B::Showlex::compile($sub); 80 $walker->(); 81 $na = padrep('$scalar',$newlex); 82 $nb = padrep('@arr',$newlex); 83 $nc = padrep('%hash',$newlex); 84 like ($buf, qr/1: $na/ms, 'found $scalar in "'. $src .'"'); 85 like ($buf, qr/2: $nb/ms, 'found @arr in "'. $src .'"'); 86 like ($buf, qr/3: $nc/ms, 'found %hash in "'. $src .'"'); 87 88 print $buf if $verbose; 89 90 # fibonacci function under test 91 my $asub = sub { 92 my ($self,%props)=@_; 93 my $total; 94 { # inner block vars 95 my (@fib)=(1,2); 96 for (my $i=2; $i<10; $i++) { 97 $fib[$i] = $fib[$i-2] + $fib[$i-1]; 98 } 99 for my $i(0..10) { 100 $total += $i; 101 } 102 } 103 }; 104 $walker = B::Showlex::compile($asub, $newlex, -nosp); 105 $walker->(); 106 print $buf if $verbose; 107 108 $walker = B::Concise::compile($asub, '-exec'); 109 $walker->(); 110 111} 112} 113