Commit | Line | Data |
c97a6147 |
1 | package B::Lint::Debug; |
2 | |
3 | =head1 NAME |
4 | |
5 | B::Lint::Debug - Adds debugging stringification to B:: |
6 | |
7 | =head1 DESCRIPTION |
8 | |
9 | This module injects stringification to a B::OP*/B::SPECIAL. This |
10 | should not be loaded unless you're debugging. |
11 | |
12 | =cut |
13 | |
14 | package B::SPECIAL; |
15 | use overload '""' => sub { |
16 | my $self = shift @_; |
17 | "SPECIAL($$self)"; |
18 | }; |
19 | |
20 | package B::OP; |
21 | use overload '""' => sub { |
22 | my $self = shift @_; |
23 | my $class = ref $self; |
24 | $class =~ s/\AB:://xms; |
25 | my $name = $self->name; |
26 | "$class($name)"; |
27 | }; |
28 | |
29 | package B::SVOP; |
30 | use overload '""' => sub { |
31 | my $self = shift @_; |
32 | my $class = ref $self; |
33 | $class =~ s/\AB:://xms; |
34 | my $name = $self->name; |
35 | "$class($name," . $self->sv . "," . $self->gv . ")"; |
36 | }; |
37 | |
38 | package B::SPECIAL; |
39 | sub DESTROY { } |
40 | our $AUTOLOAD; |
41 | |
42 | sub AUTOLOAD { |
43 | my $cx = 0; |
44 | print "AUTOLOAD $AUTOLOAD\n"; |
45 | |
46 | package DB; |
47 | while ( my @stuff = caller $cx ) { |
48 | |
49 | print "$cx: [@DB::args] [@stuff]\n"; |
50 | if ( ref $DB::args[0] ) { |
51 | if ( $DB::args[0]->can('padix') ) { |
52 | print " PADIX: " . $DB::args[0]->padix . "\n"; |
53 | } |
54 | if ( $DB::args[0]->can('targ') ) { |
55 | print " TARG: " . $DB::args[0]->targ . "\n"; |
56 | for ( B::Lint::cv()->PADLIST->ARRAY ) { |
57 | print +( $_->ARRAY )[ $DB::args[0]->targ ] . "\n"; |
58 | } |
59 | } |
60 | } |
61 | ++$cx; |
62 | } |
63 | } |
64 | |
65 | 1; |