line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright (C) 2011-2012 Rocky Bernstein <rocky@cpan.org> |
2
|
12
|
|
|
12
|
|
102
|
use warnings; no warnings 'redefine'; |
|
12
|
|
|
12
|
|
54
|
|
|
12
|
|
|
1
|
|
411
|
|
|
12
|
|
|
1
|
|
72
|
|
|
12
|
|
|
|
|
28
|
|
|
12
|
|
|
|
|
392
|
|
|
1
|
|
|
|
|
11
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
41
|
|
|
1
|
|
|
|
|
9
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
52
|
|
3
|
|
|
|
|
|
|
|
4
|
12
|
|
|
12
|
|
73
|
use rlib '../../../..'; |
|
12
|
|
|
1
|
|
26
|
|
|
12
|
|
|
|
|
74
|
|
|
1
|
|
|
|
|
12
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
14
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Devel::Trepan::CmdProcessor::Command::Frame; |
7
|
12
|
|
|
12
|
|
4169
|
use if !@ISA, Devel::Trepan::CmdProcessor::Command ; |
|
12
|
|
|
1
|
|
30
|
|
|
12
|
|
|
|
|
71
|
|
|
1
|
|
|
|
|
550
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
8
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
unless (@ISA) { |
10
|
12
|
|
|
12
|
|
84
|
eval <<'EOE'; |
|
12
|
|
|
12
|
|
29
|
|
|
12
|
|
|
12
|
|
697
|
|
|
12
|
|
|
12
|
|
79
|
|
|
12
|
|
|
12
|
|
32
|
|
|
12
|
|
|
|
|
590
|
|
|
12
|
|
|
|
|
78
|
|
|
12
|
|
|
|
|
34
|
|
|
12
|
|
|
|
|
526
|
|
|
12
|
|
|
|
|
72
|
|
|
12
|
|
|
|
|
27
|
|
|
12
|
|
|
|
|
569
|
|
|
12
|
|
|
|
|
74
|
|
|
12
|
|
|
|
|
31
|
|
|
12
|
|
|
|
|
515
|
|
11
|
|
|
|
|
|
|
use constant CATEGORY => 'stack'; |
12
|
|
|
|
|
|
|
use constant SHORT_HELP => 'Set frame for use in commands'; |
13
|
|
|
|
|
|
|
use constant MIN_ARGS => 0; # Need at least this many |
14
|
|
|
|
|
|
|
use constant MAX_ARGS => 2; # Need at most this many - undef -> unlimited. |
15
|
|
|
|
|
|
|
use constant NEED_STACK => 1; |
16
|
|
|
|
|
|
|
EOE |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
12
|
|
|
12
|
|
1864
|
use strict; |
|
12
|
|
|
1
|
|
40
|
|
|
12
|
|
|
|
|
371
|
|
|
1
|
|
|
|
|
115
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
50
|
|
20
|
|
|
|
|
|
|
|
21
|
12
|
|
|
12
|
|
80
|
use vars qw(@ISA); @ISA = @CMD_ISA; |
|
12
|
|
|
1
|
|
33
|
|
|
12
|
|
|
|
|
642
|
|
|
1
|
|
|
|
|
11
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
79
|
|
22
|
12
|
|
|
12
|
|
76
|
use vars @CMD_VARS; # Value inherited from parent |
|
12
|
|
|
1
|
|
32
|
|
|
12
|
|
|
|
|
5030
|
|
|
1
|
|
|
|
|
9
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
639
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
our $NAME = set_name(); |
25
|
|
|
|
|
|
|
=pod |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=head2 Synopsis: |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=cut |
30
|
|
|
|
|
|
|
our $HELP = <<"HELP"; |
31
|
|
|
|
|
|
|
=pod |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
B<frame> [I<frame-number>] |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
Change the current frame to frame I<frame-number> if specified, or the |
36
|
|
|
|
|
|
|
most-recent frame, 0, if no frame number specified. |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
A negative number indicates the position from the other or |
39
|
|
|
|
|
|
|
least-recently-entered end. So C<frame -1> moves to the oldest frame. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=head2 Examples: |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
frame # Set current frame at the current stopping point |
44
|
|
|
|
|
|
|
frame 0 # Same as above |
45
|
|
|
|
|
|
|
frame . # Same as above. 'current thread' is explicit. |
46
|
|
|
|
|
|
|
frame . 0 # Same as above. |
47
|
|
|
|
|
|
|
frame 1 # Move to frame 1. Same as: frame 0; up |
48
|
|
|
|
|
|
|
frame -1 # The least-recent frame |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head2 See also: |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
L<C<up>|Devel::Trepan::CmdProcessor::Command::Up>, |
53
|
|
|
|
|
|
|
L<C<down>|Devel::Trepan::CmdProcessor::Command::Down>, |
54
|
|
|
|
|
|
|
and L<C<backtrace>|Devel::Trepan::CmdProcessor::Command::Backtrace> |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=cut |
57
|
|
|
|
|
|
|
HELP |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub complete($$) |
60
|
|
|
|
|
|
|
{ |
61
|
0
|
|
|
0
|
0
|
|
my ($self, $prefix) = @_; |
|
0
|
|
|
0
|
0
|
|
|
62
|
0
|
|
|
|
|
|
$self->{proc}->frame_complete($prefix); |
|
0
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# This method runs the command |
66
|
|
|
|
|
|
|
sub run($$) |
67
|
|
|
|
|
|
|
{ |
68
|
0
|
|
|
0
|
0
|
|
my ($self, $args) = @_; |
|
0
|
|
|
0
|
0
|
|
|
69
|
0
|
|
|
|
|
|
my $proc = $self->{proc}; |
|
0
|
|
|
|
|
|
|
70
|
0
|
|
|
|
|
|
my $position_str; |
|
0
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
|
72
|
0
|
0
|
|
|
|
|
if (scalar @$args == 1) { |
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# Form is: "frame" which means "frame 0" |
74
|
0
|
|
|
|
|
|
$position_str = '0'; |
|
0
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
} elsif (scalar @$args == 2) { |
76
|
|
|
|
|
|
|
# Form is: "frame position" |
77
|
0
|
|
|
|
|
|
$position_str = $args->[1]; |
|
0
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
|
my ($low, $high) = $proc->frame_low_high(0); |
|
0
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
|
my $opts= { |
|
0
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
'msg_on_error' => |
83
|
|
|
|
|
|
|
"The '${NAME}' command requires a frame number. Got: ${position_str}", |
84
|
|
|
|
|
|
|
min_value => $low, |
85
|
|
|
|
|
|
|
max_value => $high |
86
|
|
|
|
|
|
|
}; |
87
|
0
|
|
|
|
|
|
my $frame_num = $proc->get_an_int($position_str, $opts); |
|
0
|
|
|
|
|
|
|
88
|
0
|
0
|
|
|
|
|
return unless defined $frame_num; |
|
0
|
0
|
|
|
|
|
|
89
|
0
|
|
|
|
|
|
$proc->adjust_frame($frame_num, 1); |
|
0
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
unless (caller) { |
93
|
|
|
|
|
|
|
require Devel::Trepan::DB; |
94
|
|
|
|
|
|
|
require Devel::Trepan::Core; |
95
|
|
|
|
|
|
|
my $db = Devel::Trepan::Core->new; |
96
|
|
|
|
|
|
|
my $intf = Devel::Trepan::Interface::User->new; |
97
|
|
|
|
|
|
|
my $proc = Devel::Trepan::CmdProcessor->new([$intf], $db); |
98
|
|
|
|
|
|
|
$proc->{stack_size} = 0; |
99
|
|
|
|
|
|
|
my $cmd = __PACKAGE__->new($proc); |
100
|
|
|
|
|
|
|
$cmd->run([$NAME, 0]); |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
1; |