From: Jim Cromie Date: Thu, 23 Sep 2004 21:45:42 +0000 (+0000) Subject: [perl #31697] [PATCH] B::Showlex::newlex enhancement and pod X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=59910b6dbc5bdf043d9f33f40bbbc9957f008770;p=p5sagit%2Fp5-mst-13.2.git [perl #31697] [PATCH] B::Showlex::newlex enhancement and pod From: Jim Cromie (via RT) Message-ID: (with doc nits) p4raw-id: //depot/perl@23350 --- diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index c6ac010..668b378 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp use Exporter (); # use #5 -our $VERSION = "0.63"; +our $VERSION = "0.64"; our @ISA = qw(Exporter); our @EXPORT_OK = qw( set_style set_style_standard add_callback concise_subref concise_cv concise_main @@ -274,7 +274,8 @@ sub compile { warn "disregarding non-options: @newargs\n" if @newargs; for my $objname (@args) { - + next unless $objname; # skip null args to avoid noisy responses + if ($objname eq "BEGIN") { concise_specials("BEGIN", $order, B::begin_av->isa("B::AV") ? diff --git a/ext/B/B/Showlex.pm b/ext/B/B/Showlex.pm index 31708e0..3b261a3 100644 --- a/ext/B/B/Showlex.pm +++ b/ext/B/B/Showlex.pm @@ -1,6 +1,6 @@ package B::Showlex; -our $VERSION = '1.01'; +our $VERSION = '1.02'; use strict; use B qw(svref_2object comppadlist class); @@ -62,20 +62,21 @@ sub showlex { showvaluearray("Pad of lexical values for $objname", $valsav); } +my ($newlex, $nosp1); # rendering state vars + sub newlex { # drop-in for showlex my ($objname, $names, $vals) = @_; my @names = $names->ARRAY; my @vals = $vals->ARRAY; my $count = @names; print $walkHandle "$objname Pad has $count entries\n"; - printf $walkHandle "0: %s\n", $names[0]->terse; + printf $walkHandle "0: %s\n", $names[0]->terse unless $nosp1; for (my $i = 1; $i < $count; $i++) { - printf $walkHandle "$i: %s = %s\n", $names[$i]->terse, $vals[$i]->terse; + printf $walkHandle "$i: %s = %s\n", $names[$i]->terse, $vals[$i]->terse + unless $nosp1 and $names[$i]->terse =~ /SPECIAL/; } } -my $newlex; # rendering state var - sub showlex_obj { my ($objname, $obj) = @_; $objname =~ s/^&main::/&/; @@ -84,7 +85,8 @@ sub showlex_obj { } sub showlex_main { - showlex("comppadlist", comppadlist->ARRAY); + showlex("comppadlist", comppadlist->ARRAY) if !$newlex; + newlex ("main", comppadlist->ARRAY) if $newlex; } sub compile { @@ -92,12 +94,15 @@ sub compile { my @args = grep(!/^-/, @_); for my $o (@options) { $newlex = 1 if $o eq "-newlex"; + $nosp1 = 1 if $o eq "-nosp"; } return \&showlex_main unless @args; return sub { + my $objref; foreach my $objname (@args) { - my $objref; + next unless $objname; # skip nulls w/o carping + if (ref $objname) { print $walkHandle "B::Showlex::compile($objname)\n"; $objref = $objname; @@ -124,13 +129,74 @@ B::Showlex - Show lexical variables used in functions or files =head1 SYNOPSIS - perl -MO=Showlex[,SUBROUTINE] foo.pl + perl -MO=Showlex[,-OPTIONS][,SUBROUTINE] foo.pl =head1 DESCRIPTION -When a subroutine name is provided in OPTIONS, prints the lexical -variables used in that subroutine. Otherwise, prints the file-scope -lexicals in the file. +When a comma-separated list of subroutine names is given as options, Showlex +prints the lexical variables used in those subroutines. Otherwise, it prints +the file-scope lexicals in the file. + +=head1 EXAMPLES + +Traditional form: + + $ perl -MO=Showlex -e 'my ($i,$j,$k)=(1,"foo")' + Pad of lexical names for comppadlist has 4 entries + 0: SPECIAL #1 &PL_sv_undef + 1: PVNV (0x9db0fb0) $i + 2: PVNV (0x9db0f38) $j + 3: PVNV (0x9db0f50) $k + Pad of lexical values for comppadlist has 5 entries + 0: SPECIAL #1 &PL_sv_undef + 1: NULL (0x9da4234) + 2: NULL (0x9db0f2c) + 3: NULL (0x9db0f44) + 4: NULL (0x9da4264) + -e syntax OK + +New-style form: + + $ perl -MO=Showlex,-newlex -e 'my ($i,$j,$k)=(1,"foo")' + main Pad has 4 entries + 0: SPECIAL #1 &PL_sv_undef + 1: PVNV (0xa0c4fb8) "$i" = NULL (0xa0b8234) + 2: PVNV (0xa0c4f40) "$j" = NULL (0xa0c4f34) + 3: PVNV (0xa0c4f58) "$k" = NULL (0xa0c4f4c) + -e syntax OK + +New form, no specials, outside O framework: + + $ perl -MB::Showlex -e \ + 'my ($i,$j,$k)=(1,"foo"); B::Showlex::compile(-newlex,-nosp)->()' + main Pad has 4 entries + 1: PVNV (0x998ffb0) "$i" = IV (0x9983234) 1 + 2: PVNV (0x998ff68) "$j" = PV (0x998ff5c) "foo" + 3: PVNV (0x998ff80) "$k" = NULL (0x998ff74) + +Note that this example shows the values of the lexicals, whereas the other +examples did not (as they're compile-time only). + +=head2 OPTIONS + +The C<-newlex> option produces a more readable C<< name => value >> format, +and is shown in the second example above. + +The C<-nosp> option eliminates reporting of SPECIALs, such as C<0: SPECIAL +#1 &PL_sv_undef> above. Reporting of SPECIALs can sometimes overwhelm +your declared lexicals. + +=head1 SEE ALSO + +C can also be used outside of the O framework, as in the third +example. See C for a fuller explanation of reasons. + +=head1 TODO + +Some of the reported info, such as hex addresses, is not particularly +valuable. Other information would be more useful for the typical +programmer, such as line-numbers, pad-slot reuses, etc.. Given this, +-newlex isnt a particularly good flag-name. =head1 AUTHOR diff --git a/ext/B/t/showlex.t b/ext/B/t/showlex.t index 850254e..9ac5288 100755 --- a/ext/B/t/showlex.t +++ b/ext/B/t/showlex.t @@ -21,7 +21,7 @@ use strict; use Config; use B::Showlex (); -plan tests => 8; +plan tests => 15; my $verbose = @ARGV; # set if ANY ARGS @@ -44,70 +44,78 @@ if ($is_thread) { # v1.01 tests -my ($na,$nb,$nc); # holds regex-strs +my ($na,$nb,$nc); # holds regex-strs +my ($out, $newlex); # output, option-flag + sub padrep { - my $varname = shift; - return "PVNV \\\(0x[0-9a-fA-F]+\\\) \\$varname\n"; + my ($varname,$newlex) = @_; + return ($newlex) + ? 'PVNV \(0x[0-9a-fA-F]+\) "\\'.$varname.'" = ' + : "PVNV \\\(0x[0-9a-fA-F]+\\\) \\$varname\n"; } -my $out = runperl ( switches => ["-MO=Showlex"], - prog => 'my ($a,$b)', stderr => 1 ); -$na = padrep('$a'); -$nb = padrep('$b'); -like ($out, qr/1: $na/ms, 'found $a in "my ($a,$b)"'); -like ($out, qr/2: $nb/ms, 'found $b in "my ($a,$b)"'); +for $newlex ('', '-newlex') { + + $out = runperl ( switches => ["-MO=Showlex,$newlex"], + prog => 'my ($a,$b)', stderr => 1 ); + $na = padrep('$a',$newlex); + $nb = padrep('$b',$newlex); + like ($out, qr/1: $na/ms, 'found $a in "my ($a,$b)"'); + like ($out, qr/2: $nb/ms, 'found $b in "my ($a,$b)"'); -print $out if $verbose; + print $out if $verbose; SKIP: { skip "no perlio in this build", 5 unless $Config::Config{useperlio}; -our $buf = 'arb startval'; -my $ak = B::Showlex::walk_output (\$buf); - -my $walker = B::Showlex::compile(sub { my ($foo,$bar) }); -$walker->(); -$na = padrep('$foo'); -$nb = padrep('$bar'); -like ($buf, qr/1: $na/ms, 'found $foo in "sub { my ($foo,$bar) }"'); -like ($buf, qr/2: $nb/ms, 'found $bar in "sub { my ($foo,$bar) }"'); - -print $buf if $verbose; - -$ak = B::Showlex::walk_output (\$buf); - -$walker = B::Showlex::compile(sub { my ($scalar,@arr,%hash) }); -$walker->(); -$na = padrep('$scalar'); -$nb = padrep('@arr'); -$nc = padrep('%hash'); -like ($buf, qr/1: $na/ms, 'found $scalar in "sub { my ($scalar,@arr,%hash) }"'); -like ($buf, qr/2: $nb/ms, 'found @arr in "sub { my ($scalar,@arr,%hash) }"'); -like ($buf, qr/3: $nc/ms, 'found %hash in "sub { my ($scalar,@arr,%hash) }"'); - -print $buf if $verbose; - -my $asub = sub { - my ($self,%props)=@_; - my $total; - { # inner block vars - my (@fib)=(1,2); - for (my $i=2; $i<10; $i++) { - $fib[$i] = $fib[$i-2] + $fib[$i-1]; + our $buf = 'arb startval'; + my $ak = B::Showlex::walk_output (\$buf); + + my $walker = B::Showlex::compile( $newlex, sub{my($foo,$bar)} ); + $walker->(); + $na = padrep('$foo',$newlex); + $nb = padrep('$bar',$newlex); + like ($buf, qr/1: $na/ms, 'found $foo in "sub { my ($foo,$bar) }"'); + like ($buf, qr/2: $nb/ms, 'found $bar in "sub { my ($foo,$bar) }"'); + + print $buf if $verbose; + + $ak = B::Showlex::walk_output (\$buf); + + my $src = 'sub { my ($scalar,@arr,%hash) }'; + my $sub = eval $src; + $walker = B::Showlex::compile($sub); + $walker->(); + $na = padrep('$scalar',$newlex); + $nb = padrep('@arr',$newlex); + $nc = padrep('%hash',$newlex); + like ($buf, qr/1: $na/ms, 'found $scalar in "'. $src .'"'); + like ($buf, qr/2: $nb/ms, 'found @arr in "'. $src .'"'); + like ($buf, qr/3: $nc/ms, 'found %hash in "'. $src .'"'); + + print $buf if $verbose; + + # fibonacci function under test + my $asub = sub { + my ($self,%props)=@_; + my $total; + { # inner block vars + my (@fib)=(1,2); + for (my $i=2; $i<10; $i++) { + $fib[$i] = $fib[$i-2] + $fib[$i-1]; + } + for my $i(0..10) { + $total += $i; + } } - for my $i(0..10) { - $total += $i; - } - } -}; -$walker = B::Showlex::compile($asub, '-newlex'); -$walker->(); + }; + $walker = B::Showlex::compile($asub, $newlex, -nosp); + $walker->(); + print $buf if $verbose; -$walker = B::Concise::compile($asub, '-exec'); -$walker->(); - - -print $buf if $verbose; + $walker = B::Concise::compile($asub, '-exec'); + $walker->(); } +}