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