Permalink
Browse files

Had broken in DRYing code section headings for 'our' variables

  • Loading branch information...
1 parent b7b5ced commit 53d827e6c67ef017ea259bd1bf52127981cf3312 Rocky Bernstein committed Dec 25, 2012
@@ -19,7 +19,7 @@ use PadWalker qw(peek_my);
use Devel::Trepan::CmdProcessor::Command::Subcmd::Core;
our $CMD = "info variables my";
-our @CMD = split(/ /, $CMD);
+my @CMD = split(/ /, $CMD);
our $MIN_ABBREV = length('m');
our $HELP = <<'HELP';
=pod
@@ -44,18 +44,25 @@ our $SHORT_HELP = "Information about 'my' variables.";
@ISA = qw(Devel::Trepan::CmdProcessor::Command::Subsubcmd);
-sub complete($$;$)
-{
- my ($self, $prefix, $fixup_num) = @_;
+sub get_var_hash($;$)
+{
+ my ($self, $fixup_num) = @_;
# FIXME: combine with My.pm
my $i = 0;
while (my ($pkg, $file, $line, $fn) = caller($i++)) { ; };
my $diff = $i - $DB::stack_depth;
-
- # FIXME: 4 is a magic fixup constant, also found in DB::finish.
+
+ # FIXME: 5 is a magic fixup constant, also found in DB::finish.
# Remove it.
- $fixup_num = 4 unless defined($fixup_num);
- my $var_hash = peek_my($diff + $self->{proc}{frame_index} + $fixup_num);
+ $fixup_num = 5 unless defined($fixup_num);
+ my $ref = peek_my($diff + $self->{proc}{frame_index} + $fixup_num);
+ return $ref;
+}
+
+sub complete($$;$)
+{
+ my ($self, $prefix, $fixup_num) = @_;
+ my $var_hash = $self->get_var_hash($fixup_num);
my @vars = sort keys %$var_hash;
Devel::Trepan::Complete::complete_token(\@vars, $prefix) ;
}
@@ -94,8 +101,9 @@ sub show_var($$$)
}
-sub process_args($$$$) {
- my ($self, $args, $hash_ref, $lex_type) = @_;
+sub process_args($$$) {
+ my ($self, $args, $hash_ref) = @_;
+ my $lex_type = $self->{prefix}[-1];
my $proc = $self->{proc};
my @ARGS = @{$args};
my @names = sort keys %{$hash_ref};
@@ -132,17 +140,9 @@ sub process_args($$$$) {
sub run($$;$)
{
my ($self, $args, $fixup_num) = @_;
- # FIXME: combine with My.pm
- my $i = 0;
- while (my ($pkg, $file, $line, $fn) = caller($i++)) { ; };
- my $diff = $i - $DB::stack_depth;
-
- # FIXME: 4 is a magic fixup constant, also found in DB::finish.
- # Remove it.
- $fixup_num = 4 unless defined($fixup_num);
- my $var_hash = peek_my($diff + $self->{proc}{frame_index} + $fixup_num);
+ my $var_hash = $self->get_var_hash($fixup_num);
my @ARGS = splice(@{$args}, scalar(@CMD));
- $self->process_args(\@ARGS, $var_hash, 'my');
+ $self->process_args(\@ARGS, $var_hash);
}
unless (caller) {
@@ -1,7 +1,7 @@
# -*- coding: utf-8 -*-
# Copyright (C) 2011-2012 Rocky Bernstein <rocky@cpan.org>
use warnings; no warnings 'redefine'; no warnings 'once';
-use rlib '../../../../..';
+use rlib '../../../../../..';
package Devel::Trepan::CmdProcessor::Command::Info::Variables::Our;
use vars qw(@ISA @SUBCMD_VARS);
@@ -10,7 +10,7 @@ use Devel::Trepan::CmdProcessor::Command::Info_Subcmd::Variables_Subcmd::My;
use PadWalker qw(peek_our);
our $CMD = "info variables our";
-my @CMD = split(/ /, $CMD);
+our @CMD = split(/ /, $CMD);
use constant MAX_ARGS => undef;
use constant NEED_STACK => 1;
our $MIN_ABBREV = length('o');
@@ -26,25 +26,62 @@ our $SHORT_HELP = "Information about 'our' variables.";
@ISA = qw(Devel::Trepan::CmdProcessor::Command::Info::Variables::My);
-sub run($$)
+sub get_var_hash($;$)
{
- my ($self, $args) = @_;
+ my ($self, $fixup_num) = @_;
# FIXME: combine with My.pm
my $i = 0;
-
while (my ($pkg, $file, $line, $fn) = caller($i++)) { ; };
my $diff = $i - $DB::stack_depth;
-
- # FIXME: 4 is a magic fixup constant, also found in DB::finish.
+
+ # FIXME: 5 is a magic fixup constant, also found in DB::finish.
# Remove it.
- my $var_hash = peek_our($diff + $self->{proc}{frame_index} + 4);
- my @ARGS = splice(@{$args}, scalar(@CMD));
- $self->process_args(\@ARGS, $var_hash, 'our');
+ $fixup_num = 5 unless defined($fixup_num);
+ peek_our($diff + $self->{proc}{frame_index} + $fixup_num);
}
unless (caller) {
# Demo it.
require Devel::Trepan;
+ my $proc = Devel::Trepan::CmdProcessor->new;
+ my $grandparent =
+ Devel::Trepan::CmdProcessor::Command::Info->new($proc, 'info');
+ my $parent =
+ Devel::Trepan::CmdProcessor::Command::Info::Variables->new($grandparent,
+ 'variables');
+ my $cmd = __PACKAGE__->new($parent, 'our');
+
+ eval {
+ sub create_frame() {
+ my ($pkg, $file, $line, $fn) = caller(0);
+ $DB::package = $pkg;
+ return [
+ {
+ file => $file,
+ fn => $fn,
+ line => $line,
+ pkg => $pkg,
+ }];
+ }
+ };
+ my $frame_ary = create_frame();
+ $proc->frame_setup($frame_ary);
+
+ $cmd->run($cmd->{prefix}, -2);
+ my @args = @{$cmd->{prefix}};
+ push @args, '$args';
+ print '-' x 40, "\n";
+ push @args, '@CMD';
+ print '-' x 40, "\n";
+ $cmd->run(\@args, -2);
+ print '-' x 40, "\n";
+ $cmd->run($cmd->{prefix}, -1);
+ print '-' x 40, "\n";
+ my @complete = $cmd->complete('', -1);
+ print join(', ', @complete), "\n";
+ print '-' x 40, "\n";
+ @complete = $cmd->complete('$p', -1);
+ print join(', ', @complete), "\n";
}
1;
View
@@ -1,6 +1,5 @@
-- (tempfile.pl:1)
-no warnings "once";$x=1; $y=2
--- (tempfile.pl:1)
-no warnings "once";$x=1; $y=2
+'no warnings "once";$x=1; $y=2'
Debugged program terminated. Use 'q' to quit or 'R' to restart.
+*** Command 'continue' requires a running program.
trepan.pl: That's all, folks...

0 comments on commit 53d827e

Please sign in to comment.