ext/B/t/showlex.t

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