—#!/usr/bin/perl
=head1 NAME
gdb++ - GDB wrapper providing nice reflection features
=head1 SYNOPSIS
gdb++ [options] [executable-file [core-file or process-id]]
gdb++ [options] --args executable-file [inferior-arguments ...]
=head2 OPTIONS
=over
=item B<--args>
Pass all parameters after I<executable-file> to the program being debugged.
=item B<-v>
If STDIN is not a tty (e.g. it's a pipe), echo back the GDB prompt as well as
the command being executed.
=item B<-g> I<PATH>
Specify the path to the gdb executable. Defaults to C<gdb>.
=back
=head1 DESCRIPTION
Devel::GDB::Reflect provides a reflection API for GDB/C++, which can
be used to recursively print the contents of STL data structures
(vector, set, map, etc.) within a GDB session. It is not limited
to STL, however; you can write your own delegates for printing custom
container types.
The module provides a script, "gdb++", which serves as a wrapper
around GDB. Invoke it the same way you would invoke gdb, e.g.:
$ gdb++ MYPROG
Within the gdb++ session, you can execute the same commands as within
gdb, with the following extensions:
=over
=item *
C<print_r> I<VAR>
Recursively prints the contents of VAR. The command can be
abbreviated as "pr". For example, if "v" is of type
vector< vector<int> >:
(gdb) pr v
[
[ 11, 12, 13 ],
[ 21, 22, 23 ],
[ 31, 32, 33 ]
]
=item *
C<set gdb_reflect_indent> I<VALUE>
=item *
C<show gdb_reflect_indent>
Set or show the number of spaces to indent at each level of
recursion. Defaults to 4.
=item *
C<set gdb_reflect_max_depth> I<VALUE>
=item *
C<show gdb_reflect_max_depth>
Set or show the maximum recursion depth. Defaults to 5. Example:
(gdb) set gdb_reflect_max_depth 2
(gdb) pr v
[
[ { ... }, { ... }, { ... } ],
[ { ... }, { ... }, { ... } ],
[ { ... }, { ... }, { ... } ]
]
=item *
C<set gdb_reflect_max_width> I<VALUE>
=item *
C<show gdb_reflect_max_width>
Set or show the maximum number of elements to show from a given
container. Defaults to 10. Example:
(gdb) set gdb_reflect_max_width 2
(gdb) pr v
[
[ 11, 12, ... ],
[ 21, 22, ... ],
...
]
=cut
use
warnings;
use
strict;
use
POSIX;
use
Devel::GDB::Reflect;
use
Devel::GDB;
use
Term::ReadLine;
use
Getopt::Long;
use
Pod::Usage;
use
String::ShellQuote;
my
$VERBOSE
;
my
$FILE
;
my
$CORE_FILE
;
my
$ARGS
;
my
$IS_TTY
= -t STDIN;
my
$GDB
=
"gdb"
;
#
# Map from parameter name (e.g. gdb_reflect_indent) to a variable ref
# (e.g. \$Devel::GDB::Reflect::INDENT)
#
sub
get_var($)
{
(
$_
) =
@_
;
/^gdb_reflect_indent$/
and
return
\
$Devel::GDB::Reflect::INDENT
;
/^gdb_reflect_max_width$/
and
return
\
$Devel::GDB::Reflect::MAX_WIDTH
;
/^gdb_reflect_max_depth$/
and
return
\
$Devel::GDB::Reflect::MAX_DEPTH
;
return
undef
;
}
########################################################################
##
## Process the command line arguments
##
# Stop processing arguments after --args
@ARGV
=
map
{ /^--args$/ ? (
$_
,
q(--)
) :
$_
}
@ARGV
;
GetOptions(
'v'
=> \
$VERBOSE
,
'g=s'
=> \
$GDB
,
'args'
=> \
$ARGS
)
or pod2usage();
if
(
defined
$ARGS
)
{
# Lift out $FILE
@ARGV
=
grep
{
defined
(
$FILE
) or /^-/ or
$FILE
=
$_
, 0 }
@ARGV
;
die
"`--args' specified but no program specified"
unless
defined
(
$FILE
);
}
else
{
pod2usage
if
@ARGV
> 2;
(
$FILE
,
$CORE_FILE
) =
@ARGV
;
}
my
@preamble
= ();
push
@preamble
, shell_quote(
'file'
,
$FILE
)
if
defined
(
$FILE
);
push
@preamble
, shell_quote(
'core'
,
$CORE_FILE
)
if
defined
(
$CORE_FILE
);
push
@preamble
, shell_quote(
'args'
,
@ARGV
)
if
defined
(
$ARGS
);
##
## Start up GDB. Work around a lack of proper signal handling in Devel::GDB
## and actually inform the user if GDB dies unexpectedly (or even fails to
## start up).
##
my
(
$gdb
,
$bufs
,
$errs
);
$SIG
{CHLD} =
sub
{
wait
;
return
unless
$?;
my
$msg
=
defined
(
$gdb
) ?
"GDB died unexpectedly"
:
"GDB failed to start"
;
$msg
.= (
", exit status was "
. WEXITSTATUS($?))
if
WIFEXITED($?);
$msg
.= (
", died with signal "
. WTERMSIG($?))
if
WIFSIGNALED($?);
die
$msg
;
};
(
$gdb
,
$bufs
,
$errs
) = new Devel::GDB(
-execfile
=>
$GDB
);
STDERR
$bufs
;
if
(
$errs
)
{
STDERR
$errs
;
die
"Failed to start GDB"
;
}
foreach
(
@preamble
)
{
my
(
$result
,
$error
) =
$gdb
->get(
$_
);
die
"Error: $error"
if
(
$error
);
STDERR
$result
;
}
##
## Set up our environment, and start the main loop
##
my
$reflector
= new Devel::GDB::Reflect(
$gdb
);
# Create a new ReadLine instance if we're reading from a TTY;
# otherwise create a stub that behaves like ReadLine
my
$term
;
if
(
$IS_TTY
)
{
$term
= new Term::ReadLine
'gdb++'
;
my
$rl_attribs
=
$term
->Attribs;
$rl_attribs
->{completion_function} =
sub
{
my
(
$text
,
$line
,
$start
) =
@_
;
my
@gdb_completions
=
map
{
substr
(
$_
,
$start
) }
$reflector
->get_completions(
$line
);
my
@gdbpp_completions
= ();
if
(
$line
=~ /^(set|show)\b/)
{
foreach
(
'gdb_reflect_indent'
,
'gdb_reflect_max_width'
,
'gdb_reflect_max_depth'
)
{
push
@gdbpp_completions
,
$_
if
(
$_
=~ /^\Q
$text
\E/);
}
}
if
(
$text
eq
$line
)
{
foreach
(
'print_r'
,
'pr'
)
{
push
@gdbpp_completions
,
$_
if
(
$_
=~ /^\Q
$text
\E/);
}
}
return
(
@gdb_completions
,
@gdbpp_completions
);
};
}
else
{
$term
= anon
{
readline
=>
sub
{
my
$prompt
=
shift
;
STDERR
$prompt
if
$VERBOSE
;
defined
(
$_
= <STDIN>) and
chomp
$_
or
undef
;
return
$_
;
}
};
}
my
$prompt
=
'(gdb)'
;
my
$lastcmd
=
''
;
my
$lasterror
=
''
;
for
( ;
defined
(
$_
=
$term
->
readline
(
"$prompt "
)) ;
$lastcmd
=
$_
if
/\S/ )
{
STDERR
"$_\n"
if
(!
$IS_TTY
&&
$VERBOSE
);
s/^\s*//;
$_
=
$lastcmd
unless
/\S/;
next
unless
/\S/;
if
(/^(?:print_r|pr)\s+(.*)/)
{
$reflector
->
($1);
}
elsif
(/^(?:set)\s+(gdb_reflect_(?:indent|max_width|max_depth))\b(.*)/)
{
my
$param
= $1;
(
my
$value
= $2) =~ s/\s//;
unless
(
$value
=~ /./)
{
STDERR
"Parameter requires a value!\n"
;
next
;
}
unless
(
$value
=~ /[0-9]+/)
{
STDERR
"Number expected, got '$value'!\n"
;
next
;
}
${get_var(
$param
)} =
$value
;
}
elsif
(/^(?:show)\s+(gdb_reflect_(?:indent|max_width|max_depth))\b/)
{
my
$param
= $1;
STDERR
"$param is "
. ${get_var(
$param
)} .
"\n"
;
}
else
{
(
my
$result
,
$lasterror
,
$prompt
) =
$gdb
->get(
$_
);
STDERR
$result
;
last
if
$lasterror
;
}
}
if
(
$lasterror
eq
''
)
{
# We got EOF on STDIN, so let's quit gdb gracefully
$gdb
->get(
'quit'
);
STDERR
"\n"
;
exit
0;
}
die
"Error: $lasterror"
unless
$lasterror
eq
'EOF'
;