Add parameter support for Guile.
* Makefile.in (SUBDIR_GUILE_OBS): Add scm-param.o. (SUBDIR_GUILE_SRCS): Add scm-param.c. (scm-param.o): New rule. * guile/guile-internal.h (gdbscm_gc_dup_argv): Declare. (gdbscm_misc_error): Declare. (gdbscm_canonicalize_command_name): Declare. (gdbscm_scm_to_host_string): Declare. (gdbscm_scm_from_host_string): Declare. (gdbscm_initialize_parameters): Declare. * guile/guile.c (initialize_gdb_module): Call gdbscm_initialize_parameters. * guile/lib/gdb.scm: Export parameter symbols. * guile/scm-cmd.c (gdbscm_canonicalize_command_name): Renamed from cmdscm_canonicalize_name and made public. All callers updated. * guile/scm-exception.c (gdbscm_misc_error): New function. * guile/scm-param.c: New file. * guile/scm-string.c (gdbscm_scm_to_string): Add comments. (gdbscm_scm_to_host_string): New function. (gdbscm_scm_from_host_string): New function. * scm-utils.c (gdbscm_gc_dup_argv): New function. testsuite/ * gdb.guile/scm-parameter.exp: New file. doc/ * guile.texi (Guile API): Add entry for Parameters In Guile. (GDB Scheme Data Types): Mention <gdb:parameter> object. (Parameters In Guile): New node.
This commit is contained in:
Doug Evans
parent
aef392c4ae
commit
06eb158633
14 changed files with 1663 additions and 4 deletions
|
|
@ -1,3 +1,27 @@
|
|||
2014-06-02 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
Add parameter support for Guile.
|
||||
* Makefile.in (SUBDIR_GUILE_OBS): Add scm-param.o.
|
||||
(SUBDIR_GUILE_SRCS): Add scm-param.c.
|
||||
(scm-param.o): New rule.
|
||||
* guile/guile-internal.h (gdbscm_gc_dup_argv): Declare.
|
||||
(gdbscm_misc_error): Declare.
|
||||
(gdbscm_canonicalize_command_name): Declare.
|
||||
(gdbscm_scm_to_host_string): Declare.
|
||||
(gdbscm_scm_from_host_string): Declare.
|
||||
(gdbscm_initialize_parameters): Declare.
|
||||
* guile/guile.c (initialize_gdb_module): Call
|
||||
gdbscm_initialize_parameters.
|
||||
* guile/lib/gdb.scm: Export parameter symbols.
|
||||
* guile/scm-cmd.c (gdbscm_canonicalize_command_name): Renamed from
|
||||
cmdscm_canonicalize_name and made public. All callers updated.
|
||||
* guile/scm-exception.c (gdbscm_misc_error): New function.
|
||||
* guile/scm-param.c: New file.
|
||||
* guile/scm-string.c (gdbscm_scm_to_string): Add comments.
|
||||
(gdbscm_scm_to_host_string): New function.
|
||||
(gdbscm_scm_from_host_string): New function.
|
||||
* scm-utils.c (gdbscm_gc_dup_argv): New function.
|
||||
|
||||
2014-06-02 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
Add command support for Guile.
|
||||
|
|
|
|||
|
|
@ -297,6 +297,7 @@ SUBDIR_GUILE_OBS = \
|
|||
scm-lazy-string.o \
|
||||
scm-objfile.o \
|
||||
scm-math.o \
|
||||
scm-param.o \
|
||||
scm-ports.o \
|
||||
scm-pretty-print.o \
|
||||
scm-progspace.o \
|
||||
|
|
@ -322,6 +323,7 @@ SUBDIR_GUILE_SRCS = \
|
|||
guile/scm-lazy-string.c \
|
||||
guile/scm-objfile.c \
|
||||
guile/scm-math.c \
|
||||
guile/scm-param.c \
|
||||
guile/scm-ports.c \
|
||||
guile/scm-pretty-print.c \
|
||||
guile/scm-progspace.c \
|
||||
|
|
@ -2310,6 +2312,10 @@ scm-objfile.o: $(srcdir)/guile/scm-objfile.c
|
|||
$(COMPILE) $(srcdir)/guile/scm-objfile.c
|
||||
$(POSTCOMPILE)
|
||||
|
||||
scm-param.o: $(srcdir)/guile/scm-param.c
|
||||
$(COMPILE) $(srcdir)/guile/scm-param.c
|
||||
$(POSTCOMPILE)
|
||||
|
||||
scm-ports.o: $(srcdir)/guile/scm-ports.c
|
||||
$(COMPILE) $(srcdir)/guile/scm-ports.c
|
||||
$(POSTCOMPILE)
|
||||
|
|
|
|||
|
|
@ -1,3 +1,9 @@
|
|||
2014-06-02 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
* guile.texi (Guile API): Add entry for Parameters In Guile.
|
||||
(GDB Scheme Data Types): Mention <gdb:parameter> object.
|
||||
(Parameters In Guile): New node.
|
||||
|
||||
2014-06-02 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
* guile.texi (Guile API): Add entry for Commands In Guile.
|
||||
|
|
|
|||
|
|
@ -142,6 +142,7 @@ from the Guile interactive prompt.
|
|||
* 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
|
||||
* Parameters In Guile:: Adding new @value{GDBN} parameters
|
||||
* Progspaces In Guile:: Program spaces
|
||||
* Objfiles In Guile:: Object files in Guile
|
||||
* Frames In Guile:: Accessing inferior stack frames from Guile
|
||||
|
|
@ -375,6 +376,9 @@ as a symbol.
|
|||
@item <gdb:objfile>
|
||||
@xref{Objfiles In Guile}.
|
||||
|
||||
@item <gdb:parameter>
|
||||
@xref{Parameters In Guile}.
|
||||
|
||||
@item <gdb:pretty-printer>
|
||||
@xref{Guile Pretty Printing API}.
|
||||
|
||||
|
|
@ -1946,6 +1950,177 @@ end
|
|||
Hello, World!
|
||||
@end smallexample
|
||||
|
||||
@node Parameters In Guile
|
||||
@subsubsection Parameters In Guile
|
||||
|
||||
@cindex parameters in guile
|
||||
@cindex guile parameters
|
||||
@tindex Parameter
|
||||
You can implement new @value{GDBN} @dfn{parameters} using Guile
|
||||
@footnote{Note that @value{GDBN} parameters must not be confused with
|
||||
Guile’s parameter objects (@pxref{Parameters,,, guile, GNU Guile
|
||||
Reference Manual}).}.
|
||||
|
||||
There are many parameters that already exist and can be set in
|
||||
@value{GDBN}. Two examples are: @code{set follow-fork} and
|
||||
@code{set charset}. Setting these parameters influences certain
|
||||
behavior in @value{GDBN}. Similarly, you can define parameters that
|
||||
can be used to influence behavior in custom Guile scripts and commands.
|
||||
|
||||
A new parameter is defined with the @code{make-parameter} Guile function,
|
||||
and added to @value{GDBN} with the @code{register-parameter!} Guile function.
|
||||
This two-step approach is taken to separate out the side-effect of adding
|
||||
the parameter to @value{GDBN} from @code{make-parameter}.
|
||||
|
||||
Parameters are exposed to the user via the @code{set} and
|
||||
@code{show} commands. @xref{Help}.
|
||||
|
||||
@c TODO line length
|
||||
@deffn {Scheme Procedure} (make-parameter name @r{[}#:command-class command-class@r{]} @r{[}#:parameter-type parameter-type{]} @r{[}#:enum-list enum-list@r{]} @r{[}#:set-func set-func{]} @r{[}#:show-func show-func{]} @r{[}#:doc doc{]} @r{[}#:set-doc set-doc{]} @r{[}#:show-doc show-doc{]} @r{[}#:initial-value initial-value{]})
|
||||
|
||||
The argument @var{name} is the name of the new parameter. If @var{name}
|
||||
consists of multiple words, then the initial words are looked for as prefix
|
||||
parameters. An example of this can be illustrated with the
|
||||
@code{set print} set of parameters. If @var{name} is
|
||||
@code{print foo}, then @code{print} will be searched as the prefix
|
||||
parameter. In this case the parameter can subsequently be accessed in
|
||||
@value{GDBN} as @code{set print foo}.
|
||||
If @var{name} consists of multiple words, and no prefix parameter group
|
||||
can be found, an exception is raised.
|
||||
|
||||
The result is the @code{<gdb:parameter>} object representing the parameter.
|
||||
The parameter is not usable until it has been registered with @value{GDBN}
|
||||
with @code{register-parameter!}.
|
||||
|
||||
The rest of the arguments are optional.
|
||||
|
||||
The argument @var{command-class} should be one of the @samp{COMMAND_} constants
|
||||
(@pxref{Commands In Guile}). This argument tells @value{GDBN} how to
|
||||
categorize the new parameter in the help system.
|
||||
The default is @code{COMMAND_NONE}.
|
||||
|
||||
The argument @var{parameter-type} should be one of the @samp{PARAM_} constants
|
||||
defined below. This argument tells @value{GDBN} the type of the new
|
||||
parameter; this information is used for input validation and
|
||||
completion. The default is @code{PARAM_BOOLEAN}.
|
||||
|
||||
If @var{parameter-type} is @code{PARAM_ENUM}, then
|
||||
@var{enum-list} must be a list of strings. These strings
|
||||
represent the possible values for the parameter.
|
||||
|
||||
If @var{parameter-type} is not @code{PARAM_ENUM}, then the presence
|
||||
of @var{enum-list} will cause an exception to be thrown.
|
||||
|
||||
The argument @var{set-func} is a function of one argument: @var{self} which
|
||||
is the @code{<gdb:parameter>} object representing the parameter.
|
||||
@value{GDBN} will call this function when a @var{parameter}'s value has
|
||||
been changed via the @code{set} API (for example, @kbd{set foo off}).
|
||||
The value of the parameter has already been set to the new value.
|
||||
This function must return a string to be displayed to the user.
|
||||
@value{GDBN} will add a trailing newline if the string is non-empty.
|
||||
@value{GDBN} generally doesn't print anything when a parameter is set,
|
||||
thus typically this function should return @samp{""}.
|
||||
A non-empty string result should typically be used for displaying warnings
|
||||
and errors.
|
||||
|
||||
The argument @var{show-func} is a function of two arguments: @var{self} which
|
||||
is the @code{<gdb:parameter>} object representing the parameter, and
|
||||
@var{svalue} which is the string representation of the current value.
|
||||
@value{GDBN} will call this function when a @var{parameter}'s
|
||||
@code{show} API has been invoked (for example, @kbd{show foo}).
|
||||
This function must return a string, and will be displayed to the user.
|
||||
@value{GDBN} will add a trailing newline.
|
||||
|
||||
The argument @var{doc} is the help text for the new parameter.
|
||||
If there is no documentation string, a default value is used.
|
||||
|
||||
The argument @var{set-doc} is the help text for this parameter's
|
||||
@code{set} command.
|
||||
|
||||
The argument @var{show-doc} is the help text for this parameter's
|
||||
@code{show} command.
|
||||
|
||||
The argument @var{initial-value} specifies the initial value of the parameter.
|
||||
If it is a function, it takes one parameter, the @code{<gdb:parameter>}
|
||||
object and its result is used as the initial value of the parameter.
|
||||
The initial value must be valid for the parameter type,
|
||||
otherwise an exception is thrown.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} register-parameter! parameter
|
||||
Add @var{parameter}, a @code{<gdb:parameter>} object, to @value{GDBN}'s
|
||||
list of parameters.
|
||||
It is an error to register a parameter more than once.
|
||||
The result is unspecified.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} parameter? object
|
||||
Return @code{#t} if @var{object} is a @code{<gdb:parameter>} object.
|
||||
Otherwise return @code{#f}.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} parameter-value parameter
|
||||
Return the value of @var{parameter} which may either be
|
||||
a @code{<gdb:parameter>} object or a string naming the parameter.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} set-parameter-value! parameter new-value
|
||||
Assign @var{parameter} the value of @var{new-value}.
|
||||
The argument @var{parameter} must be an object of type @code{<gdb:parameter>}.
|
||||
@value{GDBN} does validation when assignments are made.
|
||||
@end deffn
|
||||
|
||||
When a new parameter is defined, its type must be specified. The
|
||||
available types are represented by constants defined in the @code{gdb}
|
||||
module:
|
||||
|
||||
@vtable @code
|
||||
@item PARAM_BOOLEAN
|
||||
The value is a plain boolean. The Guile boolean values, @code{#t}
|
||||
and @code{#f} are the only valid values.
|
||||
|
||||
@item PARAM_AUTO_BOOLEAN
|
||||
The value has three possible states: true, false, and @samp{auto}. In
|
||||
Guile, true and false are represented using boolean constants, and
|
||||
@samp{auto} is represented using @code{#:auto}.
|
||||
|
||||
@item PARAM_UINTEGER
|
||||
The value is an unsigned integer. The value of 0 should be
|
||||
interpreted to mean ``unlimited''.
|
||||
|
||||
@item PARAM_ZINTEGER
|
||||
The value is an integer.
|
||||
|
||||
@item PARAM_ZUINTEGER
|
||||
The value is an unsigned integer.
|
||||
|
||||
@item PARAM_ZUINTEGER_UNLIMITED
|
||||
The value is an integer in the range @samp{[0, INT_MAX]}.
|
||||
A value of @samp{-1} means ``unlimited'', and other negative
|
||||
numbers are not allowed.
|
||||
|
||||
@item PARAM_STRING
|
||||
The value is a string. When the user modifies the string, any escape
|
||||
sequences, such as @samp{\t}, @samp{\f}, and octal escapes, are
|
||||
translated into corresponding characters and encoded into the current
|
||||
host charset.
|
||||
|
||||
@item PARAM_STRING_NOESCAPE
|
||||
The value is a string. When the user modifies the string, escapes are
|
||||
passed through untranslated.
|
||||
|
||||
@item PARAM_OPTIONAL_FILENAME
|
||||
The value is a either a filename (a string), or @code{#f}.
|
||||
|
||||
@item PARAM_FILENAME
|
||||
The value is a filename. This is just like
|
||||
@code{PARAM_STRING_NOESCAPE}, but uses file names for completion.
|
||||
|
||||
@item PARAM_ENUM
|
||||
The value is a string, which must be one of a collection of string
|
||||
constants provided when the parameter is created.
|
||||
@end vtable
|
||||
|
||||
@node Progspaces In Guile
|
||||
@subsubsection Program Spaces In Guile
|
||||
|
||||
|
|
|
|||
|
|
@ -166,6 +166,8 @@ extern void gdbscm_dynwind_xfree (void *ptr);
|
|||
extern int gdbscm_is_procedure (SCM proc);
|
||||
|
||||
extern char *gdbscm_gc_xstrdup (const char *);
|
||||
|
||||
extern const char * const *gdbscm_gc_dup_argv (char **argv);
|
||||
|
||||
/* GDB smobs, from scm-gsmob.c */
|
||||
|
||||
|
|
@ -301,6 +303,10 @@ extern void gdbscm_out_of_range_error (const char *subr, int arg_pos,
|
|||
extern SCM gdbscm_make_misc_error (const char *subr, int arg_pos,
|
||||
SCM bad_value, const char *error);
|
||||
|
||||
extern void gdbscm_misc_error (const char *subr, int arg_pos,
|
||||
SCM bad_value, const char *error)
|
||||
ATTRIBUTE_NORETURN;
|
||||
|
||||
extern void gdbscm_throw (SCM exception) ATTRIBUTE_NORETURN;
|
||||
|
||||
extern SCM gdbscm_scm_from_gdb_exception (struct gdb_exception exception);
|
||||
|
|
@ -388,6 +394,9 @@ extern char *gdbscm_parse_command_name (const char *name,
|
|||
|
||||
extern int gdbscm_valid_command_class_p (int command_class);
|
||||
|
||||
extern char *gdbscm_canonicalize_command_name (const char *name,
|
||||
int want_trailing_space);
|
||||
|
||||
/* scm-frame.c */
|
||||
|
||||
typedef struct _frame_smob frame_smob;
|
||||
|
|
@ -476,6 +485,10 @@ extern char *gdbscm_scm_to_string (SCM string, size_t *lenp,
|
|||
extern SCM gdbscm_scm_from_string (const char *string, size_t len,
|
||||
const char *charset, int strict);
|
||||
|
||||
extern char *gdbscm_scm_to_host_string (SCM string, size_t *lenp, SCM *except);
|
||||
|
||||
extern SCM gdbscm_scm_from_host_string (const char *string, size_t len);
|
||||
|
||||
/* scm-symbol.c */
|
||||
|
||||
extern int syscm_is_symbol (SCM scm);
|
||||
|
|
@ -565,6 +578,7 @@ extern void gdbscm_initialize_lazy_strings (void);
|
|||
extern void gdbscm_initialize_math (void);
|
||||
extern void gdbscm_initialize_objfiles (void);
|
||||
extern void gdbscm_initialize_pretty_printers (void);
|
||||
extern void gdbscm_initialize_parameters (void);
|
||||
extern void gdbscm_initialize_ports (void);
|
||||
extern void gdbscm_initialize_pspaces (void);
|
||||
extern void gdbscm_initialize_smobs (void);
|
||||
|
|
|
|||
|
|
@ -544,6 +544,7 @@ initialize_gdb_module (void *data)
|
|||
gdbscm_initialize_lazy_strings ();
|
||||
gdbscm_initialize_math ();
|
||||
gdbscm_initialize_objfiles ();
|
||||
gdbscm_initialize_parameters ();
|
||||
gdbscm_initialize_ports ();
|
||||
gdbscm_initialize_pretty_printers ();
|
||||
gdbscm_initialize_pspaces ();
|
||||
|
|
|
|||
|
|
@ -275,6 +275,26 @@
|
|||
current-objfile
|
||||
objfiles
|
||||
|
||||
;; scm-param.c
|
||||
|
||||
PARAM_BOOLEAN
|
||||
PARAM_AUTO_BOOLEAN
|
||||
PARAM_ZINTEGER
|
||||
PARAM_UINTEGER
|
||||
PARAM_ZUINTEGER
|
||||
PARAM_ZUINTEGER_UNLIMITED
|
||||
PARAM_STRING
|
||||
PARAM_STRING_NOESCAPE
|
||||
PARAM_OPTIONAL_FILENAME
|
||||
PARAM_FILENAME
|
||||
PARAM_ENUM
|
||||
|
||||
make-parameter
|
||||
register-parameter!
|
||||
parameter?
|
||||
parameter-value
|
||||
set-parameter-value!
|
||||
|
||||
;; scm-ports.c
|
||||
|
||||
input-port
|
||||
|
|
|
|||
|
|
@ -603,8 +603,8 @@ gdbscm_valid_command_class_p (int command_class)
|
|||
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)
|
||||
char *
|
||||
gdbscm_canonicalize_command_name (const char *name, int want_trailing_space)
|
||||
{
|
||||
int i, out, seen_word;
|
||||
char *result = scm_gc_malloc_pointerless (strlen (name) + 2, FUNC_NAME);
|
||||
|
|
@ -699,7 +699,7 @@ gdbscm_make_command (SCM name_scm, SCM rest)
|
|||
doc = xstrdup (_("This command is not documented."));
|
||||
|
||||
s = name;
|
||||
name = cmdscm_canonicalize_name (s, is_prefix);
|
||||
name = gdbscm_canonicalize_command_name (s, is_prefix);
|
||||
xfree (s);
|
||||
s = doc;
|
||||
doc = gdbscm_gc_xstrdup (s);
|
||||
|
|
|
|||
|
|
@ -360,12 +360,23 @@ gdbscm_out_of_range_error (const char *subr, int arg_pos, SCM bad_value,
|
|||
|
||||
SCM
|
||||
gdbscm_make_misc_error (const char *subr, int arg_pos, SCM bad_value,
|
||||
const char *error)
|
||||
const char *error)
|
||||
{
|
||||
return gdbscm_make_arg_error (scm_misc_error_key,
|
||||
subr, arg_pos, bad_value, NULL, error);
|
||||
}
|
||||
|
||||
/* Throw a misc-error error. */
|
||||
|
||||
void
|
||||
gdbscm_misc_error (const char *subr, int arg_pos, SCM bad_value,
|
||||
const char *error)
|
||||
{
|
||||
SCM exception = gdbscm_make_misc_error (subr, arg_pos, bad_value, error);
|
||||
|
||||
gdbscm_throw (exception);
|
||||
}
|
||||
|
||||
/* Return a <gdb:exception> object for gdb:memory-error. */
|
||||
|
||||
SCM
|
||||
|
|
|
|||
1163
gdb/guile/scm-param.c
Normal file
1163
gdb/guile/scm-param.c
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -90,10 +90,17 @@ gdbscm_call_scm_to_stringn (void *datap)
|
|||
|
||||
/* Convert an SCM string to a string in charset CHARSET.
|
||||
This function is guaranteed to not throw an exception.
|
||||
|
||||
If LENP is NULL then the returned string is NUL-terminated,
|
||||
and an exception is thrown if the string contains embedded NULs.
|
||||
Otherwise the string is not guaranteed to be NUL-terminated, but worse
|
||||
there's no space to put a NUL if we wanted to (scm_to_stringn limitation).
|
||||
|
||||
If STRICT is non-zero, and there's a conversion error, then a
|
||||
<gdb:exception> object is stored in *EXCEPT_SCMP, and NULL is returned.
|
||||
If STRICT is zero, then escape sequences are used for characters that
|
||||
can't be converted, and EXCEPT_SCMP may be passed as NULL.
|
||||
|
||||
Space for the result is allocated with malloc, caller must free.
|
||||
It is an error to call this if STRING is not a string. */
|
||||
|
||||
|
|
@ -151,6 +158,7 @@ gdbscm_call_scm_from_stringn (void *datap)
|
|||
|
||||
/* Convert STRING to a Scheme string in charset CHARSET.
|
||||
This function is guaranteed to not throw an exception.
|
||||
|
||||
If STRICT is non-zero, and there's a conversion error, then a
|
||||
<gdb:exception> object is returned.
|
||||
If STRICT is zero, then question marks are used for characters that
|
||||
|
|
@ -183,6 +191,36 @@ gdbscm_scm_from_string (const char *string, size_t len,
|
|||
return scm_result;
|
||||
}
|
||||
|
||||
/* Convert an SCM string to a host string.
|
||||
This function is guaranteed to not throw an exception.
|
||||
|
||||
If LENP is NULL then the returned string is NUL-terminated,
|
||||
and if the string contains embedded NULs then NULL is returned with
|
||||
an exception object stored in *EXCEPT_SCMP.
|
||||
Otherwise the string is not guaranteed to be NUL-terminated, but worse
|
||||
there's no space to put a NUL if we wanted to (scm_to_stringn limitation).
|
||||
|
||||
Returns NULL if there is a conversion error, with the exception object
|
||||
stored in *EXCEPT_SCMP.
|
||||
Space for the result is allocated with malloc, caller must free.
|
||||
It is an error to call this if STRING is not a string. */
|
||||
|
||||
char *
|
||||
gdbscm_scm_to_host_string (SCM string, size_t *lenp, SCM *except_scmp)
|
||||
{
|
||||
return gdbscm_scm_to_string (string, lenp, host_charset (), 1, except_scmp);
|
||||
}
|
||||
|
||||
/* Convert a host string to an SCM string.
|
||||
This function is guaranteed to not throw an exception.
|
||||
Returns a <gdb:exception> object if there's a conversion error. */
|
||||
|
||||
SCM
|
||||
gdbscm_scm_from_host_string (const char *string, size_t len)
|
||||
{
|
||||
return gdbscm_scm_from_string (string, len, host_charset (), 1);
|
||||
}
|
||||
|
||||
/* (string->argv string) -> list
|
||||
Return list of strings split up according to GDB's argv parsing rules.
|
||||
This is useful when writing GDB commands in Scheme. */
|
||||
|
|
|
|||
|
|
@ -595,3 +595,32 @@ gdbscm_gc_xstrdup (const char *str)
|
|||
strcpy (result, str);
|
||||
return result;
|
||||
}
|
||||
|
||||
/* Return a duplicate of ARGV living on the GC heap. */
|
||||
|
||||
const char * const *
|
||||
gdbscm_gc_dup_argv (char **argv)
|
||||
{
|
||||
int i, len;
|
||||
size_t string_space;
|
||||
char *p, **result;
|
||||
|
||||
for (len = 0, string_space = 0; argv[len] != NULL; ++len)
|
||||
string_space += strlen (argv[len]) + 1;
|
||||
|
||||
/* Allocating "pointerless" works because the pointers are all
|
||||
self-contained within the object. */
|
||||
result = scm_gc_malloc_pointerless (((len + 1) * sizeof (char *))
|
||||
+ string_space, "parameter enum list");
|
||||
p = (char *) &result[len + 1];
|
||||
|
||||
for (i = 0; i < len; ++i)
|
||||
{
|
||||
result[i] = p;
|
||||
strcpy (p, argv[i]);
|
||||
p += strlen (p) + 1;
|
||||
}
|
||||
result[i] = NULL;
|
||||
|
||||
return (const char * const *) result;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
2014-06-02 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
* gdb.guile/scm-parameter.exp: New file.
|
||||
|
||||
2014-06-02 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
* gdb.guile/scm-cmd.c: New file.
|
||||
|
|
|
|||
168
gdb/testsuite/gdb.guile/scm-parameter.exp
Normal file
168
gdb/testsuite/gdb.guile/scm-parameter.exp
Normal file
|
|
@ -0,0 +1,168 @@
|
|||
# Copyright (C) 2010-2014 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 GDB parameter support in Guile.
|
||||
|
||||
load_lib gdb-guile.exp
|
||||
|
||||
# Start with a fresh gdb.
|
||||
gdb_exit
|
||||
gdb_start
|
||||
gdb_reinitialize_dir $srcdir/$subdir
|
||||
|
||||
# Skip all tests if Guile scripting is not enabled.
|
||||
if { [skip_guile_tests] } { continue }
|
||||
|
||||
gdb_install_guile_utils
|
||||
gdb_install_guile_module
|
||||
|
||||
# We use "." here instead of ":" so that this works on win32 too.
|
||||
gdb_test "guile (print (parameter-value \"directories\"))" "$srcdir/$subdir.\\\$cdir.\\\$cwd"
|
||||
|
||||
# Test a simple boolean parameter, and parameter? while we're at it.
|
||||
|
||||
gdb_test_multiline "Simple gdb boolean parameter" \
|
||||
"guile" "" \
|
||||
"(define test-param" "" \
|
||||
" (make-parameter \"print test-param\"" "" \
|
||||
" #:command-class COMMAND_DATA" "" \
|
||||
" #:parameter-type PARAM_BOOLEAN" "" \
|
||||
" #:doc \"When enabled, test param does something useful. When disabled, does nothing.\"" "" \
|
||||
" #:set-doc \"Set the state of the boolean test-param.\"" "" \
|
||||
" #:show-doc \"Show the state of the boolean test-param.\"" "" \
|
||||
" #:show-func (lambda (self value)" ""\
|
||||
" (format #f \"The state of the Test Parameter is ~a.\" value))" "" \
|
||||
" #:initial-value #t))" "" \
|
||||
"(register-parameter! test-param)" "" \
|
||||
"end"
|
||||
|
||||
with_test_prefix "test-param" {
|
||||
gdb_test "guile (print (parameter-value test-param))" "= #t" "parameter value (true)"
|
||||
gdb_test "show print test-param" "The state of the Test Parameter is on." "Show parameter on"
|
||||
gdb_test_no_output "set print test-param off"
|
||||
gdb_test "show print test-param" "The state of the Test Parameter is off." "Show parameter off"
|
||||
gdb_test "guile (print (parameter-value test-param))" "= #f" "parameter value (false)"
|
||||
gdb_test "help show print test-param" "Show the state of the boolean test-param.*" "show help"
|
||||
gdb_test "help set print test-param" "Set the state of the boolean test-param.*" "set help"
|
||||
gdb_test "help set print" "set print test-param -- Set the state of the boolean test-param.*" "general help"
|
||||
|
||||
gdb_test "guile (print (parameter? test-param))" "= #t"
|
||||
gdb_test "guile (print (parameter? 42))" "= #f"
|
||||
}
|
||||
|
||||
# Test an enum parameter.
|
||||
|
||||
gdb_test_multiline "enum gdb parameter" \
|
||||
"guile" "" \
|
||||
"(define test-enum-param" "" \
|
||||
" (make-parameter \"print test-enum-param\"" "" \
|
||||
" #:command-class COMMAND_DATA" "" \
|
||||
" #:parameter-type PARAM_ENUM" "" \
|
||||
" #:enum-list '(\"one\" \"two\")" "" \
|
||||
" #:doc \"When set, test param does something useful. When disabled, does nothing.\"" "" \
|
||||
" #:show-doc \"Show the state of the enum.\"" "" \
|
||||
" #:set-doc \"Set the state of the enum.\"" "" \
|
||||
" #:show-func (lambda (self value)" "" \
|
||||
" (format #f \"The state of the enum is ~a.\" value))" "" \
|
||||
" #:initial-value \"one\"))" "" \
|
||||
"(register-parameter! test-enum-param)" "" \
|
||||
"end"
|
||||
|
||||
with_test_prefix "test-enum-param" {
|
||||
gdb_test "guile (print (parameter-value test-enum-param))" "one" "enum parameter value (one)"
|
||||
gdb_test "show print test-enum-param" "The state of the enum is one." "show initial value"
|
||||
gdb_test_no_output "set print test-enum-param two"
|
||||
gdb_test "show print test-enum-param" "The state of the enum is two." "show new value"
|
||||
gdb_test "guile (print (parameter-value test-enum-param))" "two" "enum parameter value (two)"
|
||||
gdb_test "set print test-enum-param three" "Undefined item: \"three\".*" "set invalid enum parameter"
|
||||
}
|
||||
|
||||
# Test a file parameter.
|
||||
|
||||
gdb_test_multiline "file gdb parameter" \
|
||||
"guile" "" \
|
||||
"(define test-file-param" "" \
|
||||
" (make-parameter \"test-file-param\"" "" \
|
||||
" #:command-class COMMAND_FILES" "" \
|
||||
" #:parameter-type PARAM_FILENAME" "" \
|
||||
" #:doc \"When set, test param does something useful. When disabled, does nothing.\"" "" \
|
||||
" #:show-doc \"Show the name of the file.\"" "" \
|
||||
" #:set-doc \"Set the name of the file.\"" "" \
|
||||
" #:show-func (lambda (self value)" "" \
|
||||
" (format #f \"The name of the file is ~a.\" value))" "" \
|
||||
" #:initial-value \"foo.txt\"))" "" \
|
||||
"(register-parameter! test-file-param)" "" \
|
||||
"end"
|
||||
|
||||
with_test_prefix "test-file-param" {
|
||||
gdb_test "guile (print (parameter-value test-file-param))" "foo.txt" "initial parameter value"
|
||||
gdb_test "show test-file-param" "The name of the file is foo.txt." "show initial value"
|
||||
gdb_test_no_output "set test-file-param bar.txt"
|
||||
gdb_test "show test-file-param" "The name of the file is bar.txt." "show new value"
|
||||
gdb_test "guile (print (parameter-value test-file-param))" "bar.txt" " new parameter value"
|
||||
gdb_test "set test-file-param" "Argument required.*"
|
||||
}
|
||||
|
||||
# Test a parameter that is not documented.
|
||||
|
||||
gdb_test_multiline "undocumented gdb parameter" \
|
||||
"guile" "" \
|
||||
"(register-parameter! (make-parameter \"print test-undoc-param\"" "" \
|
||||
" #:command-class COMMAND_DATA" "" \
|
||||
" #:parameter-type PARAM_BOOLEAN" "" \
|
||||
" #:show-func (lambda (self value)" "" \
|
||||
" (format #f \"The state of the Test Parameter is ~a.\" value))" "" \
|
||||
" #:initial-value #t))" "" \
|
||||
"end"
|
||||
|
||||
with_test_prefix "test-undocumented-param" {
|
||||
gdb_test "show print test-undoc-param" "The state of the Test Parameter is on." "show parameter on"
|
||||
gdb_test_no_output "set print test-undoc-param off"
|
||||
gdb_test "show print test-undoc-param" "The state of the Test Parameter is off." "show parameter off"
|
||||
gdb_test "help show print test-undoc-param" "This command is not documented." "show help"
|
||||
gdb_test "help set print test-undoc-param" "This command is not documented." "set help"
|
||||
gdb_test "help set print" "set print test-undoc-param -- This command is not documented.*" "general help"
|
||||
}
|
||||
|
||||
# Test a parameter with a restricted range, where we need to notify the user
|
||||
# and restore the previous value.
|
||||
|
||||
gdb_test_multiline "restricted gdb parameter" \
|
||||
"guile" "" \
|
||||
"(register-parameter! (make-parameter \"test-restricted-param\"" "" \
|
||||
" #:command-class COMMAND_DATA" "" \
|
||||
" #:parameter-type PARAM_ZINTEGER" "" \
|
||||
" #:set-func (lambda (self)" "" \
|
||||
" (let ((value (parameter-value self)))" "" \
|
||||
" (if (and (>= value 0) (<= value 10))" "" \
|
||||
" \"\"" "" \
|
||||
" (begin" "" \
|
||||
" (set-parameter-value! self (object-property self 'value))" "" \
|
||||
" \"Error: Range of parameter is 0-10.\"))))" "" \
|
||||
" #:show-func (lambda (self value)" "" \
|
||||
" (format #f \"The value of the restricted parameter is ~a.\" value))" "" \
|
||||
" #:initial-value (lambda (self)" "" \
|
||||
" (set-object-property! self 'value 2)" "" \
|
||||
" 2)))" "" \
|
||||
"end"
|
||||
|
||||
with_test_prefix "test-restricted-param" {
|
||||
gdb_test "show test-restricted-param" "The value of the restricted parameter is 2."
|
||||
gdb_test_no_output "set test-restricted-param 10"
|
||||
gdb_test "show test-restricted-param" "The value of the restricted parameter is 10."
|
||||
gdb_test "set test-restricted-param 42" "Error: Range of parameter is 0-10."
|
||||
gdb_test "show test-restricted-param" "The value of the restricted parameter is 2."
|
||||
}
|
||||
Loading…
Reference in a new issue