Add command support for Guile.
* Makefile.in (SUBDIR_GUILE_OBS): Add scm-cmd.o. (SUBDIR_GUILE_SRCS): Add scm-cmd.c. (scm-cmd.o): New rule. * guile/guile-internal.h (gdbscm_gc_xstrdup): Declare. (gdbscm_user_error_p): Declare. (gdbscm_parse_command_name): Declare. (gdbscm_valid_command_class_p): Declare. (gdbscm_initialize_commands): Declare. * guile/guile.c (initialize_gdb_module): Call gdbscm_initialize_commands. * guile/lib/gdb.scm: Export command symbols. * guile/lib/gdb/init.scm (%exception-keys): Add gdb:user-error. (throw-user-error): New function. * guile/scm-cmd.c: New file. * guile/scm-exception.c (user_error_symbol): New static global. (gdbscm_user_error_p): New function. (gdbscm_initialize_exceptions): Set user_error_symbol. * scm-utils.c (gdbscm_gc_xstrdup): New function. testsuite/ * gdb.guile/scm-cmd.c: New file. * gdb.guile/scm-cmd.exp: New file. doc/ * guile.texi (Guile API): Add entry for Commands In Guile. (Basic Guile) <parse-and-eval>: Add reference. (Basic Guile) <string->argv>: Move definition to Commands In Guile. (GDB Scheme Data Types): Mention <gdb:command> object. (Commands In Guile): New node.
This commit is contained in:
Doug Evans
parent
fb1f94b09a
commit
e698b8c41c
|
|
@ -1,3 +1,25 @@
|
|||
2014-06-02 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
Add command support for Guile.
|
||||
* Makefile.in (SUBDIR_GUILE_OBS): Add scm-cmd.o.
|
||||
(SUBDIR_GUILE_SRCS): Add scm-cmd.c.
|
||||
(scm-cmd.o): New rule.
|
||||
* guile/guile-internal.h (gdbscm_gc_xstrdup): Declare.
|
||||
(gdbscm_user_error_p): Declare.
|
||||
(gdbscm_parse_command_name): Declare.
|
||||
(gdbscm_valid_command_class_p): Declare.
|
||||
(gdbscm_initialize_commands): Declare.
|
||||
* guile/guile.c (initialize_gdb_module): Call
|
||||
gdbscm_initialize_commands.
|
||||
* guile/lib/gdb.scm: Export command symbols.
|
||||
* guile/lib/gdb/init.scm (%exception-keys): Add gdb:user-error.
|
||||
(throw-user-error): New function.
|
||||
* guile/scm-cmd.c: New file.
|
||||
* guile/scm-exception.c (user_error_symbol): New static global.
|
||||
(gdbscm_user_error_p): New function.
|
||||
(gdbscm_initialize_exceptions): Set user_error_symbol.
|
||||
* scm-utils.c (gdbscm_gc_xstrdup): New function.
|
||||
|
||||
2014-06-02 Phil Muldoon <pmuldoon@redhat.com>
|
||||
|
||||
* top.c (command_loop): Handle comments here...
|
||||
|
|
|
|||
|
|
@ -288,6 +288,7 @@ SUBDIR_GUILE_OBS = \
|
|||
scm-auto-load.o \
|
||||
scm-block.o \
|
||||
scm-breakpoint.o \
|
||||
scm-cmd.o \
|
||||
scm-disasm.o \
|
||||
scm-exception.o \
|
||||
scm-frame.o \
|
||||
|
|
@ -312,6 +313,7 @@ SUBDIR_GUILE_SRCS = \
|
|||
guile/scm-auto-load.c \
|
||||
guile/scm-block.c \
|
||||
guile/scm-breakpoint.c \
|
||||
guile/scm-cmd.c \
|
||||
guile/scm-disasm.c \
|
||||
guile/scm-exception.c \
|
||||
guile/scm-frame.c \
|
||||
|
|
@ -2272,6 +2274,10 @@ scm-breakpoint.o: $(srcdir)/guile/scm-breakpoint.c
|
|||
$(COMPILE) $(srcdir)/guile/scm-breakpoint.c
|
||||
$(POSTCOMPILE)
|
||||
|
||||
scm-cmd.o: $(srcdir)/guile/scm-cmd.c
|
||||
$(COMPILE) $(srcdir)/guile/scm-cmd.c
|
||||
$(POSTCOMPILE)
|
||||
|
||||
scm-disasm.o: $(srcdir)/guile/scm-disasm.c
|
||||
$(COMPILE) $(srcdir)/guile/scm-disasm.c
|
||||
$(POSTCOMPILE)
|
||||
|
|
|
|||
|
|
@ -1,3 +1,11 @@
|
|||
2014-06-02 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
* guile.texi (Guile API): Add entry for Commands In Guile.
|
||||
(Basic Guile) <parse-and-eval>: Add reference.
|
||||
(Basic Guile) <string->argv>: Move definition to Commands In Guile.
|
||||
(GDB Scheme Data Types): Mention <gdb:command> object.
|
||||
(Commands In Guile): New node.
|
||||
|
||||
2014-06-02 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
* guile.texi (Guile API): Add entry for Progspaces In Guile.
|
||||
|
|
|
|||
|
|
@ -141,6 +141,7 @@ from the Guile interactive prompt.
|
|||
* Guile Pretty Printing API:: Pretty-printing values with Guile
|
||||
* Selecting Guile Pretty-Printers:: How GDB chooses a pretty-printer
|
||||
* Writing a Guile Pretty-Printer:: Writing a pretty-printer
|
||||
* Commands In Guile:: Implementing new commands in Guile
|
||||
* Progspaces In Guile:: Program spaces
|
||||
* Objfiles In Guile:: Object files in Guile
|
||||
* Frames In Guile:: Accessing inferior stack frames from Guile
|
||||
|
|
@ -293,16 +294,14 @@ Parse @var{expression} as an expression in the current language,
|
|||
evaluate it, and return the result as a @code{<gdb:value>}.
|
||||
The @var{expression} must be a string.
|
||||
|
||||
This function is useful when computing values.
|
||||
This function can be useful when implementing a new command
|
||||
(@pxref{Commands In Guile}), as it provides a way to parse the
|
||||
command's arguments as an expression.
|
||||
It is also is useful when computing values.
|
||||
For example, it is the only way to get the value of a
|
||||
convenience variable (@pxref{Convenience Vars}) as a @code{<gdb:value>}.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} string->argv string
|
||||
Convert a string to a list of strings split up according to
|
||||
@value{GDBN}'s argv parsing rules.
|
||||
@end deffn
|
||||
|
||||
@node Guile Configuration
|
||||
@subsubsection Guile Configuration
|
||||
@cindex guile configuration
|
||||
|
|
@ -358,6 +357,9 @@ as a symbol.
|
|||
@item <gdb:breakpoint>
|
||||
@xref{Breakpoints In Guile}.
|
||||
|
||||
@item <gdb:command>
|
||||
@xref{Commands In Guile}.
|
||||
|
||||
@item <gdb:exception>
|
||||
@xref{Guile Exception Handling}.
|
||||
|
||||
|
|
@ -1665,6 +1667,285 @@ my_library.so:
|
|||
bar
|
||||
@end smallexample
|
||||
|
||||
@node Commands In Guile
|
||||
@subsubsection Commands In Guile
|
||||
|
||||
@cindex commands in guile
|
||||
@cindex guile commands
|
||||
You can implement new @value{GDBN} CLI commands in Guile. A CLI
|
||||
command object is created with the @code{make-command} Guile function,
|
||||
and added to @value{GDBN} with the @code{register-command!} Guile function.
|
||||
This two-step approach is taken to separate out the side-effect of adding
|
||||
the command to @value{GDBN} from @code{make-command}.
|
||||
|
||||
There is no support for multi-line commands, that is commands that
|
||||
consist of multiple lines and are terminated with @code{end}.
|
||||
|
||||
@c TODO: line length
|
||||
@deffn {Scheme Procedure} (make-command name @r{[}#:invoke invoke{]} @r{[}#:command-class command-class@r{]} @r{[}#:completer-class completer{]} @r{[}#:prefix? prefix@r{]} @r{[}#:doc doc-string{]})
|
||||
|
||||
The argument @var{name} is the name of the command. If @var{name} consists of
|
||||
multiple words, then the initial words are looked for as prefix
|
||||
commands. In this case, if one of the prefix commands does not exist,
|
||||
an exception is raised.
|
||||
|
||||
The result is the @code{<gdb:command>} object representing the command.
|
||||
The command is not usable until it has been registered with @value{GDBN}
|
||||
with @code{register-command!}.
|
||||
|
||||
The rest of the arguments are optional.
|
||||
|
||||
The argument @var{invoke} is a procedure of three arguments: @var{self},
|
||||
@var{args} and @var{from-tty}. The argument @var{self} is the
|
||||
@code{<gdb:command>} object representing the command.
|
||||
The argument @var{args} is a string representing the arguments passed to
|
||||
the command, after leading and trailing whitespace has been stripped.
|
||||
The argument @var{from-tty} is a boolean flag and specifies whether the
|
||||
command should consider itself to have been originated from the user
|
||||
invoking it interactively. If this function throws an exception,
|
||||
it is turned into a @value{GDBN} @code{error} call.
|
||||
Otherwise, the return value is ignored.
|
||||
|
||||
The argument @var{command-class} is one of the @samp{COMMAND_} constants
|
||||
defined below. This argument tells @value{GDBN} how to categorize the
|
||||
new command in the help system. The default is @code{COMMAND_NONE}.
|
||||
|
||||
The argument @var{completer} is either @code{#f}, one of the @samp{COMPLETE_}
|
||||
constants defined below, or a procedure, also defined below.
|
||||
This argument tells @value{GDBN} how to perform completion
|
||||
for this command. If not provided or if the value is @code{#f},
|
||||
then no completion is performed on the command.
|
||||
|
||||
The argument @var{prefix} is a boolean flag indicating whether the new
|
||||
command is a prefix command; sub-commands of this command may be
|
||||
registered.
|
||||
|
||||
The argument @var{doc-string} is help text for the new command.
|
||||
If no documentation string is provided, the default value ``This command is
|
||||
not documented.'' is used.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} register-command! command
|
||||
Add @var{command}, a @code{<gdb:command>} object, to @value{GDBN}'s
|
||||
list of commands.
|
||||
It is an error to register a command more than once.
|
||||
The result is unspecified.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} command? object
|
||||
Return @code{#t} if @var{object} is a @code{<gdb:command>} object.
|
||||
Otherwise return @code{#f}.
|
||||
@end deffn
|
||||
|
||||
@cindex don't repeat Guile command
|
||||
@deffn {Scheme Procedure} dont-repeat
|
||||
By default, a @value{GDBN} command is repeated when the user enters a
|
||||
blank line at the command prompt. A command can suppress this
|
||||
behavior by invoking the @code{dont-repeat} function. This is similar
|
||||
to the user command @code{dont-repeat}, see @ref{Define, dont-repeat}.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} string->argv string
|
||||
Convert a string to a list of strings split up according to
|
||||
@value{GDBN}'s argv parsing rules.
|
||||
It is recommended to use this for consistency.
|
||||
Arguments are separated by spaces and may be quoted.
|
||||
Example:
|
||||
|
||||
@smallexample
|
||||
scheme@@(guile-user)> (string->argv "1 2\\ \\\"3 '4 \"5' \"6 '7\"")
|
||||
$1 = ("1" "2 \"3" "4 \"5" "6 '7")
|
||||
@end smallexample
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} throw-user-error message . args
|
||||
Throw a @code{gdb:user-error} exception.
|
||||
The argument @var{message} is the error message as a format string, like the
|
||||
@var{fmt} argument to the @code{format} Scheme function.
|
||||
@xref{Formatted Output,,, guile, GNU Guile Reference Manual}.
|
||||
The argument @var{args} is a list of the optional arguments of @var{message}.
|
||||
|
||||
This is used when the command detects a user error of some kind,
|
||||
say a bad command argument.
|
||||
|
||||
@smallexample
|
||||
(gdb) guile (use-modules (gdb))
|
||||
(gdb) guile
|
||||
(register-command! (make-command "test-user-error"
|
||||
#:command-class COMMAND_OBSCURE
|
||||
#:invoke (lambda (self arg from-tty)
|
||||
(throw-user-error "Bad argument ~a" arg))))
|
||||
end
|
||||
(gdb) test-user-error ugh
|
||||
ERROR: Bad argument ugh
|
||||
@end smallexample
|
||||
@end deffn
|
||||
|
||||
@cindex completion of Guile commands
|
||||
@deffn completer self text word
|
||||
If the @var{completer} option to @code{make-command} is a procedure,
|
||||
it takes three arguments: @var{self} which is the @code{<gdb:command>}
|
||||
object, and @var{text} and @var{word} which are both strings.
|
||||
The argument @var{text} holds the complete command line up to the cursor's
|
||||
location. The argument @var{word} holds the last word of the command line;
|
||||
this is computed using a word-breaking heuristic.
|
||||
|
||||
All forms of completion are handled by this function, that is,
|
||||
the @key{TAB} and @key{M-?} key bindings (@pxref{Completion}),
|
||||
and the @code{complete} command (@pxref{Help, complete}).
|
||||
|
||||
This procedure can return several kinds of values:
|
||||
|
||||
@itemize @bullet
|
||||
@item
|
||||
If the return value is a list, the contents of the list are used as the
|
||||
completions. It is up to @var{completer} to ensure that the
|
||||
contents actually do complete the word. An empty list is
|
||||
allowed, it means that there were no completions available. Only
|
||||
string elements of the list are used; other elements in the
|
||||
list are ignored.
|
||||
|
||||
@item
|
||||
If the return value is a @code{<gdb:iterator>} object, it is iterated over to
|
||||
obtain the completions. It is up to @code{completer-procedure} to ensure
|
||||
that the results actually do complete the word. Only
|
||||
string elements of the result are used; other elements in the
|
||||
sequence are ignored.
|
||||
|
||||
@item
|
||||
All other results are treated as though there were no available
|
||||
completions.
|
||||
@end itemize
|
||||
@end deffn
|
||||
|
||||
When a new command is registered, it will have been declared as a member of
|
||||
some general class of commands. This is used to classify top-level
|
||||
commands in the on-line help system; note that prefix commands are not
|
||||
listed under their own category but rather that of their top-level
|
||||
command. The available classifications are represented by constants
|
||||
defined in the @code{gdb} module:
|
||||
|
||||
@vtable @code
|
||||
@item COMMAND_NONE
|
||||
The command does not belong to any particular class. A command in
|
||||
this category will not be displayed in any of the help categories.
|
||||
This is the default.
|
||||
|
||||
@item COMMAND_RUNNING
|
||||
The command is related to running the inferior. For example,
|
||||
@code{start}, @code{step}, and @code{continue} are in this category.
|
||||
Type @kbd{help running} at the @value{GDBN} prompt to see a list of
|
||||
commands in this category.
|
||||
|
||||
@item COMMAND_DATA
|
||||
The command is related to data or variables. For example,
|
||||
@code{call}, @code{find}, and @code{print} are in this category. Type
|
||||
@kbd{help data} at the @value{GDBN} prompt to see a list of commands
|
||||
in this category.
|
||||
|
||||
@item COMMAND_STACK
|
||||
The command has to do with manipulation of the stack. For example,
|
||||
@code{backtrace}, @code{frame}, and @code{return} are in this
|
||||
category. Type @kbd{help stack} at the @value{GDBN} prompt to see a
|
||||
list of commands in this category.
|
||||
|
||||
@item COMMAND_FILES
|
||||
This class is used for file-related commands. For example,
|
||||
@code{file}, @code{list} and @code{section} are in this category.
|
||||
Type @kbd{help files} at the @value{GDBN} prompt to see a list of
|
||||
commands in this category.
|
||||
|
||||
@item COMMAND_SUPPORT
|
||||
This should be used for ``support facilities'', generally meaning
|
||||
things that are useful to the user when interacting with @value{GDBN},
|
||||
but not related to the state of the inferior. For example,
|
||||
@code{help}, @code{make}, and @code{shell} are in this category. Type
|
||||
@kbd{help support} at the @value{GDBN} prompt to see a list of
|
||||
commands in this category.
|
||||
|
||||
@item COMMAND_STATUS
|
||||
The command is an @samp{info}-related command, that is, related to the
|
||||
state of @value{GDBN} itself. For example, @code{info}, @code{macro},
|
||||
and @code{show} are in this category. Type @kbd{help status} at the
|
||||
@value{GDBN} prompt to see a list of commands in this category.
|
||||
|
||||
@item COMMAND_BREAKPOINTS
|
||||
The command has to do with breakpoints. For example, @code{break},
|
||||
@code{clear}, and @code{delete} are in this category. Type @kbd{help
|
||||
breakpoints} at the @value{GDBN} prompt to see a list of commands in
|
||||
this category.
|
||||
|
||||
@item COMMAND_TRACEPOINTS
|
||||
The command has to do with tracepoints. For example, @code{trace},
|
||||
@code{actions}, and @code{tfind} are in this category. Type
|
||||
@kbd{help tracepoints} at the @value{GDBN} prompt to see a list of
|
||||
commands in this category.
|
||||
|
||||
@item COMMAND_USER
|
||||
The command is a general purpose command for the user, and typically
|
||||
does not fit in one of the other categories.
|
||||
Type @kbd{help user-defined} at the @value{GDBN} prompt to see
|
||||
a list of commands in this category, as well as the list of gdb macros
|
||||
(@pxref{Sequences}).
|
||||
|
||||
@item COMMAND_OBSCURE
|
||||
The command is only used in unusual circumstances, or is not of
|
||||
general interest to users. For example, @code{checkpoint},
|
||||
@code{fork}, and @code{stop} are in this category. Type @kbd{help
|
||||
obscure} at the @value{GDBN} prompt to see a list of commands in this
|
||||
category.
|
||||
|
||||
@item COMMAND_MAINTENANCE
|
||||
The command is only useful to @value{GDBN} maintainers. The
|
||||
@code{maintenance} and @code{flushregs} commands are in this category.
|
||||
Type @kbd{help internals} at the @value{GDBN} prompt to see a list of
|
||||
commands in this category.
|
||||
@end vtable
|
||||
|
||||
A new command can use a predefined completion function, either by
|
||||
specifying it via an argument at initialization, or by returning it
|
||||
from the @code{completer} procedure. These predefined completion
|
||||
constants are all defined in the @code{gdb} module:
|
||||
|
||||
@vtable @code
|
||||
@item COMPLETE_NONE
|
||||
This constant means that no completion should be done.
|
||||
|
||||
@item COMPLETE_FILENAME
|
||||
This constant means that filename completion should be performed.
|
||||
|
||||
@item COMPLETE_LOCATION
|
||||
This constant means that location completion should be done.
|
||||
@xref{Specify Location}.
|
||||
|
||||
@item COMPLETE_COMMAND
|
||||
This constant means that completion should examine @value{GDBN}
|
||||
command names.
|
||||
|
||||
@item COMPLETE_SYMBOL
|
||||
This constant means that completion should be done using symbol names
|
||||
as the source.
|
||||
|
||||
@item COMPLETE_EXPRESSION
|
||||
This constant means that completion should be done on expressions.
|
||||
Often this means completing on symbol names, but some language
|
||||
parsers also have support for completing on field names.
|
||||
@end vtable
|
||||
|
||||
The following code snippet shows how a trivial CLI command can be
|
||||
implemented in Guile:
|
||||
|
||||
@smallexample
|
||||
(gdb) guile
|
||||
(register-command! (make-command "hello-world"
|
||||
#:command-class COMMAND_USER
|
||||
#:doc "Greet the whole world."
|
||||
#:invoke (lambda (self args from-tty) (display "Hello, World!\n"))))
|
||||
end
|
||||
(gdb) hello-world
|
||||
Hello, World!
|
||||
@end smallexample
|
||||
|
||||
@node Progspaces In Guile
|
||||
@subsubsection Program Spaces In Guile
|
||||
|
||||
|
|
|
|||
|
|
@ -164,6 +164,8 @@ extern ULONGEST gdbscm_scm_to_ulongest (SCM u);
|
|||
extern void gdbscm_dynwind_xfree (void *ptr);
|
||||
|
||||
extern int gdbscm_is_procedure (SCM proc);
|
||||
|
||||
extern char *gdbscm_gc_xstrdup (const char *);
|
||||
|
||||
/* GDB smobs, from scm-gsmob.c */
|
||||
|
||||
|
|
@ -315,6 +317,8 @@ extern char *gdbscm_exception_message_to_string (SCM exception);
|
|||
|
||||
extern excp_matcher_func gdbscm_memory_error_p;
|
||||
|
||||
extern excp_matcher_func gdbscm_user_error_p;
|
||||
|
||||
extern SCM gdbscm_make_memory_error (const char *subr, const char *msg,
|
||||
SCM args);
|
||||
|
||||
|
|
@ -375,6 +379,15 @@ extern SCM bkscm_scm_from_block (const struct block *block,
|
|||
extern const struct block *bkscm_scm_to_block
|
||||
(SCM block_scm, int arg_pos, const char *func_name, SCM *excp);
|
||||
|
||||
/* scm-cmd.c */
|
||||
|
||||
extern char *gdbscm_parse_command_name (const char *name,
|
||||
const char *func_name, int arg_pos,
|
||||
struct cmd_list_element ***base_list,
|
||||
struct cmd_list_element **start_list);
|
||||
|
||||
extern int gdbscm_valid_command_class_p (int command_class);
|
||||
|
||||
/* scm-frame.c */
|
||||
|
||||
typedef struct _frame_smob frame_smob;
|
||||
|
|
@ -543,6 +556,7 @@ extern void gdbscm_initialize_arches (void);
|
|||
extern void gdbscm_initialize_auto_load (void);
|
||||
extern void gdbscm_initialize_blocks (void);
|
||||
extern void gdbscm_initialize_breakpoints (void);
|
||||
extern void gdbscm_initialize_commands (void);
|
||||
extern void gdbscm_initialize_disasm (void);
|
||||
extern void gdbscm_initialize_exceptions (void);
|
||||
extern void gdbscm_initialize_frames (void);
|
||||
|
|
|
|||
|
|
@ -537,6 +537,7 @@ initialize_gdb_module (void *data)
|
|||
gdbscm_initialize_auto_load ();
|
||||
gdbscm_initialize_blocks ();
|
||||
gdbscm_initialize_breakpoints ();
|
||||
gdbscm_initialize_commands ();
|
||||
gdbscm_initialize_disasm ();
|
||||
gdbscm_initialize_frames ();
|
||||
gdbscm_initialize_iterators ();
|
||||
|
|
|
|||
|
|
@ -141,6 +141,34 @@
|
|||
set-breakpoint-stop!
|
||||
breakpoint-commands
|
||||
|
||||
;; scm-cmd.c
|
||||
|
||||
make-command
|
||||
register-command!
|
||||
command?
|
||||
command-valid?
|
||||
dont-repeat
|
||||
|
||||
COMPLETE_NONE
|
||||
COMPLETE_FILENAME
|
||||
COMPLETE_LOCATION
|
||||
COMPLETE_COMMAND
|
||||
COMPLETE_SYMBOL
|
||||
COMPLETE_EXPRESSION
|
||||
|
||||
COMMAND_NONE
|
||||
COMMAND_RUNNING
|
||||
COMMAND_DATA
|
||||
COMMAND_STACK
|
||||
COMMAND_FILES
|
||||
COMMAND_SUPPORT
|
||||
COMMAND_STATUS
|
||||
COMMAND_BREAKPOINTS
|
||||
COMMAND_TRACEPOINTS
|
||||
COMMAND_OBSCURE
|
||||
COMMAND_MAINTENANCE
|
||||
COMMAND_USER
|
||||
|
||||
;; scm-disasm.c
|
||||
|
||||
arch-disassemble
|
||||
|
|
@ -457,4 +485,5 @@
|
|||
orig-input-port
|
||||
orig-output-port
|
||||
orig-error-port
|
||||
throw-user-error
|
||||
)
|
||||
|
|
|
|||
|
|
@ -37,7 +37,8 @@
|
|||
(define %exception-keys '(gdb:error
|
||||
gdb:invalid-object-error
|
||||
gdb:memory-error
|
||||
gdb:pp-type-error))
|
||||
gdb:pp-type-error
|
||||
gdb:user-error))
|
||||
|
||||
;; Printer for gdb exceptions, used when Scheme tries to print them directly.
|
||||
|
||||
|
|
@ -171,3 +172,10 @@
|
|||
(define-public (orig-input-port) %orig-input-port)
|
||||
(define-public (orig-output-port) %orig-output-port)
|
||||
(define-public (orig-error-port) %orig-error-port)
|
||||
|
||||
;; Utility to throw gdb:user-error for use in writing gdb commands.
|
||||
;; The requirements for the arguments to "throw" are a bit obscure,
|
||||
;; so give the user something simpler.
|
||||
|
||||
(define-public (throw-user-error message . args)
|
||||
(throw 'gdb:user-error #f message args))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,893 @@
|
|||
/* GDB commands implemented in Scheme.
|
||||
|
||||
Copyright (C) 2008-2014 Free Software Foundation, Inc.
|
||||
|
||||
This file is part of GDB.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>. */
|
||||
|
||||
/* See README file in this directory for implementation notes, coding
|
||||
conventions, et.al. */
|
||||
|
||||
#include "defs.h"
|
||||
#include <ctype.h>
|
||||
#include "exceptions.h"
|
||||
#include "charset.h"
|
||||
#include "gdbcmd.h"
|
||||
#include "cli/cli-decode.h"
|
||||
#include "completer.h"
|
||||
#include "guile-internal.h"
|
||||
|
||||
/* The <gdb:command> smob.
|
||||
|
||||
Note: Commands are added to gdb using a two step process:
|
||||
1) Call make-command to create a <gdb:command> object.
|
||||
2) Call register-command! to add the command to gdb.
|
||||
It is done this way so that the constructor, make-command, doesn't have
|
||||
any side-effects. This means that the smob needs to store everything
|
||||
that was passed to make-command. */
|
||||
|
||||
typedef struct _command_smob
|
||||
{
|
||||
/* This always appears first. */
|
||||
gdb_smob base;
|
||||
|
||||
/* The name of the command, as passed to make-command. */
|
||||
char *name;
|
||||
|
||||
/* The last word of the command.
|
||||
This is needed because add_cmd requires us to allocate space
|
||||
for it. :-( */
|
||||
char *cmd_name;
|
||||
|
||||
/* Non-zero if this is a prefix command. */
|
||||
int is_prefix;
|
||||
|
||||
/* One of the COMMAND_* constants. */
|
||||
enum command_class cmd_class;
|
||||
|
||||
/* The documentation for the command. */
|
||||
char *doc;
|
||||
|
||||
/* The corresponding gdb command object.
|
||||
This is NULL if the command has not been registered yet, or
|
||||
is no longer registered. */
|
||||
struct cmd_list_element *command;
|
||||
|
||||
/* A prefix command requires storage for a list of its sub-commands.
|
||||
A pointer to this is passed to add_prefix_command, and to add_cmd
|
||||
for sub-commands of that prefix.
|
||||
This is NULL if the command has not been registered yet, or
|
||||
is no longer registered. If this command is not a prefix
|
||||
command, then this field is unused. */
|
||||
struct cmd_list_element *sub_list;
|
||||
|
||||
/* The procedure to call to invoke the command.
|
||||
(lambda (self arg from-tty) ...).
|
||||
Its result is unspecified. */
|
||||
SCM invoke;
|
||||
|
||||
/* Either #f, one of the COMPLETE_* constants, or a procedure to call to
|
||||
perform command completion. Called as (lambda (self text word) ...). */
|
||||
SCM complete;
|
||||
|
||||
/* The <gdb:command> object we are contained in, needed to protect/unprotect
|
||||
the object since a reference to it comes from non-gc-managed space
|
||||
(the command context pointer). */
|
||||
SCM containing_scm;
|
||||
} command_smob;
|
||||
|
||||
static const char command_smob_name[] = "gdb:command";
|
||||
|
||||
/* The tag Guile knows the objfile smob by. */
|
||||
static scm_t_bits command_smob_tag;
|
||||
|
||||
/* Keywords used by make-command. */
|
||||
static SCM invoke_keyword;
|
||||
static SCM command_class_keyword;
|
||||
static SCM completer_class_keyword;
|
||||
static SCM prefix_p_keyword;
|
||||
static SCM doc_keyword;
|
||||
|
||||
/* Struct representing built-in completion types. */
|
||||
struct cmdscm_completer
|
||||
{
|
||||
/* Scheme symbol name. */
|
||||
const char *name;
|
||||
/* Completion function. */
|
||||
completer_ftype *completer;
|
||||
};
|
||||
|
||||
static const struct cmdscm_completer cmdscm_completers[] =
|
||||
{
|
||||
{ "COMPLETE_NONE", noop_completer },
|
||||
{ "COMPLETE_FILENAME", filename_completer },
|
||||
{ "COMPLETE_LOCATION", location_completer },
|
||||
{ "COMPLETE_COMMAND", command_completer },
|
||||
{ "COMPLETE_SYMBOL", make_symbol_completion_list_fn },
|
||||
{ "COMPLETE_EXPRESSION", expression_completer },
|
||||
};
|
||||
|
||||
#define N_COMPLETERS (sizeof (cmdscm_completers) \
|
||||
/ sizeof (cmdscm_completers[0]))
|
||||
|
||||
static int cmdscm_is_valid (command_smob *);
|
||||
|
||||
/* Administrivia for command smobs. */
|
||||
|
||||
/* The smob "print" function for <gdb:command>. */
|
||||
|
||||
static int
|
||||
cmdscm_print_command_smob (SCM self, SCM port, scm_print_state *pstate)
|
||||
{
|
||||
command_smob *c_smob = (command_smob *) SCM_SMOB_DATA (self);
|
||||
|
||||
gdbscm_printf (port, "#<%s", command_smob_name);
|
||||
|
||||
gdbscm_printf (port, " %s",
|
||||
c_smob->name != NULL ? c_smob->name : "{unnamed}");
|
||||
|
||||
if (! cmdscm_is_valid (c_smob))
|
||||
scm_puts (" {invalid}", port);
|
||||
|
||||
scm_puts (">", port);
|
||||
|
||||
scm_remember_upto_here_1 (self);
|
||||
|
||||
/* Non-zero means success. */
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Low level routine to create a <gdb:command> object.
|
||||
It's empty in the sense that a command still needs to be associated
|
||||
with it. */
|
||||
|
||||
static SCM
|
||||
cmdscm_make_command_smob (void)
|
||||
{
|
||||
command_smob *c_smob = (command_smob *)
|
||||
scm_gc_malloc (sizeof (command_smob), command_smob_name);
|
||||
SCM c_scm;
|
||||
|
||||
memset (c_smob, 0, sizeof (*c_smob));
|
||||
c_smob->cmd_class = no_class;
|
||||
c_smob->invoke = SCM_BOOL_F;
|
||||
c_smob->complete = SCM_BOOL_F;
|
||||
c_scm = scm_new_smob (command_smob_tag, (scm_t_bits) c_smob);
|
||||
c_smob->containing_scm = c_scm;
|
||||
gdbscm_init_gsmob (&c_smob->base);
|
||||
|
||||
return c_scm;
|
||||
}
|
||||
|
||||
/* Clear the COMMAND pointer in C_SMOB and unprotect the object from GC. */
|
||||
|
||||
static void
|
||||
cmdscm_release_command (command_smob *c_smob)
|
||||
{
|
||||
c_smob->command = NULL;
|
||||
scm_gc_unprotect_object (c_smob->containing_scm);
|
||||
}
|
||||
|
||||
/* Return non-zero if SCM is a command smob. */
|
||||
|
||||
static int
|
||||
cmdscm_is_command (SCM scm)
|
||||
{
|
||||
return SCM_SMOB_PREDICATE (command_smob_tag, scm);
|
||||
}
|
||||
|
||||
/* (command? scm) -> boolean */
|
||||
|
||||
static SCM
|
||||
gdbscm_command_p (SCM scm)
|
||||
{
|
||||
return scm_from_bool (cmdscm_is_command (scm));
|
||||
}
|
||||
|
||||
/* Returns the <gdb:command> object in SELF.
|
||||
Throws an exception if SELF is not a <gdb:command> object. */
|
||||
|
||||
static SCM
|
||||
cmdscm_get_command_arg_unsafe (SCM self, int arg_pos, const char *func_name)
|
||||
{
|
||||
SCM_ASSERT_TYPE (cmdscm_is_command (self), self, arg_pos, func_name,
|
||||
command_smob_name);
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
/* Returns a pointer to the command smob of SELF.
|
||||
Throws an exception if SELF is not a <gdb:command> object. */
|
||||
|
||||
static command_smob *
|
||||
cmdscm_get_command_smob_arg_unsafe (SCM self, int arg_pos,
|
||||
const char *func_name)
|
||||
{
|
||||
SCM c_scm = cmdscm_get_command_arg_unsafe (self, arg_pos, func_name);
|
||||
command_smob *c_smob = (command_smob *) SCM_SMOB_DATA (c_scm);
|
||||
|
||||
return c_smob;
|
||||
}
|
||||
|
||||
/* Return non-zero if command C_SMOB is valid. */
|
||||
|
||||
static int
|
||||
cmdscm_is_valid (command_smob *c_smob)
|
||||
{
|
||||
return c_smob->command != NULL;
|
||||
}
|
||||
|
||||
/* Returns a pointer to the command smob of SELF.
|
||||
Throws an exception if SELF is not a valid <gdb:command> object. */
|
||||
|
||||
static command_smob *
|
||||
cmdscm_get_valid_command_smob_arg_unsafe (SCM self, int arg_pos,
|
||||
const char *func_name)
|
||||
{
|
||||
command_smob *c_smob
|
||||
= cmdscm_get_command_smob_arg_unsafe (self, arg_pos, func_name);
|
||||
|
||||
if (!cmdscm_is_valid (c_smob))
|
||||
{
|
||||
gdbscm_invalid_object_error (func_name, arg_pos, self,
|
||||
_("<gdb:command>"));
|
||||
}
|
||||
|
||||
return c_smob;
|
||||
}
|
||||
|
||||
/* Scheme functions for GDB commands. */
|
||||
|
||||
/* (command-valid? <gdb:command>) -> boolean
|
||||
Returns #t if SELF is still valid. */
|
||||
|
||||
static SCM
|
||||
gdbscm_command_valid_p (SCM self)
|
||||
{
|
||||
command_smob *c_smob
|
||||
= cmdscm_get_command_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||
|
||||
return scm_from_bool (cmdscm_is_valid (c_smob));
|
||||
}
|
||||
|
||||
/* (dont-repeat cmd) -> unspecified
|
||||
Scheme function which wraps dont_repeat. */
|
||||
|
||||
static SCM
|
||||
gdbscm_dont_repeat (SCM self)
|
||||
{
|
||||
/* We currently don't need anything from SELF, but still verify it. */
|
||||
command_smob *c_smob
|
||||
= cmdscm_get_valid_command_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||
|
||||
dont_repeat ();
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
/* The make-command function. */
|
||||
|
||||
/* Called if the gdb cmd_list_element is destroyed. */
|
||||
|
||||
static void
|
||||
cmdscm_destroyer (struct cmd_list_element *self, void *context)
|
||||
{
|
||||
command_smob *c_smob = (command_smob *) context;
|
||||
|
||||
cmdscm_release_command (c_smob);
|
||||
|
||||
/* We allocated the name, doc string, and perhaps the prefix name. */
|
||||
xfree ((char *) self->name);
|
||||
xfree (self->doc);
|
||||
xfree (self->prefixname);
|
||||
}
|
||||
|
||||
/* Called by gdb to invoke the command. */
|
||||
|
||||
static void
|
||||
cmdscm_function (struct cmd_list_element *command, char *args, int from_tty)
|
||||
{
|
||||
command_smob *c_smob/*obj*/ = (command_smob *) get_cmd_context (command);
|
||||
SCM arg_scm, tty_scm, result;
|
||||
|
||||
gdb_assert (c_smob != NULL);
|
||||
|
||||
if (args == NULL)
|
||||
args = "";
|
||||
arg_scm = gdbscm_scm_from_string (args, strlen (args), host_charset (), 1);
|
||||
if (gdbscm_is_exception (arg_scm))
|
||||
error (_("Could not convert arguments to Scheme string."));
|
||||
|
||||
tty_scm = scm_from_bool (from_tty);
|
||||
|
||||
result = gdbscm_safe_call_3 (c_smob->invoke, c_smob->containing_scm,
|
||||
arg_scm, tty_scm, gdbscm_user_error_p);
|
||||
|
||||
if (gdbscm_is_exception (result))
|
||||
{
|
||||
/* Don't print the stack if this was an error signalled by the command
|
||||
itself. */
|
||||
if (gdbscm_user_error_p (gdbscm_exception_key (result)))
|
||||
{
|
||||
char *msg = gdbscm_exception_message_to_string (result);
|
||||
|
||||
make_cleanup (xfree, msg);
|
||||
error ("%s", msg);
|
||||
}
|
||||
else
|
||||
{
|
||||
gdbscm_print_gdb_exception (SCM_BOOL_F, result);
|
||||
error (_("Error occurred in Scheme-implemented GDB command."));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Subroutine of cmdscm_completer to simplify it.
|
||||
Print an error message indicating that COMPLETION is a bad completion
|
||||
result. */
|
||||
|
||||
static void
|
||||
cmdscm_bad_completion_result (const char *msg, SCM completion)
|
||||
{
|
||||
SCM port = scm_current_error_port ();
|
||||
|
||||
scm_puts (msg, port);
|
||||
scm_display (completion, port);
|
||||
scm_newline (port);
|
||||
}
|
||||
|
||||
/* Subroutine of cmdscm_completer to simplify it.
|
||||
Validate COMPLETION and add to RESULT.
|
||||
If an error occurs print an error message.
|
||||
The result is a boolean indicating success. */
|
||||
|
||||
static int
|
||||
cmdscm_add_completion (SCM completion, VEC (char_ptr) **result)
|
||||
{
|
||||
char *item;
|
||||
SCM except_scm;
|
||||
|
||||
if (!scm_is_string (completion))
|
||||
{
|
||||
/* Inform the user, but otherwise ignore the entire result. */
|
||||
cmdscm_bad_completion_result (_("Bad text from completer: "),
|
||||
completion);
|
||||
return 0;
|
||||
}
|
||||
|
||||
item = gdbscm_scm_to_string (completion, NULL, host_charset (), 1,
|
||||
&except_scm);
|
||||
if (item == NULL)
|
||||
{
|
||||
/* Inform the user, but otherwise ignore the entire result. */
|
||||
gdbscm_print_gdb_exception (SCM_BOOL_F, except_scm);
|
||||
return 0;
|
||||
}
|
||||
|
||||
VEC_safe_push (char_ptr, *result, item);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Called by gdb for command completion. */
|
||||
|
||||
static VEC (char_ptr) *
|
||||
cmdscm_completer (struct cmd_list_element *command,
|
||||
const char *text, const char *word)
|
||||
{
|
||||
command_smob *c_smob/*obj*/ = (command_smob *) get_cmd_context (command);
|
||||
SCM completer_result_scm;
|
||||
SCM text_scm, word_scm, result_scm;
|
||||
VEC (char_ptr) *result = NULL;
|
||||
|
||||
gdb_assert (c_smob != NULL);
|
||||
gdb_assert (gdbscm_is_procedure (c_smob->complete));
|
||||
|
||||
text_scm = gdbscm_scm_from_string (text, strlen (text), host_charset (),
|
||||
1);
|
||||
if (gdbscm_is_exception (text_scm))
|
||||
error (_("Could not convert \"text\" argument to Scheme string."));
|
||||
word_scm = gdbscm_scm_from_string (word, strlen (word), host_charset (),
|
||||
1);
|
||||
if (gdbscm_is_exception (word_scm))
|
||||
error (_("Could not convert \"word\" argument to Scheme string."));
|
||||
|
||||
completer_result_scm
|
||||
= gdbscm_safe_call_3 (c_smob->complete, c_smob->containing_scm,
|
||||
text_scm, word_scm, NULL);
|
||||
|
||||
if (gdbscm_is_exception (completer_result_scm))
|
||||
{
|
||||
/* Inform the user, but otherwise ignore. */
|
||||
gdbscm_print_gdb_exception (SCM_BOOL_F, completer_result_scm);
|
||||
goto done;
|
||||
}
|
||||
|
||||
if (gdbscm_is_true (scm_list_p (completer_result_scm)))
|
||||
{
|
||||
SCM list = completer_result_scm;
|
||||
|
||||
while (!scm_is_eq (list, SCM_EOL))
|
||||
{
|
||||
SCM next = scm_car (list);
|
||||
|
||||
if (!cmdscm_add_completion (next, &result))
|
||||
{
|
||||
VEC_free (char_ptr, result);
|
||||
goto done;
|
||||
}
|
||||
|
||||
list = scm_cdr (list);
|
||||
}
|
||||
}
|
||||
else if (itscm_is_iterator (completer_result_scm))
|
||||
{
|
||||
SCM iter = completer_result_scm;
|
||||
SCM next = itscm_safe_call_next_x (iter, NULL);
|
||||
|
||||
while (gdbscm_is_true (next))
|
||||
{
|
||||
if (gdbscm_is_exception (next))
|
||||
{
|
||||
/* Inform the user, but otherwise ignore the entire result. */
|
||||
gdbscm_print_gdb_exception (SCM_BOOL_F, completer_result_scm);
|
||||
VEC_free (char_ptr, result);
|
||||
goto done;
|
||||
}
|
||||
|
||||
if (!cmdscm_add_completion (next, &result))
|
||||
{
|
||||
VEC_free (char_ptr, result);
|
||||
goto done;
|
||||
}
|
||||
|
||||
next = itscm_safe_call_next_x (iter, NULL);
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Inform the user, but otherwise ignore. */
|
||||
cmdscm_bad_completion_result (_("Bad completer result: "),
|
||||
completer_result_scm);
|
||||
}
|
||||
|
||||
done:
|
||||
return result;
|
||||
}
|
||||
|
||||
/* Helper for gdbscm_make_command which locates the command list to use and
|
||||
pulls out the command name.
|
||||
|
||||
NAME is the command name list. The final word in the list is the
|
||||
name of the new command. All earlier words must be existing prefix
|
||||
commands.
|
||||
|
||||
*BASE_LIST is set to the final prefix command's list of
|
||||
*sub-commands.
|
||||
|
||||
START_LIST is the list in which the search starts.
|
||||
|
||||
This function returns the xmalloc()d name of the new command.
|
||||
On error a Scheme exception is thrown. */
|
||||
|
||||
char *
|
||||
gdbscm_parse_command_name (const char *name,
|
||||
const char *func_name, int arg_pos,
|
||||
struct cmd_list_element ***base_list,
|
||||
struct cmd_list_element **start_list)
|
||||
{
|
||||
struct cmd_list_element *elt;
|
||||
int len = strlen (name);
|
||||
int i, lastchar;
|
||||
char *prefix_text;
|
||||
const char *prefix_text2;
|
||||
char *result, *msg;
|
||||
|
||||
/* Skip trailing whitespace. */
|
||||
for (i = len - 1; i >= 0 && (name[i] == ' ' || name[i] == '\t'); --i)
|
||||
;
|
||||
if (i < 0)
|
||||
{
|
||||
gdbscm_out_of_range_error (func_name, arg_pos,
|
||||
gdbscm_scm_from_c_string (name),
|
||||
_("no command name found"));
|
||||
}
|
||||
lastchar = i;
|
||||
|
||||
/* Find first character of the final word. */
|
||||
for (; i > 0 && (isalnum (name[i - 1])
|
||||
|| name[i - 1] == '-'
|
||||
|| name[i - 1] == '_');
|
||||
--i)
|
||||
;
|
||||
result = xmalloc (lastchar - i + 2);
|
||||
memcpy (result, &name[i], lastchar - i + 1);
|
||||
result[lastchar - i + 1] = '\0';
|
||||
|
||||
/* Skip whitespace again. */
|
||||
for (--i; i >= 0 && (name[i] == ' ' || name[i] == '\t'); --i)
|
||||
;
|
||||
if (i < 0)
|
||||
{
|
||||
*base_list = start_list;
|
||||
return result;
|
||||
}
|
||||
|
||||
prefix_text = xmalloc (i + 2);
|
||||
memcpy (prefix_text, name, i + 1);
|
||||
prefix_text[i + 1] = '\0';
|
||||
|
||||
prefix_text2 = prefix_text;
|
||||
elt = lookup_cmd_1 (&prefix_text2, *start_list, NULL, 1);
|
||||
if (!elt || elt == (struct cmd_list_element *) -1)
|
||||
{
|
||||
msg = xstrprintf (_("could not find command prefix '%s'"), prefix_text);
|
||||
xfree (prefix_text);
|
||||
xfree (result);
|
||||
scm_dynwind_begin (0);
|
||||
gdbscm_dynwind_xfree (msg);
|
||||
gdbscm_out_of_range_error (func_name, arg_pos,
|
||||
gdbscm_scm_from_c_string (name), msg);
|
||||
}
|
||||
|
||||
if (elt->prefixlist)
|
||||
{
|
||||
xfree (prefix_text);
|
||||
*base_list = elt->prefixlist;
|
||||
return result;
|
||||
}
|
||||
|
||||
msg = xstrprintf (_("'%s' is not a prefix command"), prefix_text);
|
||||
xfree (prefix_text);
|
||||
xfree (result);
|
||||
scm_dynwind_begin (0);
|
||||
gdbscm_dynwind_xfree (msg);
|
||||
gdbscm_out_of_range_error (func_name, arg_pos,
|
||||
gdbscm_scm_from_c_string (name), msg);
|
||||
/* NOTREACHED */
|
||||
}
|
||||
|
||||
static const scheme_integer_constant command_classes[] =
|
||||
{
|
||||
/* Note: alias and user are special; pseudo appears to be unused,
|
||||
and there is no reason to expose tui or xdb, I think. */
|
||||
{ "COMMAND_NONE", no_class },
|
||||
{ "COMMAND_RUNNING", class_run },
|
||||
{ "COMMAND_DATA", class_vars },
|
||||
{ "COMMAND_STACK", class_stack },
|
||||
{ "COMMAND_FILES", class_files },
|
||||
{ "COMMAND_SUPPORT", class_support },
|
||||
{ "COMMAND_STATUS", class_info },
|
||||
{ "COMMAND_BREAKPOINTS", class_breakpoint },
|
||||
{ "COMMAND_TRACEPOINTS", class_trace },
|
||||
{ "COMMAND_OBSCURE", class_obscure },
|
||||
{ "COMMAND_MAINTENANCE", class_maintenance },
|
||||
{ "COMMAND_USER", class_user },
|
||||
|
||||
END_INTEGER_CONSTANTS
|
||||
};
|
||||
|
||||
/* Return non-zero if command_class is a valid command class. */
|
||||
|
||||
int
|
||||
gdbscm_valid_command_class_p (int command_class)
|
||||
{
|
||||
int i;
|
||||
|
||||
for (i = 0; command_classes[i].name != NULL; ++i)
|
||||
{
|
||||
if (command_classes[i].value == command_class)
|
||||
return 1;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Return a normalized form of command NAME.
|
||||
That is tabs are replaced with spaces and multiple spaces are replaced
|
||||
with a single space.
|
||||
If WANT_TRAILING_SPACE is non-zero, add one space at the end. This is for
|
||||
prefix commands.
|
||||
but that is the caller's responsibility.
|
||||
Space for the result is allocated on the GC heap. */
|
||||
|
||||
static char *
|
||||
cmdscm_canonicalize_name (const char *name, int want_trailing_space)
|
||||
{
|
||||
int i, out, seen_word;
|
||||
char *result = scm_gc_malloc_pointerless (strlen (name) + 2, FUNC_NAME);
|
||||
|
||||
i = out = seen_word = 0;
|
||||
while (name[i])
|
||||
{
|
||||
/* Skip whitespace. */
|
||||
while (name[i] == ' ' || name[i] == '\t')
|
||||
++i;
|
||||
/* Copy non-whitespace characters. */
|
||||
if (name[i])
|
||||
{
|
||||
if (seen_word)
|
||||
result[out++] = ' ';
|
||||
while (name[i] && name[i] != ' ' && name[i] != '\t')
|
||||
result[out++] = name[i++];
|
||||
seen_word = 1;
|
||||
}
|
||||
}
|
||||
if (want_trailing_space)
|
||||
result[out++] = ' ';
|
||||
result[out] = '\0';
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/* (make-command name [#:invoke lambda]
|
||||
[#:command-class class] [#:completer-class completer]
|
||||
[#:prefix? <bool>] [#:doc <string>]) -> <gdb:command>
|
||||
|
||||
NAME is the name of the command. It may consist of multiple words,
|
||||
in which case the final word is the name of the new command, and
|
||||
earlier words must be prefix commands.
|
||||
|
||||
INVOKE is a procedure of three arguments that performs the command when
|
||||
invoked: (lambda (self arg from-tty) ...).
|
||||
Its result is unspecified.
|
||||
|
||||
CLASS is the kind of command. It must be one of the COMMAND_*
|
||||
constants defined in the gdb module. If not specified, "no_class" is used.
|
||||
|
||||
COMPLETER is the kind of completer. It must be either:
|
||||
#f - completion is not supported for this command.
|
||||
One of the COMPLETE_* constants defined in the gdb module.
|
||||
A procedure of three arguments: (lambda (self text word) ...).
|
||||
Its result is one of:
|
||||
A list of strings.
|
||||
A <gdb:iterator> object that returns the set of possible completions,
|
||||
ending with #f.
|
||||
TODO(dje): Once PR 16699 is fixed, add support for returning
|
||||
a COMPLETE_* constant.
|
||||
If not specified, then completion is not supported for this command.
|
||||
|
||||
If PREFIX is #t, then this command is a prefix command.
|
||||
|
||||
DOC is the doc string for the command.
|
||||
|
||||
The result is the <gdb:command> Scheme object.
|
||||
The command is not available to be used yet, however.
|
||||
It must still be added to gdb with register-command!. */
|
||||
|
||||
static SCM
|
||||
gdbscm_make_command (SCM name_scm, SCM rest)
|
||||
{
|
||||
const SCM keywords[] = {
|
||||
invoke_keyword, command_class_keyword, completer_class_keyword,
|
||||
prefix_p_keyword, doc_keyword, SCM_BOOL_F
|
||||
};
|
||||
int invoke_arg_pos = -1, command_class_arg_pos = 1;
|
||||
int completer_class_arg_pos = -1, is_prefix_arg_pos = -1;
|
||||
int doc_arg_pos = -1;
|
||||
char *s;
|
||||
char *name;
|
||||
int command_class = no_class;
|
||||
SCM completer_class = SCM_BOOL_F;
|
||||
int is_prefix = 0;
|
||||
char *doc = NULL;
|
||||
SCM invoke = SCM_BOOL_F;
|
||||
SCM c_scm;
|
||||
command_smob *c_smob;
|
||||
|
||||
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#OiOts",
|
||||
name_scm, &name, rest,
|
||||
&invoke_arg_pos, &invoke,
|
||||
&command_class_arg_pos, &command_class,
|
||||
&completer_class_arg_pos, &completer_class,
|
||||
&is_prefix_arg_pos, &is_prefix,
|
||||
&doc_arg_pos, &doc);
|
||||
|
||||
if (doc == NULL)
|
||||
doc = xstrdup (_("This command is not documented."));
|
||||
|
||||
s = name;
|
||||
name = cmdscm_canonicalize_name (s, is_prefix);
|
||||
xfree (s);
|
||||
s = doc;
|
||||
doc = gdbscm_gc_xstrdup (s);
|
||||
xfree (s);
|
||||
|
||||
if (is_prefix
|
||||
? name[0] == ' '
|
||||
: name[0] == '\0')
|
||||
{
|
||||
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, name_scm,
|
||||
_("no command name found"));
|
||||
}
|
||||
|
||||
if (gdbscm_is_true (invoke))
|
||||
{
|
||||
SCM_ASSERT_TYPE (gdbscm_is_procedure (invoke), invoke,
|
||||
invoke_arg_pos, FUNC_NAME, _("procedure"));
|
||||
}
|
||||
|
||||
if (!gdbscm_valid_command_class_p (command_class))
|
||||
{
|
||||
gdbscm_out_of_range_error (FUNC_NAME, command_class_arg_pos,
|
||||
scm_from_int (command_class),
|
||||
_("invalid command class argument"));
|
||||
}
|
||||
|
||||
SCM_ASSERT_TYPE (gdbscm_is_false (completer_class)
|
||||
|| scm_is_integer (completer_class)
|
||||
|| gdbscm_is_procedure (completer_class),
|
||||
completer_class, completer_class_arg_pos, FUNC_NAME,
|
||||
_("integer or procedure"));
|
||||
if (scm_is_integer (completer_class)
|
||||
&& !scm_is_signed_integer (completer_class, 0, N_COMPLETERS - 1))
|
||||
{
|
||||
gdbscm_out_of_range_error (FUNC_NAME, completer_class_arg_pos,
|
||||
completer_class,
|
||||
_("invalid completion type argument"));
|
||||
}
|
||||
|
||||
c_scm = cmdscm_make_command_smob ();
|
||||
c_smob = (command_smob *) SCM_SMOB_DATA (c_scm);
|
||||
c_smob->name = name;
|
||||
c_smob->is_prefix = is_prefix;
|
||||
c_smob->cmd_class = command_class;
|
||||
c_smob->doc = doc;
|
||||
c_smob->invoke = invoke;
|
||||
c_smob->complete = completer_class;
|
||||
|
||||
return c_scm;
|
||||
}
|
||||
|
||||
/* (register-command! <gdb:command>) -> unspecified
|
||||
|
||||
It is an error to register a command more than once. */
|
||||
|
||||
static SCM
|
||||
gdbscm_register_command_x (SCM self)
|
||||
{
|
||||
command_smob *c_smob
|
||||
= cmdscm_get_command_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||
char *cmd_name, *pfx_name;
|
||||
struct cmd_list_element **cmd_list;
|
||||
struct cmd_list_element *cmd = NULL;
|
||||
volatile struct gdb_exception except;
|
||||
|
||||
if (cmdscm_is_valid (c_smob))
|
||||
scm_misc_error (FUNC_NAME, _("command is already registered"), SCM_EOL);
|
||||
|
||||
cmd_name = gdbscm_parse_command_name (c_smob->name, FUNC_NAME, SCM_ARG1,
|
||||
&cmd_list, &cmdlist);
|
||||
c_smob->cmd_name = gdbscm_gc_xstrdup (cmd_name);
|
||||
xfree (cmd_name);
|
||||
|
||||
TRY_CATCH (except, RETURN_MASK_ALL)
|
||||
{
|
||||
if (c_smob->is_prefix)
|
||||
{
|
||||
/* If we have our own "invoke" method, then allow unknown
|
||||
sub-commands. */
|
||||
int allow_unknown = gdbscm_is_true (c_smob->invoke);
|
||||
|
||||
cmd = add_prefix_cmd (c_smob->cmd_name, c_smob->cmd_class,
|
||||
NULL, c_smob->doc, &c_smob->sub_list,
|
||||
c_smob->name, allow_unknown, cmd_list);
|
||||
}
|
||||
else
|
||||
{
|
||||
cmd = add_cmd (c_smob->cmd_name, c_smob->cmd_class,
|
||||
NULL, c_smob->doc, cmd_list);
|
||||
}
|
||||
}
|
||||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||||
|
||||
/* Note: At this point the command exists in gdb.
|
||||
So no more errors after this point. */
|
||||
|
||||
/* There appears to be no API to set this. */
|
||||
cmd->func = cmdscm_function;
|
||||
cmd->destroyer = cmdscm_destroyer;
|
||||
|
||||
c_smob->command = cmd;
|
||||
set_cmd_context (cmd, c_smob);
|
||||
|
||||
if (gdbscm_is_true (c_smob->complete))
|
||||
{
|
||||
set_cmd_completer (cmd,
|
||||
scm_is_integer (c_smob->complete)
|
||||
? cmdscm_completers[scm_to_int (c_smob->complete)].completer
|
||||
: cmdscm_completer);
|
||||
}
|
||||
|
||||
/* The owner of this command is not in GC-controlled memory, so we need
|
||||
to protect it from GC until the command is deleted. */
|
||||
scm_gc_protect_object (c_smob->containing_scm);
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
/* Initialize the Scheme command support. */
|
||||
|
||||
static const scheme_function command_functions[] =
|
||||
{
|
||||
{ "make-command", 1, 0, 1, gdbscm_make_command,
|
||||
"\
|
||||
Make a GDB command object.\n\
|
||||
\n\
|
||||
Arguments: name [#:invoke lambda]\n\
|
||||
[#:command-class <class>] [#:completer-class <completer>]\n\
|
||||
[#:prefix? <bool>] [#:doc string]\n\
|
||||
name: The name of the command. It may consist of multiple words,\n\
|
||||
in which case the final word is the name of the new command, and\n\
|
||||
earlier words must be prefix commands.\n\
|
||||
invoke: A procedure of three arguments to perform the command.\n\
|
||||
(lambda (self arg from-tty) ...)\n\
|
||||
Its result is unspecified.\n\
|
||||
class: The class of the command, one of COMMAND_*.\n\
|
||||
The default is COMMAND_NONE.\n\
|
||||
completer: The kind of completer, #f, one of COMPLETE_*, or a procedure\n\
|
||||
to perform the completion: (lambda (self text word) ...).\n\
|
||||
prefix?: If true then the command is a prefix command.\n\
|
||||
doc: The \"doc string\" of the command.\n\
|
||||
Returns: <gdb:command> object" },
|
||||
|
||||
{ "register-command!", 1, 0, 0, gdbscm_register_command_x,
|
||||
"\
|
||||
Register a <gdb:command> object with GDB." },
|
||||
|
||||
{ "command?", 1, 0, 0, gdbscm_command_p,
|
||||
"\
|
||||
Return #t if the object is a <gdb:command> object." },
|
||||
|
||||
{ "command-valid?", 1, 0, 0, gdbscm_command_valid_p,
|
||||
"\
|
||||
Return #t if the <gdb:command> object is valid." },
|
||||
|
||||
{ "dont-repeat", 1, 0, 0, gdbscm_dont_repeat,
|
||||
"\
|
||||
Prevent command repetition when user enters an empty line.\n\
|
||||
\n\
|
||||
Arguments: <gdb:command>\n\
|
||||
Returns: unspecified" },
|
||||
|
||||
END_FUNCTIONS
|
||||
};
|
||||
|
||||
/* Initialize the 'commands' code. */
|
||||
|
||||
void
|
||||
gdbscm_initialize_commands (void)
|
||||
{
|
||||
int i;
|
||||
|
||||
command_smob_tag
|
||||
= gdbscm_make_smob_type (command_smob_name, sizeof (command_smob));
|
||||
scm_set_smob_print (command_smob_tag, cmdscm_print_command_smob);
|
||||
|
||||
gdbscm_define_integer_constants (command_classes, 1);
|
||||
gdbscm_define_functions (command_functions, 1);
|
||||
|
||||
for (i = 0; i < N_COMPLETERS; ++i)
|
||||
{
|
||||
scm_c_define (cmdscm_completers[i].name, scm_from_int (i));
|
||||
scm_c_export (cmdscm_completers[i].name, NULL);
|
||||
}
|
||||
|
||||
invoke_keyword = scm_from_latin1_keyword ("invoke");
|
||||
command_class_keyword = scm_from_latin1_keyword ("command-class");
|
||||
completer_class_keyword = scm_from_latin1_keyword ("completer-class");
|
||||
prefix_p_keyword = scm_from_latin1_keyword ("prefix?");
|
||||
doc_keyword = scm_from_latin1_keyword ("doc");
|
||||
}
|
||||
|
|
@ -64,6 +64,9 @@ static SCM memory_error_symbol;
|
|||
/* User interrupt, e.g., RETURN_QUIT in struct gdb_exception. */
|
||||
static SCM signal_symbol;
|
||||
|
||||
/* A user error, e.g., bad arg to gdb command. */
|
||||
static SCM user_error_symbol;
|
||||
|
||||
/* Printing the stack is done by first capturing the stack and recording it in
|
||||
a <gdb:exception> object with this key and with the ARGS field set to
|
||||
(cons real-key (cons stack real-args)).
|
||||
|
|
@ -391,6 +394,15 @@ gdbscm_memory_error_p (SCM key)
|
|||
return scm_is_eq (key, memory_error_symbol);
|
||||
}
|
||||
|
||||
/* Return non-zero if KEY is gdb:user-error.
|
||||
Note: This is an excp_matcher_func function. */
|
||||
|
||||
int
|
||||
gdbscm_user_error_p (SCM key)
|
||||
{
|
||||
return scm_is_eq (key, user_error_symbol);
|
||||
}
|
||||
|
||||
/* Wrapper around scm_throw to throw a gdb:exception.
|
||||
This function does not return.
|
||||
This function cannot be called from inside TRY_CATCH. */
|
||||
|
|
@ -663,6 +675,8 @@ gdbscm_initialize_exceptions (void)
|
|||
|
||||
memory_error_symbol = scm_from_latin1_symbol ("gdb:memory-error");
|
||||
|
||||
user_error_symbol = scm_from_latin1_symbol ("gdb:user-error");
|
||||
|
||||
gdbscm_invalid_object_error_symbol
|
||||
= scm_from_latin1_symbol ("gdb:invalid-object-error");
|
||||
|
||||
|
|
|
|||
|
|
@ -583,3 +583,15 @@ gdbscm_is_procedure (SCM proc)
|
|||
{
|
||||
return gdbscm_is_true (scm_procedure_p (proc));
|
||||
}
|
||||
|
||||
/* Same as xstrdup, but the string is allocated on the GC heap. */
|
||||
|
||||
char *
|
||||
gdbscm_gc_xstrdup (const char *str)
|
||||
{
|
||||
size_t len = strlen (str);
|
||||
char *result = scm_gc_malloc_pointerless (len + 1, "gdbscm_gc_xstrdup");
|
||||
|
||||
strcpy (result, str);
|
||||
return result;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
2014-06-02 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
* gdb.guile/scm-cmd.c: New file.
|
||||
* gdb.guile/scm-cmd.exp: New file.
|
||||
|
||||
2014-06-02 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
* gdb.guile/scm-pretty-print.exp: Add tests for objfile and progspace
|
||||
|
|
|
|||
|
|
@ -0,0 +1,29 @@
|
|||
/* This testcase is part of GDB, the GNU debugger.
|
||||
|
||||
Copyright 2013 Free Software Foundation, Inc.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>. */
|
||||
|
||||
struct foo
|
||||
{
|
||||
int ij;
|
||||
int bc;
|
||||
};
|
||||
|
||||
int
|
||||
main (void)
|
||||
{
|
||||
struct foo bar;
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,198 @@
|
|||
# Copyright (C) 2009-2013 Free Software Foundation, Inc.
|
||||
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
# This file is part of the GDB testsuite. It tests the mechanism
|
||||
# for defining new GDB commands in Scheme.
|
||||
|
||||
load_lib gdb-guile.exp
|
||||
|
||||
standard_testfile
|
||||
|
||||
if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
|
||||
return
|
||||
}
|
||||
|
||||
# Skip all tests if Guile scripting is not enabled.
|
||||
if { [skip_guile_tests] } { continue }
|
||||
|
||||
if ![gdb_guile_runto_main] {
|
||||
fail "Can't run to main"
|
||||
return
|
||||
}
|
||||
|
||||
# Test a simple command, and command? while we're at it.
|
||||
|
||||
gdb_test_multiline "input simple command" \
|
||||
"guile" "" \
|
||||
"(define test-cmd" "" \
|
||||
" (make-command \"test-cmd\"" "" \
|
||||
" #:command-class COMMAND_OBSCURE" "" \
|
||||
" #:invoke (lambda (self arg from-tty)" "" \
|
||||
" (display (format #f \"test-cmd output, arg = ~a\\n\" arg)))))" "" \
|
||||
"(register-command! test-cmd)" "" \
|
||||
"end" ""
|
||||
|
||||
gdb_test "guile (print (command? test-cmd))" "= #t"
|
||||
gdb_test "guile (print (command? 42))" "= #f"
|
||||
|
||||
gdb_test "test-cmd ugh" "test-cmd output, arg = ugh" "call simple command"
|
||||
|
||||
# Test a prefix command, and a subcommand within it.
|
||||
|
||||
gdb_test_multiline "input prefix command" \
|
||||
"guile" "" \
|
||||
"(register-command! (make-command \"prefix-cmd\"" "" \
|
||||
" #:command-class COMMAND_OBSCURE" "" \
|
||||
" #:completer-class COMPLETE_NONE" "" \
|
||||
" #:prefix? #t" "" \
|
||||
" #:invoke (lambda (self arg from-tty)" "" \
|
||||
" (display (format #f \"prefix-cmd output, arg = ~a\\n\" arg)))))" "" \
|
||||
"end" ""
|
||||
|
||||
gdb_test "prefix-cmd ugh" "prefix-cmd output, arg = ugh" "call prefix command"
|
||||
|
||||
gdb_test_multiline "input subcommand" \
|
||||
"guile" "" \
|
||||
"(register-command! (make-command \"prefix-cmd subcmd\"" "" \
|
||||
" #:command-class COMMAND_OBSCURE" "" \
|
||||
" #:invoke (lambda (self arg from-tty)" "" \
|
||||
" (display (format #f \"subcmd output, arg = ~a\\n\" arg)))))" "" \
|
||||
"end" ""
|
||||
|
||||
gdb_test "prefix-cmd subcmd ugh" "subcmd output, arg = ugh" "call subcmd"
|
||||
|
||||
# Test a subcommand in an existing GDB prefix.
|
||||
|
||||
gdb_test_multiline "input new subcommand" \
|
||||
"guile" "" \
|
||||
"(register-command! (make-command \"info newsubcmd\"" "" \
|
||||
" #:command-class COMMAND_OBSCURE" "" \
|
||||
" #:invoke (lambda (self arg from-tty)" "" \
|
||||
" (display (format #f \"newsubcmd output, arg = ~a\\n\" arg)))))" "" \
|
||||
"end" ""
|
||||
|
||||
gdb_test "info newsubcmd ugh" "newsubcmd output, arg = ugh" "call newsubcmd"
|
||||
|
||||
# Test a command that throws gdb:user-error.
|
||||
|
||||
gdb_test_multiline "input command to throw error" \
|
||||
"guile" "" \
|
||||
"(register-command! (make-command \"test-error-cmd\"" "" \
|
||||
" #:command-class COMMAND_OBSCURE" "" \
|
||||
" #:invoke (lambda (self arg from-tty)" "" \
|
||||
" (throw-user-error \"you lose! ~a\" arg))))" "" \
|
||||
"end" ""
|
||||
|
||||
gdb_test "test-error-cmd ugh" "ERROR: you lose! ugh" "call error command"
|
||||
|
||||
# Test string->argv.
|
||||
|
||||
gdb_test "guile (raw-print (string->argv \"1 2 3\"))" \
|
||||
{= \("1" "2" "3"\)} \
|
||||
"(string->argv \"1 2 3\")"
|
||||
|
||||
gdb_test "guile (raw-print (string->argv \"'1 2' 3\"))" \
|
||||
{= \("1 2" "3"\)} \
|
||||
"(string->argv \"'1 2' 3\")"
|
||||
|
||||
gdb_test "guile (raw-print (string->argv \"\\\"1 2\\\" 3\"))" \
|
||||
{= \("1 2" "3"\)} \
|
||||
"(string->argv (\"\\\"1 2\\\" 3\")"
|
||||
|
||||
gdb_test "guile (raw-print (string->argv \"1\\\\ 2 3\"))" \
|
||||
{= \("1 2" "3"\)} \
|
||||
"(string->argv \"1\\\\ 2 3\")"
|
||||
|
||||
# Test user-defined guile commands.
|
||||
|
||||
gdb_test_multiline "input simple user-defined command" \
|
||||
"guile" "" \
|
||||
"(register-command! (make-command \"test-help\"" "" \
|
||||
" #:doc \"Docstring\"" "" \
|
||||
" #:command-class COMMAND_USER" "" \
|
||||
" #:invoke (lambda (self arg from-tty)" "" \
|
||||
" (display (format #f \"test-cmd output, arg = ~a\\n\" arg)))))" "" \
|
||||
"end" ""
|
||||
|
||||
gdb_test "test-help ugh" "test-cmd output, arg = ugh" \
|
||||
"call simple user-defined command"
|
||||
|
||||
# Make sure the command shows up in `help user-defined`.
|
||||
gdb_test "help user-defined" \
|
||||
"User-defined commands.\[\r\n\]+The commands in this class are those defined by the user.\[\r\n\]+Use the \"define\" command to define a command.\[\r\n\]+List of commands:\[\r\n\]+test-help -- Docstring\[\r\n\]+Type \"help\" followed by command name for full documentation.\[\r\n\]+Type \"apropos word\" to search for commands related to \"word\".\[\r\n\]+Command name abbreviations are allowed if unambiguous.\[\r\n\]+" \
|
||||
"see user-defined command in `help user-defined`"
|
||||
|
||||
# Test expression completion on fields.
|
||||
|
||||
gdb_test_multiline "expression completion command" \
|
||||
"guile" "" \
|
||||
"(register-command! (make-command \"expr-test\"" "" \
|
||||
" #:command-class COMMAND_USER" ""\
|
||||
" #:completer-class COMPLETE_EXPRESSION" "" \
|
||||
" #:invoke (lambda (self arg from-tty)" "" \
|
||||
" (display (format #f \"invoked on = ~a\\n\" arg)))))" "" \
|
||||
"end" ""
|
||||
|
||||
gdb_test "complete expr-test bar\." \
|
||||
"expr-test bar\.bc.*expr-test bar\.ij.*" \
|
||||
"test completion through complete command"
|
||||
|
||||
set test "complete 'expr-test bar.i'"
|
||||
send_gdb "expr-test bar\.i\t\t"
|
||||
gdb_test_multiple "" "$test" {
|
||||
-re "expr-test bar\.ij \\\x07$" {
|
||||
send_gdb "\n"
|
||||
gdb_test_multiple "" $test {
|
||||
-re "invoked on = bar.ij.*$gdb_prompt $" {
|
||||
pass "$test"
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Test using a function for completion.
|
||||
|
||||
gdb_test_multiline "completer-as-function command" \
|
||||
"guile" "" \
|
||||
"(register-command! (make-command \"completer-as-function\"" "" \
|
||||
" #:command-class COMMAND_USER" ""\
|
||||
" #:completer-class (lambda (self text word)" "" \
|
||||
" (list \"1\" \"2\" \"3\"))" "" \
|
||||
" #:invoke (lambda (self arg from-tty)" "" \
|
||||
" (display (format #f \"invoked on = ~a\\n\" arg)))))" "" \
|
||||
"end" ""
|
||||
|
||||
gdb_test "complete completer-as-function 42\." \
|
||||
"completer-as-function 42\.1.*completer-as-function 42\.2.*completer-as-function 42\.3" \
|
||||
"test completion with completion function"
|
||||
|
||||
# Test Scheme error in invoke function.
|
||||
|
||||
gdb_test_multiline "input command with Scheme error" \
|
||||
"guile" "" \
|
||||
"(register-command! (make-command \"test-scheme-error-cmd\"" "" \
|
||||
" #:command-class COMMAND_OBSCURE" "" \
|
||||
" #:invoke (lambda (self arg from-tty)" "" \
|
||||
" oops-bad-spelling)))" "" \
|
||||
"end" ""
|
||||
|
||||
gdb_test "test-scheme-error-cmd ugh" \
|
||||
"Error occurred in Scheme-implemented GDB command." \
|
||||
"call scheme-error command"
|
||||
|
||||
# If there is a problem with object management, this can often trigger it.
|
||||
# It is useful to do this last, after we've created a bunch of command objects.
|
||||
|
||||
gdb_test_no_output "guile (gc)"
|
||||
Loading…
Reference in New Issue