Permalink
Browse files

info macro: colorize sub if highlight is on. Allow for info macro *. …

…This puts this more inline with other Trepan debuggers.
  • Loading branch information...
1 parent 5c19e61 commit 33a1423fa4ca6dde7f5fd294d5e2c923ce83d7fb Rocky Bernstein committed Feb 5, 2013
View
@@ -10,6 +10,7 @@ example/fns.pl
example/gcd-dbcall.pl
example/gcd-dbg.pl
example/gcd.pl
+example/lsub.pl
example/my.pl
example/next2.pl
example/nexting.pl
@@ -241,6 +242,8 @@ t/20test-list1.t
t/20test-list2.t
t/20test-list3.t
t/20test-list4.t
+t/20test-lsub.t
+t/20test-macro.t
t/20test-my.t
t/20test-next.t
t/20test-next2.t
@@ -295,6 +298,10 @@ t/data/list3.cmd
t/data/list3.right
t/data/list4.cmd
t/data/list4.right
+t/data/lsub.cmd
+t/data/lsub.right
+t/data/macro.cmd
+t/data/macro.right
t/data/my.cmd
t/data/my.right
t/data/next.cmd
@@ -4,6 +4,9 @@
use warnings; no warnings 'redefine'; no warnings 'once';
use rlib '../../../../..';
+# For DB::Linecache;
+use Devel::Trepan::DB::LineCache;
+
package Devel::Trepan::CmdProcessor::Command::Info::Macros;
use Devel::Trepan::CmdProcessor::Command::Subcmd::Core;
@@ -50,18 +53,30 @@ sub run($$) {
my $proc = $self->{proc};
my @args = @$args;
if (scalar(@args) > 2) {
- shift @args; shift @args;
- for my $macro_name (@args) {
+ my @macro_names;
+ if ((scalar(@args)) == 3 && '*' eq $args[2]) {
+ @macro_names = sort keys %{$proc->{macros}};
+ if (scalar @macro_names == 0) {
+ $proc->msg("No macros defined.");
+ return;
+ }
+ } else {
+ @macro_names = @args[2..$#args];
+ }
+ for my $macro_name (@macro_names) {
if (exists $proc->{macros}{$macro_name}) {
- my $msg = sprintf("%s: %s", $macro_name,
- $proc->{macros}{$macro_name}->[1]);
+ my $line = $proc->{macros}{$macro_name}->[1];
+ if ($proc->{settings}{highlight} eq 'term') {
+ $line = DB::LineCache::highlight_string($line);
+ }
+ my $msg = sprintf("%s: %s", $macro_name, $line);
$proc->msg($msg);
} else {
- $proc->msg("$macro_name is not a defined macro");
+ $proc->errmsg("$macro_name is not a defined macro");
}
}
} else {
- my @macros = keys %{$proc->{macros}};
+ my @macros = sort keys %{$proc->{macros}};
if (scalar @macros == 0) {
$proc->msg("No macros defined.");
} else {
@@ -30,14 +30,15 @@ arguments which you supply without parenthesis or commas. See below
for an example.
The macro (really a Perl anonymous subroutine) should return either a
-string or an array reference to a list of strings. The string in both
-cases are strings of debugger commands. If the return is a string,
-that gets tokenized by a simple C<split(/ /, $string)>. Note that
-macro processing is done right after splitting on C<;;> so if the macro
-returns a string containing C<;;> this will not be handled on the
-string returned.
-
-If instead, a reference to a list of strings is returned, then the
+string or an array reference to a list of strings. The string in
+bothcases is a debugger command..
+
+If a string is returned, that gets tokenized by a simple C<split(/ /,
+$string)>. Note that macro processing is done right after splitting
+on C<;;> so if the macro returns a string containing C<;;> this will
+not be handled on the string returned.
+
+If instead a reference to a list of strings is returned, then the
first string is shifted from the array and executed. The remaining
strings are pushed onto the command queue. In contrast to the first
string, subsequent strings can contain other macros. Any C<;;> in those
@@ -70,7 +71,7 @@ you use for other debugger commands, no commas or parenthesis. That is:
rather than C<fin+(3,2)> or C<fin+ 3, 2>.
-See also C<info macro>.
+See also C<alias> and C<info macro>.
=cut
HELP
View
@@ -0,0 +1,7 @@
+#!/usr/bin/env perl
+use warnings; use strict;
+use rlib '.'; use Helper;
+
+my $test_prog = prog_file('gcd.pl');
+run_debugger("$test_prog 3 5");
+done_testing();
View
@@ -0,0 +1,14 @@
+# Test of macro debugger command
+set max width 80
+set highlight off
+info macro
+macro foo
+macro foo sub { 'list' }
+foo
+info macro
+macro bar sub($) { my $count=shift; ['list ' . $count] }
+bar .
+info macro
+info macro *
+quit!
+
View
@@ -0,0 +1,34 @@
+-- main::(gcd.pl:18)
+die sprintf "Need two integer arguments, got %d", scalar(@ARGV) unless
+ @ARGV == 2;
+set max width is 80.
+highlight is off.
+No macros defined.
+*** Command 'macro' needs at least 3 argument(s); got 1.
+Macro "foo" defined.
+gcd.pl [14-21]
+ 14 return $a if ($a == 1) or ($b-$a == 0);
+ 15 return gcd($b-$a, $a);
+ 16 }
+ 17
+ 18 -> die sprintf "Need two integer arguments, got %d", scalar(@ARGV) unless
+ 19 @ARGV == 2;
+ 20 my ($a, $b) = @ARGV[0,1];
+ 21 printf "The GCD of %d and %d is %d\n", $a, $b, gcd($a, $b);
+List of macro names currently defined:
+foo
+Macro "bar" defined.
+gcd.pl [14-21]
+ 14 return $a if ($a == 1) or ($b-$a == 0);
+ 15 return gcd($b-$a, $a);
+ 16 }
+ 17
+ 18 -> die sprintf "Need two integer arguments, got %d", scalar(@ARGV) unless
+ 19 @ARGV == 2;
+ 20 my ($a, $b) = @ARGV[0,1];
+ 21 printf "The GCD of %d and %d is %d\n", $a, $b, gcd($a, $b);
+List of macro names currently defined:
+ bar foo
+bar: sub($) { my $count=shift; ['list ' . $count] }
+foo: sub { 'list' }
+trepan.pl: That's all, folks...

0 comments on commit 33a1423

Please sign in to comment.