Split create-breakpoint! into make-breakpoint, register-breakpoint!.
Rename breakpoint-delete! to delete-breakpoint!. * guile/scm-breakpoint.c (struct gdbscm_breakpoint_object): New members is_scheme_bkpt, spec. (bpscm_make_breakpoint_smob): Initialize new members. (gdbscm_create_breakpoint_x): Split into two ... (gdbscm_make_breakpoint, gdbscm_register_breakpoint_x): New functions. (bpscm_breakpoint_deleted): Reset breakpoint number and stop function. (scheme_function breakpoint_functions): Update. * guile/lib/gdb.scm: Delete create-breakpoint!. Rename breakpoint-delete! to delete-breakpoint!. Add make-breakpoint, register-breakpoint!. testsuite/ * gdb.guile/scm-breakpoint.exp: Update. Add tests for breakpoint registration. doc/ * guile.texi (Breakpoints In Guile): Update.
This commit is contained in:
parent
c5cad97c38
commit
16f691fb2e
@ -1,3 +1,16 @@
|
||||
2014-06-04 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
* guile/scm-breakpoint.c (struct gdbscm_breakpoint_object): New members
|
||||
is_scheme_bkpt, spec.
|
||||
(bpscm_make_breakpoint_smob): Initialize new members.
|
||||
(gdbscm_create_breakpoint_x): Split into two ...
|
||||
(gdbscm_make_breakpoint, gdbscm_register_breakpoint_x): New functions.
|
||||
(bpscm_breakpoint_deleted): Reset breakpoint number and stop function.
|
||||
(scheme_function breakpoint_functions): Update.
|
||||
* guile/lib/gdb.scm: Delete create-breakpoint!. Rename
|
||||
breakpoint-delete! to delete-breakpoint!. Add make-breakpoint,
|
||||
register-breakpoint!.
|
||||
|
||||
2014-06-04 Joel Brobecker <brobecker@adacorer.com>
|
||||
|
||||
PR server/17023
|
||||
|
@ -1,3 +1,7 @@
|
||||
2014-06-04 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
* guile.texi (Breakpoints In Guile): Update.
|
||||
|
||||
2014-06-03 Joel Brobecker <brobecker@adacore.com>
|
||||
|
||||
* python.texi (Xmethod API): Fix reference to "Progspaces In
|
||||
|
@ -2899,18 +2899,30 @@ object will be @code{#f} and 0 respectively.
|
||||
@tindex <gdb:breakpoint>
|
||||
|
||||
Breakpoints in Guile are represented by objects of type
|
||||
@code{<gdb:breakpoint>}.
|
||||
@code{<gdb:breakpoint>}. New breakpoints can be created with the
|
||||
@code{make-breakpoint} Guile function, and then added to @value{GDBN} with the
|
||||
@code{register-breakpoint!} Guile function.
|
||||
This two-step approach is taken to separate out the side-effect of adding
|
||||
the breakpoint to @value{GDBN} from @code{make-breakpoint}.
|
||||
|
||||
Support is also provided to view and manipulate breakpoints created
|
||||
outside of Guile.
|
||||
|
||||
The following breakpoint-related procedures are provided by the
|
||||
@code{(gdb)} module:
|
||||
|
||||
@c TODO: line length
|
||||
@deffn {Scheme Procedure} create-breakpoint! location @r{[}#:type type@r{]} @r{[}#:wp-class wp-class@r{]} @r{[}#:internal internal@r{]}
|
||||
Create a new breakpoint according to @var{spec}, a string naming the
|
||||
@deffn {Scheme Procedure} make-breakpoint location @r{[}#:type type@r{]} @r{[}#:wp-class wp-class@r{]} @r{[}#:internal internal@r{]}
|
||||
Create a new breakpoint at @var{location}, a string naming the
|
||||
location of the breakpoint, or an expression that defines a watchpoint.
|
||||
The contents can be any location recognized by the @code{break} command,
|
||||
or in the case of a watchpoint, by the @code{watch} command.
|
||||
|
||||
The breakpoint is initially marked as @samp{invalid}.
|
||||
The breakpoint is not usable until it has been registered with @value{GDBN}
|
||||
with @code{register-breakpoint!}, at which point it becomes @samp{valid}.
|
||||
The result is the @code{<gdb:breakpoint>} object representing the breakpoint.
|
||||
|
||||
The optional @var{type} denotes the breakpoint to create.
|
||||
This argument can be either @code{BP_BREAKPOINT} or @code{BP_WATCHPOINT},
|
||||
and defaults to @code{BP_BREAKPOINT}.
|
||||
@ -2921,7 +2933,7 @@ not provided, it is assumed to be a @code{WP_WRITE} class.
|
||||
|
||||
The optional @var{internal} argument allows the breakpoint to become
|
||||
invisible to the user. The breakpoint will neither be reported when
|
||||
created, nor will it be listed in the output from @code{info breakpoints}
|
||||
registered, nor will it be listed in the output from @code{info breakpoints}
|
||||
(but will be listed with the @code{maint info breakpoints} command).
|
||||
If an internal flag is not provided, the breakpoint is visible
|
||||
(non-internal).
|
||||
@ -2972,10 +2984,24 @@ Read/Write watchpoint.
|
||||
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} breakpoint-delete! breakpoint
|
||||
Permanently delete @var{breakpoint}. This also invalidates the
|
||||
Guile @var{breakpoint} object. Any further attempt to access the
|
||||
object will throw an exception.
|
||||
@deffn {Scheme Procedure} register-breakpoint! breakpoint
|
||||
Add @var{breakpoint}, a @code{<gdb:breakpoint>} object, to @value{GDBN}'s
|
||||
list of breakpoints. The breakpoint must have been created with
|
||||
@code{make-breakpoint}. One cannot register breakpoints that have been
|
||||
created outside of Guile. Once a breakpoint is registered it becomes
|
||||
@samp{valid}.
|
||||
It is an error to register an already registered breakpoint.
|
||||
The result is unspecified.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} delete-breakpoint! breakpoint
|
||||
Remove @var{breakpoint} from @value{GDBN}'s list of breakpoints.
|
||||
This also invalidates the Guile @var{breakpoint} object.
|
||||
Any further attempt to access the object will throw an exception.
|
||||
|
||||
If @var{breakpoint} was created from Guile with @code{make-breakpoint}
|
||||
it may be re-registered with @value{GDBN}, in which case the breakpoint
|
||||
becomes valid again.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} breakpoints
|
||||
@ -2990,6 +3016,8 @@ and @code{#f} otherwise.
|
||||
|
||||
@deffn {Scheme Procedure} breakpoint-valid? breakpoint
|
||||
Return @code{#t} if @var{breakpoint} is valid, @code{#f} otherwise.
|
||||
Breakpoints created with @code{make-breakpoint} are marked as invalid
|
||||
until they are registered with @value{GDBN} with @code{register-breakpoint!}.
|
||||
A @code{<gdb:breakpoint>} object can become invalid
|
||||
if the user deletes the breakpoint. In this case, the object still
|
||||
exists, but the underlying breakpoint does not. In the cases of
|
||||
@ -3129,7 +3157,8 @@ Example @code{stop} implementation:
|
||||
(define (my-stop? bkpt)
|
||||
(let ((int-val (parse-and-eval "foo")))
|
||||
(value=? int-val 3)))
|
||||
(define bkpt (create-breakpoint! "main.c:42"))
|
||||
(define bkpt (make-breakpoint "main.c:42"))
|
||||
(register-breakpoint! bkpt)
|
||||
(set-breakpoint-stop! bkpt my-stop?)
|
||||
@end smallexample
|
||||
@end deffn
|
||||
|
@ -114,7 +114,8 @@
|
||||
WP_ACCESS
|
||||
|
||||
make-breakpoint
|
||||
breakpoint-delete!
|
||||
register-breakpoint!
|
||||
delete-breakpoint!
|
||||
breakpoints
|
||||
breakpoint?
|
||||
breakpoint-valid?
|
||||
|
@ -34,18 +34,51 @@
|
||||
#include "guile-internal.h"
|
||||
|
||||
/* The <gdb:breakpoint> smob.
|
||||
N.B.: The name of this struct is known to breakpoint.h. */
|
||||
N.B.: The name of this struct is known to breakpoint.h.
|
||||
|
||||
Note: Breakpoints are added to gdb using a two step process:
|
||||
1) Call make-breakpoint to create a <gdb:breakpoint> object.
|
||||
2) Call register-breakpoint! to add the breakpoint to gdb.
|
||||
It is done this way so that the constructor, make-breakpoint, doesn't have
|
||||
any side-effects. This means that the smob needs to store everything
|
||||
that was passed to make-breakpoint. */
|
||||
|
||||
typedef struct gdbscm_breakpoint_object
|
||||
{
|
||||
/* This always appears first. */
|
||||
gdb_smob base;
|
||||
|
||||
/* Non-zero if this breakpoint was created with make-breakpoint. */
|
||||
int is_scheme_bkpt;
|
||||
|
||||
/* For breakpoints created with make-breakpoint, these are the parameters
|
||||
that were passed to make-breakpoint. These values are not used except
|
||||
to register the breakpoint with GDB. */
|
||||
struct
|
||||
{
|
||||
/* The string representation of the breakpoint.
|
||||
Space for this lives in GC space. */
|
||||
char *location;
|
||||
|
||||
/* The kind of breakpoint.
|
||||
At the moment this can only be one of bp_breakpoint, bp_watchpoint. */
|
||||
enum bptype type;
|
||||
|
||||
/* If a watchpoint, the kind of watchpoint. */
|
||||
enum target_hw_bp_type access_type;
|
||||
|
||||
/* Non-zero if the breakpoint is an "internal" breakpoint. */
|
||||
int is_internal;
|
||||
} spec;
|
||||
|
||||
/* The breakpoint number according to gdb.
|
||||
For breakpoints created from Scheme, this has the value -1 until the
|
||||
breakpoint is registered with gdb.
|
||||
This is recorded here because BP will be NULL when deleted. */
|
||||
int number;
|
||||
|
||||
/* The gdb breakpoint object, or NULL if the breakpoint has been deleted. */
|
||||
/* The gdb breakpoint object, or NULL if the breakpoint has not been
|
||||
registered yet, or has been deleted. */
|
||||
struct breakpoint *bp;
|
||||
|
||||
/* Backlink to our containing <gdb:breakpoint> smob.
|
||||
@ -171,8 +204,8 @@ bpscm_make_breakpoint_smob (void)
|
||||
scm_gc_malloc (sizeof (breakpoint_smob), breakpoint_smob_name);
|
||||
SCM bp_scm;
|
||||
|
||||
memset (bp_smob, 0, sizeof (*bp_smob));
|
||||
bp_smob->number = -1;
|
||||
bp_smob->bp = NULL;
|
||||
bp_smob->stop = SCM_BOOL_F;
|
||||
bp_scm = scm_new_smob (breakpoint_smob_tag, (scm_t_bits) bp_smob);
|
||||
bp_smob->containing_scm = bp_scm;
|
||||
@ -293,42 +326,111 @@ bpscm_get_valid_breakpoint_smob_arg_unsafe (SCM self, int arg_pos,
|
||||
|
||||
/* Breakpoint methods. */
|
||||
|
||||
/* (create-breakpoint! string [#:type integer] [#:wp-class integer]
|
||||
[#:internal boolean) -> <gdb:breakpoint> */
|
||||
/* (make-breakpoint string [#:type integer] [#:wp-class integer]
|
||||
[#:internal boolean) -> <gdb:breakpoint>
|
||||
|
||||
The result is the <gdb:breakpoint> Scheme object.
|
||||
The breakpoint is not available to be used yet, however.
|
||||
It must still be added to gdb with register-breakpoint!. */
|
||||
|
||||
static SCM
|
||||
gdbscm_create_breakpoint_x (SCM spec_scm, SCM rest)
|
||||
gdbscm_make_breakpoint (SCM location_scm, SCM rest)
|
||||
{
|
||||
const SCM keywords[] = {
|
||||
type_keyword, wp_class_keyword, internal_keyword, SCM_BOOL_F
|
||||
};
|
||||
char *spec;
|
||||
char *s;
|
||||
char *location;
|
||||
int type_arg_pos = -1, access_type_arg_pos = -1, internal_arg_pos = -1;
|
||||
int type = bp_breakpoint;
|
||||
int access_type = hw_write;
|
||||
int internal = 0;
|
||||
SCM result;
|
||||
volatile struct gdb_exception except;
|
||||
breakpoint_smob *bp_smob;
|
||||
|
||||
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#iit",
|
||||
spec_scm, &spec, rest,
|
||||
location_scm, &location, rest,
|
||||
&type_arg_pos, &type,
|
||||
&access_type_arg_pos, &access_type,
|
||||
&internal_arg_pos, &internal);
|
||||
|
||||
result = bpscm_make_breakpoint_smob ();
|
||||
pending_breakpoint_scm = result;
|
||||
bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (result);
|
||||
|
||||
s = location;
|
||||
location = gdbscm_gc_xstrdup (s);
|
||||
xfree (s);
|
||||
|
||||
switch (type)
|
||||
{
|
||||
case bp_breakpoint:
|
||||
if (access_type_arg_pos > 0)
|
||||
{
|
||||
gdbscm_misc_error (FUNC_NAME, access_type_arg_pos,
|
||||
scm_from_int (access_type),
|
||||
_("access type with breakpoint is not allowed"));
|
||||
}
|
||||
break;
|
||||
case bp_watchpoint:
|
||||
switch (access_type)
|
||||
{
|
||||
case hw_write:
|
||||
case hw_access:
|
||||
case hw_read:
|
||||
break;
|
||||
default:
|
||||
gdbscm_out_of_range_error (FUNC_NAME, access_type_arg_pos,
|
||||
scm_from_int (access_type),
|
||||
_("invalid watchpoint class"));
|
||||
}
|
||||
break;
|
||||
default:
|
||||
gdbscm_out_of_range_error (FUNC_NAME, access_type_arg_pos,
|
||||
scm_from_int (type),
|
||||
_("invalid breakpoint type"));
|
||||
}
|
||||
|
||||
bp_smob->is_scheme_bkpt = 1;
|
||||
bp_smob->spec.location = location;
|
||||
bp_smob->spec.type = type;
|
||||
bp_smob->spec.access_type = access_type;
|
||||
bp_smob->spec.is_internal = internal;
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/* (register-breakpoint! <gdb:breakpoint>) -> unspecified
|
||||
|
||||
It is an error to register a breakpoint created outside of Guile,
|
||||
or an already-registered breakpoint. */
|
||||
|
||||
static SCM
|
||||
gdbscm_register_breakpoint_x (SCM self)
|
||||
{
|
||||
breakpoint_smob *bp_smob
|
||||
= bpscm_get_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||
volatile struct gdb_exception except;
|
||||
|
||||
/* We only support registering breakpoints created with make-breakpoint. */
|
||||
if (!bp_smob->is_scheme_bkpt)
|
||||
scm_misc_error (FUNC_NAME, _("not a Scheme breakpoint"), SCM_EOL);
|
||||
|
||||
if (bpscm_is_valid (bp_smob))
|
||||
scm_misc_error (FUNC_NAME, _("breakpoint is already registered"), SCM_EOL);
|
||||
|
||||
pending_breakpoint_scm = self;
|
||||
|
||||
TRY_CATCH (except, RETURN_MASK_ALL)
|
||||
{
|
||||
struct cleanup *cleanup = make_cleanup (xfree, spec);
|
||||
char *location = bp_smob->spec.location;
|
||||
int internal = bp_smob->spec.is_internal;
|
||||
|
||||
switch (type)
|
||||
switch (bp_smob->spec.type)
|
||||
{
|
||||
case bp_breakpoint:
|
||||
{
|
||||
create_breakpoint (get_current_arch (),
|
||||
spec, NULL, -1, NULL,
|
||||
location, NULL, -1, NULL,
|
||||
0,
|
||||
0, bp_breakpoint,
|
||||
0,
|
||||
@ -339,36 +441,37 @@ gdbscm_create_breakpoint_x (SCM spec_scm, SCM rest)
|
||||
}
|
||||
case bp_watchpoint:
|
||||
{
|
||||
enum target_hw_bp_type access_type = bp_smob->spec.access_type;
|
||||
|
||||
if (access_type == hw_write)
|
||||
watch_command_wrapper (spec, 0, internal);
|
||||
watch_command_wrapper (location, 0, internal);
|
||||
else if (access_type == hw_access)
|
||||
awatch_command_wrapper (spec, 0, internal);
|
||||
awatch_command_wrapper (location, 0, internal);
|
||||
else if (access_type == hw_read)
|
||||
rwatch_command_wrapper (spec, 0, internal);
|
||||
rwatch_command_wrapper (location, 0, internal);
|
||||
else
|
||||
error (_("Invalid watchpoint access type"));
|
||||
gdb_assert_not_reached ("invalid access type");
|
||||
break;
|
||||
}
|
||||
default:
|
||||
error (_("Invalid breakpoint type"));
|
||||
gdb_assert_not_reached ("invalid breakpoint type");
|
||||
}
|
||||
|
||||
do_cleanups (cleanup);
|
||||
}
|
||||
/* Ensure this gets reset, even if there's an error. */
|
||||
pending_breakpoint_scm = SCM_BOOL_F;
|
||||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||||
|
||||
return result;
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
/* (breakpoint-delete! <gdb:breakpoint>) -> unspecified
|
||||
Scheme function which deletes the underlying GDB breakpoint. This
|
||||
triggers the breakpoint_deleted observer which will call
|
||||
gdbscm_breakpoint_deleted; that function cleans up the Scheme sections. */
|
||||
/* (delete-breakpoint! <gdb:breakpoint>) -> unspecified
|
||||
Scheme function which deletes (removes) the underlying GDB breakpoint
|
||||
from GDB's list of breakpoints. This triggers the breakpoint_deleted
|
||||
observer which will call gdbscm_breakpoint_deleted; that function cleans
|
||||
up the Scheme bits. */
|
||||
|
||||
static SCM
|
||||
gdbscm_breakpoint_delete_x (SCM self)
|
||||
gdbscm_delete_breakpoint_x (SCM self)
|
||||
{
|
||||
breakpoint_smob *bp_smob
|
||||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||
@ -999,6 +1102,8 @@ bpscm_breakpoint_deleted (struct breakpoint *b)
|
||||
if (bp_smob)
|
||||
{
|
||||
bp_smob->bp = NULL;
|
||||
bp_smob->number = -1;
|
||||
bp_smob->stop = SCM_BOOL_F;
|
||||
scm_gc_unprotect_object (bp_smob->containing_scm);
|
||||
}
|
||||
}
|
||||
@ -1024,14 +1129,20 @@ static const scheme_integer_constant breakpoint_integer_constants[] =
|
||||
|
||||
static const scheme_function breakpoint_functions[] =
|
||||
{
|
||||
{ "create-breakpoint!", 1, 0, 1, gdbscm_create_breakpoint_x,
|
||||
{ "make-breakpoint", 1, 0, 1, gdbscm_make_breakpoint,
|
||||
"\
|
||||
Create and install a GDB breakpoint object.\n\
|
||||
Create a GDB breakpoint object.\n\
|
||||
\n\
|
||||
Arguments:\n\
|
||||
location [#:type <type>] [#:wp-class <wp-class>] [#:internal <bool>]" },
|
||||
location [#:type <type>] [#:wp-class <wp-class>] [#:internal <bool>]\n\
|
||||
Returns:\n\
|
||||
<gdb:breakpoint object" },
|
||||
|
||||
{ "breakpoint-delete!", 1, 0, 0, gdbscm_breakpoint_delete_x,
|
||||
{ "register-breakpoint!", 1, 0, 0, gdbscm_register_breakpoint_x,
|
||||
"\
|
||||
Register a <gdb:breakpoint> object with GDB." },
|
||||
|
||||
{ "delete-breakpoint!", 1, 0, 0, gdbscm_delete_breakpoint_x,
|
||||
"\
|
||||
Delete the breakpoint from GDB." },
|
||||
|
||||
|
@ -1,3 +1,8 @@
|
||||
2014-06-04 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
* gdb.guile/scm-breakpoint.exp: Update.
|
||||
Add tests for breakpoint registration.
|
||||
|
||||
2014-06-04 Tom Tromey <tromey@redhat.com>
|
||||
|
||||
* gdb.base/vla-datatypes.exp: Add tests for VLA-in-structure and
|
||||
|
@ -116,8 +116,10 @@ proc test_bkpt_deletion { } {
|
||||
# Test breakpoints are deleted correctly.
|
||||
set deltst_location [gdb_get_line_number "Break at multiply."]
|
||||
set end_location [gdb_get_line_number "Break at end."]
|
||||
gdb_scm_test_silent_cmd "guile (define dp1 (create-breakpoint! \"$deltst_location\"))" \
|
||||
gdb_scm_test_silent_cmd "guile (define dp1 (make-breakpoint \"$deltst_location\"))" \
|
||||
"create deltst breakpoint"
|
||||
gdb_scm_test_silent_cmd "guile (register-breakpoint! dp1)" \
|
||||
"register dp1"
|
||||
gdb_breakpoint [gdb_get_line_number "Break at end."]
|
||||
gdb_scm_test_silent_cmd "guile (define del-list (breakpoints))" \
|
||||
"get breakpoint list 4"
|
||||
@ -125,10 +127,10 @@ proc test_bkpt_deletion { } {
|
||||
"= 3" "number of breakpoints before delete"
|
||||
gdb_continue_to_breakpoint "Break at multiply." \
|
||||
".*/$srcfile:$deltst_location.*"
|
||||
gdb_scm_test_silent_cmd "guile (breakpoint-delete! dp1)" \
|
||||
gdb_scm_test_silent_cmd "guile (delete-breakpoint! dp1)" \
|
||||
"delete breakpoint"
|
||||
gdb_test "guile (print (breakpoint-number dp1))" \
|
||||
"ERROR: .*: Invalid object: <gdb:breakpoint> in position 1: #<gdb:breakpoint #2>.*" \
|
||||
"ERROR: .*: Invalid object: <gdb:breakpoint> in position 1: #<gdb:breakpoint #-1>.*" \
|
||||
"check breakpoint invalidated"
|
||||
gdb_scm_test_silent_cmd "guile (set! del-list (breakpoints))" \
|
||||
"get breakpoint list 5"
|
||||
@ -151,8 +153,10 @@ proc test_bkpt_cond_and_cmds { } {
|
||||
|
||||
# Test conditional setting.
|
||||
set bp_location1 [gdb_get_line_number "Break at multiply."]
|
||||
gdb_scm_test_silent_cmd "guile (define bp1 (create-breakpoint! \"$bp_location1\"))" \
|
||||
gdb_scm_test_silent_cmd "guile (define bp1 (make-breakpoint \"$bp_location1\"))" \
|
||||
"create multiply breakpoint"
|
||||
gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \
|
||||
"register bp1"
|
||||
gdb_continue_to_breakpoint "Break at multiply."
|
||||
gdb_scm_test_silent_cmd "guile (set-breakpoint-condition! bp1 \"i == 5\")" \
|
||||
"set condition"
|
||||
@ -199,8 +203,10 @@ proc test_bkpt_invisible { } {
|
||||
# Test invisible breakpoints.
|
||||
delete_breakpoints
|
||||
set ibp_location [gdb_get_line_number "Break at multiply."]
|
||||
gdb_scm_test_silent_cmd "guile (define vbp (create-breakpoint! \"$ibp_location\" #:internal #f))" \
|
||||
gdb_scm_test_silent_cmd "guile (define vbp1 (make-breakpoint \"$ibp_location\" #:internal #f))" \
|
||||
"create visible breakpoint"
|
||||
gdb_scm_test_silent_cmd "guile (register-breakpoint! vbp1)" \
|
||||
"register vbp1"
|
||||
gdb_scm_test_silent_cmd "guile (define vbp (car (breakpoints)))" \
|
||||
"get visible breakpoint"
|
||||
gdb_test "guile (print vbp)" \
|
||||
@ -214,8 +220,10 @@ proc test_bkpt_invisible { } {
|
||||
"scm-breakpoint\.c:$ibp_location.*" \
|
||||
"check info breakpoints shows visible breakpoints"
|
||||
delete_breakpoints
|
||||
gdb_scm_test_silent_cmd "guile (define ibp (create-breakpoint! \"$ibp_location\" #:internal #t))" \
|
||||
gdb_scm_test_silent_cmd "guile (define ibp (make-breakpoint \"$ibp_location\" #:internal #t))" \
|
||||
"create invisible breakpoint"
|
||||
gdb_scm_test_silent_cmd "guile (register-breakpoint! ibp)" \
|
||||
"register ibp"
|
||||
gdb_test "guile (print ibp)" \
|
||||
"= #<gdb:breakpoint #-$decimal BP_BREAKPOINT enabled noisy hit:0 ignore:0 @.*scm-breakpoint.c:$ibp_location>" \
|
||||
"check invisible bp obj exists"
|
||||
@ -247,8 +255,10 @@ proc test_watchpoints { } {
|
||||
return
|
||||
}
|
||||
|
||||
gdb_scm_test_silent_cmd "guile (define wp1 (create-breakpoint! \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE))" \
|
||||
gdb_scm_test_silent_cmd "guile (define wp1 (make-breakpoint \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE))" \
|
||||
"create watchpoint"
|
||||
gdb_scm_test_silent_cmd "guile (register-breakpoint! wp1)" \
|
||||
"register wp1"
|
||||
gdb_test "continue" \
|
||||
".*\[Ww\]atchpoint.*result.*Old value = 0.*New value = 25.*main.*" \
|
||||
"test watchpoint write"
|
||||
@ -272,8 +282,10 @@ proc test_bkpt_internal { } {
|
||||
|
||||
delete_breakpoints
|
||||
|
||||
gdb_scm_test_silent_cmd "guile (define wp1 (create-breakpoint! \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE #:internal #t))" \
|
||||
gdb_scm_test_silent_cmd "guile (define wp1 (make-breakpoint \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE #:internal #t))" \
|
||||
"create invisible watchpoint"
|
||||
gdb_scm_test_silent_cmd "guile (register-breakpoint! wp1)" \
|
||||
"register wp1"
|
||||
gdb_test "info breakpoints" \
|
||||
"No breakpoints or watchpoints.*" \
|
||||
"check info breakpoints does not show invisible watchpoint"
|
||||
@ -303,6 +315,11 @@ proc test_bkpt_eval_funcs { } {
|
||||
|
||||
delete_breakpoints
|
||||
|
||||
# Define create-breakpoint! as a convenient wrapper around
|
||||
# make-breakpoint, register-breakpoint!
|
||||
gdb_test_no_output "guile (define (create-breakpoint! . args) (let ((bp (apply make-breakpoint args))) (register-breakpoint! bp) bp))" \
|
||||
"define create-breakpoint!"
|
||||
|
||||
gdb_test_multiline "data collection breakpoint 1" \
|
||||
"guile" "" \
|
||||
"(define (make-bp-data) (cons 0 0))" "" \
|
||||
@ -429,6 +446,47 @@ proc test_bkpt_eval_funcs { } {
|
||||
}
|
||||
}
|
||||
|
||||
proc test_bkpt_registration {} {
|
||||
global srcfile testfile
|
||||
|
||||
with_test_prefix "test_bkpt_registration" {
|
||||
# Start with a fresh gdb.
|
||||
clean_restart ${testfile}
|
||||
|
||||
if ![gdb_guile_runto_main] {
|
||||
return
|
||||
}
|
||||
|
||||
# Initially there should be one breakpoint: main.
|
||||
gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
|
||||
"get breakpoint list 1"
|
||||
gdb_test "guile (register-breakpoint! (car blist))" \
|
||||
"ERROR: .*: not a Scheme breakpoint.*" \
|
||||
"try to register a non-guile breakpoint"
|
||||
|
||||
set bp_location1 [gdb_get_line_number "Break at multiply."]
|
||||
gdb_scm_test_silent_cmd "guile (define bp1 (make-breakpoint \"$bp_location1\"))" \
|
||||
"create multiply breakpoint"
|
||||
gdb_test "guile (print (breakpoint-valid? bp1))" \
|
||||
"= #f" "breakpoint invalid after creation"
|
||||
gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \
|
||||
"register bp1"
|
||||
gdb_test "guile (print (breakpoint-valid? bp1))" \
|
||||
"= #t" "breakpoint valid after registration"
|
||||
gdb_test "guile (register-breakpoint! bp1)" \
|
||||
"ERROR: .*: breakpoint is already registered.*" \
|
||||
"re-register already registered bp1"
|
||||
gdb_scm_test_silent_cmd "guile (delete-breakpoint! bp1)" \
|
||||
"delete registered breakpoint"
|
||||
gdb_test "guile (print (breakpoint-valid? bp1))" \
|
||||
"= #f" "breakpoint invalid after deletion"
|
||||
gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \
|
||||
"re-register bp1"
|
||||
gdb_test "guile (print (breakpoint-valid? bp1))" \
|
||||
"= #t" "breakpoint valid after re-registration"
|
||||
}
|
||||
}
|
||||
|
||||
test_bkpt_basic
|
||||
test_bkpt_deletion
|
||||
test_bkpt_cond_and_cmds
|
||||
@ -436,3 +494,4 @@ test_bkpt_invisible
|
||||
test_watchpoints
|
||||
test_bkpt_internal
|
||||
test_bkpt_eval_funcs
|
||||
test_bkpt_registration
|
||||
|
Loading…
x
Reference in New Issue
Block a user