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 2014-06-03 01:58:15 -07:00
parent aef392c4ae
commit 06eb158633
14 changed files with 1663 additions and 4 deletions

View file

@ -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> 2014-06-02 Doug Evans <xdje42@gmail.com>
Add command support for Guile. Add command support for Guile.

View file

@ -297,6 +297,7 @@ SUBDIR_GUILE_OBS = \
scm-lazy-string.o \ scm-lazy-string.o \
scm-objfile.o \ scm-objfile.o \
scm-math.o \ scm-math.o \
scm-param.o \
scm-ports.o \ scm-ports.o \
scm-pretty-print.o \ scm-pretty-print.o \
scm-progspace.o \ scm-progspace.o \
@ -322,6 +323,7 @@ SUBDIR_GUILE_SRCS = \
guile/scm-lazy-string.c \ guile/scm-lazy-string.c \
guile/scm-objfile.c \ guile/scm-objfile.c \
guile/scm-math.c \ guile/scm-math.c \
guile/scm-param.c \
guile/scm-ports.c \ guile/scm-ports.c \
guile/scm-pretty-print.c \ guile/scm-pretty-print.c \
guile/scm-progspace.c \ guile/scm-progspace.c \
@ -2310,6 +2312,10 @@ scm-objfile.o: $(srcdir)/guile/scm-objfile.c
$(COMPILE) $(srcdir)/guile/scm-objfile.c $(COMPILE) $(srcdir)/guile/scm-objfile.c
$(POSTCOMPILE) $(POSTCOMPILE)
scm-param.o: $(srcdir)/guile/scm-param.c
$(COMPILE) $(srcdir)/guile/scm-param.c
$(POSTCOMPILE)
scm-ports.o: $(srcdir)/guile/scm-ports.c scm-ports.o: $(srcdir)/guile/scm-ports.c
$(COMPILE) $(srcdir)/guile/scm-ports.c $(COMPILE) $(srcdir)/guile/scm-ports.c
$(POSTCOMPILE) $(POSTCOMPILE)

View file

@ -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> 2014-06-02 Doug Evans <xdje42@gmail.com>
* guile.texi (Guile API): Add entry for Commands In Guile. * guile.texi (Guile API): Add entry for Commands In Guile.

View file

@ -142,6 +142,7 @@ from the Guile interactive prompt.
* Selecting Guile Pretty-Printers:: How GDB chooses a pretty-printer * Selecting Guile Pretty-Printers:: How GDB chooses a pretty-printer
* Writing a Guile Pretty-Printer:: Writing a pretty-printer * Writing a Guile Pretty-Printer:: Writing a pretty-printer
* Commands In Guile:: Implementing new commands in Guile * Commands In Guile:: Implementing new commands in Guile
* Parameters In Guile:: Adding new @value{GDBN} parameters
* Progspaces In Guile:: Program spaces * Progspaces In Guile:: Program spaces
* Objfiles In Guile:: Object files in Guile * Objfiles In Guile:: Object files in Guile
* Frames In Guile:: Accessing inferior stack frames from Guile * Frames In Guile:: Accessing inferior stack frames from Guile
@ -375,6 +376,9 @@ as a symbol.
@item <gdb:objfile> @item <gdb:objfile>
@xref{Objfiles In Guile}. @xref{Objfiles In Guile}.
@item <gdb:parameter>
@xref{Parameters In Guile}.
@item <gdb:pretty-printer> @item <gdb:pretty-printer>
@xref{Guile Pretty Printing API}. @xref{Guile Pretty Printing API}.
@ -1946,6 +1950,177 @@ end
Hello, World! Hello, World!
@end smallexample @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
Guiles 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 @node Progspaces In Guile
@subsubsection Program Spaces In Guile @subsubsection Program Spaces In Guile

View file

@ -166,6 +166,8 @@ extern void gdbscm_dynwind_xfree (void *ptr);
extern int gdbscm_is_procedure (SCM proc); extern int gdbscm_is_procedure (SCM proc);
extern char *gdbscm_gc_xstrdup (const char *); extern char *gdbscm_gc_xstrdup (const char *);
extern const char * const *gdbscm_gc_dup_argv (char **argv);
/* GDB smobs, from scm-gsmob.c */ /* 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, extern SCM gdbscm_make_misc_error (const char *subr, int arg_pos,
SCM bad_value, const char *error); 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 void gdbscm_throw (SCM exception) ATTRIBUTE_NORETURN;
extern SCM gdbscm_scm_from_gdb_exception (struct gdb_exception exception); 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 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 */ /* scm-frame.c */
typedef struct _frame_smob frame_smob; 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, extern SCM gdbscm_scm_from_string (const char *string, size_t len,
const char *charset, int strict); 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 */ /* scm-symbol.c */
extern int syscm_is_symbol (SCM scm); 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_math (void);
extern void gdbscm_initialize_objfiles (void); extern void gdbscm_initialize_objfiles (void);
extern void gdbscm_initialize_pretty_printers (void); extern void gdbscm_initialize_pretty_printers (void);
extern void gdbscm_initialize_parameters (void);
extern void gdbscm_initialize_ports (void); extern void gdbscm_initialize_ports (void);
extern void gdbscm_initialize_pspaces (void); extern void gdbscm_initialize_pspaces (void);
extern void gdbscm_initialize_smobs (void); extern void gdbscm_initialize_smobs (void);

View file

@ -544,6 +544,7 @@ initialize_gdb_module (void *data)
gdbscm_initialize_lazy_strings (); gdbscm_initialize_lazy_strings ();
gdbscm_initialize_math (); gdbscm_initialize_math ();
gdbscm_initialize_objfiles (); gdbscm_initialize_objfiles ();
gdbscm_initialize_parameters ();
gdbscm_initialize_ports (); gdbscm_initialize_ports ();
gdbscm_initialize_pretty_printers (); gdbscm_initialize_pretty_printers ();
gdbscm_initialize_pspaces (); gdbscm_initialize_pspaces ();

View file

@ -275,6 +275,26 @@
current-objfile current-objfile
objfiles 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 ;; scm-ports.c
input-port input-port

View file

@ -603,8 +603,8 @@ gdbscm_valid_command_class_p (int command_class)
but that is the caller's responsibility. but that is the caller's responsibility.
Space for the result is allocated on the GC heap. */ Space for the result is allocated on the GC heap. */
static char * char *
cmdscm_canonicalize_name (const char *name, int want_trailing_space) gdbscm_canonicalize_command_name (const char *name, int want_trailing_space)
{ {
int i, out, seen_word; int i, out, seen_word;
char *result = scm_gc_malloc_pointerless (strlen (name) + 2, FUNC_NAME); 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.")); doc = xstrdup (_("This command is not documented."));
s = name; s = name;
name = cmdscm_canonicalize_name (s, is_prefix); name = gdbscm_canonicalize_command_name (s, is_prefix);
xfree (s); xfree (s);
s = doc; s = doc;
doc = gdbscm_gc_xstrdup (s); doc = gdbscm_gc_xstrdup (s);

View file

@ -360,12 +360,23 @@ gdbscm_out_of_range_error (const char *subr, int arg_pos, SCM bad_value,
SCM SCM
gdbscm_make_misc_error (const char *subr, int arg_pos, SCM bad_value, 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, return gdbscm_make_arg_error (scm_misc_error_key,
subr, arg_pos, bad_value, NULL, error); 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. */ /* Return a <gdb:exception> object for gdb:memory-error. */
SCM SCM

1163
gdb/guile/scm-param.c Normal file

File diff suppressed because it is too large Load diff

View file

@ -90,10 +90,17 @@ gdbscm_call_scm_to_stringn (void *datap)
/* Convert an SCM string to a string in charset CHARSET. /* Convert an SCM string to a string in charset CHARSET.
This function is guaranteed to not throw an exception. 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 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. <gdb:exception> object is stored in *EXCEPT_SCMP, and NULL is returned.
If STRICT is zero, then escape sequences are used for characters that If STRICT is zero, then escape sequences are used for characters that
can't be converted, and EXCEPT_SCMP may be passed as NULL. can't be converted, and EXCEPT_SCMP may be passed as NULL.
Space for the result is allocated with malloc, caller must free. Space for the result is allocated with malloc, caller must free.
It is an error to call this if STRING is not a string. */ 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. /* Convert STRING to a Scheme string in charset CHARSET.
This function is guaranteed to not throw an exception. This function is guaranteed to not throw an exception.
If STRICT is non-zero, and there's a conversion error, then a If STRICT is non-zero, and there's a conversion error, then a
<gdb:exception> object is returned. <gdb:exception> object is returned.
If STRICT is zero, then question marks are used for characters that 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; 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 /* (string->argv string) -> list
Return list of strings split up according to GDB's argv parsing rules. Return list of strings split up according to GDB's argv parsing rules.
This is useful when writing GDB commands in Scheme. */ This is useful when writing GDB commands in Scheme. */

View file

@ -595,3 +595,32 @@ gdbscm_gc_xstrdup (const char *str)
strcpy (result, str); strcpy (result, str);
return result; 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;
}

View file

@ -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> 2014-06-02 Doug Evans <xdje42@gmail.com>
* gdb.guile/scm-cmd.c: New file. * gdb.guile/scm-cmd.c: New file.

View 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."
}