From: George Barrett <bob@bob131.so>
To: gdb-patches@sourceware.org
Cc: George Barrett <bob@bob131.so>
Subject: [PATCH v3] guile: stop procedures on invalid breakpoints
Date: Thu, 29 Jul 2021 09:16:41 +1000 [thread overview]
Message-ID: <&mr9pm79twbmfxhnjpgw3f5d7fia0/vpu&msv32ihkw74tae&vx&@mail.bob131.so> (raw)
Stop procedures on <gdb:breakpoint> objects are independent of the
breakpoints in GDB core: the only reference made to the GDB breakpoint
pointer in either of `breakpoint-stop' or `set-breakpoint-stop!' is in
the latter checking to ensure that there hasn't already been a stop
condition attached from elsewhere. This check is not applicable to
not-yet-registered <gdb:breakpoint> objects allocated from Scheme.
This commit changes the above-mentioned procedures to accept invalid
<gdb:breakpoint> objects originating from Scheme; this allows the
decoupling of the creation of a specific breakpoint object from its
registration (as well as making the interface less restrictive than it
needs to be).
gdb/ChangeLog:
2021-07-29 George Barrett <bob@bob131.so>
* guile/scm-breakpoint.c
(bpscm_get_valid_or_scm_breakpoint_smob_arg_unsafe): Add
helper function.
(gdbscm_breakpoint_stop): Use
bpscm_get_valid_or_scm_breakpoint_smob_arg_unsafe.
(gdbscm_set_breakpoint_stop_x): Likewise. Check that bp is
non-NULL before doing condition string tests.
gdb/doc/ChangeLog:
2021-07-29 George Barrett <bob@bob131.so>
* guile.texi (Breakpoints In Guile): Add note that
breakpoint-stop and set-breakpoint-stop! may be used on
invalid <gdb:breakpoint> objects if they originated from
Scheme.
gdb/testsuite/ChangeLog:
2021-07-29 George Barrett <bob@bob131.so>
* gdb.guile/scm-breakpoint.exp (test_bkpt_eval_funcs): Add
tests for stop procedure manipulation on invalid
<gdb:breakpoint> objects originating from Scheme.
Add tests for stop procedure manipulation on valid and invalid
<gdb:breakpoint> objects originating from GDB core.
---
gdb/doc/guile.texi | 10 ++++
gdb/guile/scm-breakpoint.c | 64 +++++++++++++++-------
gdb/testsuite/gdb.guile/scm-breakpoint.exp | 37 ++++++++++++-
3 files changed, 90 insertions(+), 21 deletions(-)
diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi
index 36fc9a7af79..602e45b6ce0 100644
--- a/gdb/doc/guile.texi
+++ b/gdb/doc/guile.texi
@@ -3186,6 +3186,11 @@ becomes unconditional.
@deffn {Scheme Procedure} breakpoint-stop breakpoint
Return the stop predicate of @var{breakpoint}.
See @code{set-breakpoint-stop!} below in this section.
+
+If @var{breakpoint} was created using @code{make-breakpoint}, this
+procedure may be used even if @code{breakpoint-valid?} would return
+@code{#f}. In that case it returns the stop procedure that will be used
+by @var{breakpoint} once the breakpoint has been registered.
@end deffn
@deffn {Scheme Procedure} set-breakpoint-stop! breakpoint procedure|#f
@@ -3219,6 +3224,11 @@ Example @code{stop} implementation:
(register-breakpoint! bkpt)
(set-breakpoint-stop! bkpt my-stop?)
@end smallexample
+
+If @var{breakpoint} was created using @code{make-breakpoint}, this
+procedure may be used even if @code{breakpoint-valid?} would return
+@code{#f}. In that case @var{procedure} will be the stop procedure for
+@var{breakpoint} when the breakpoint is registered.
@end deffn
@deffn {Scheme Procedure} breakpoint-commands breakpoint
diff --git a/gdb/guile/scm-breakpoint.c b/gdb/guile/scm-breakpoint.c
index 3f25708afff..32a6e3e4164 100644
--- a/gdb/guile/scm-breakpoint.c
+++ b/gdb/guile/scm-breakpoint.c
@@ -328,6 +328,25 @@ bpscm_get_valid_breakpoint_smob_arg_unsafe (SCM self, int arg_pos,
return bp_smob;
}
+
+/* Returns the breakpoint smob in SELF, verifying it's either valid or
+ originates from Scheme.
+ Throws an exception if SELF is not a <gdb:breakpoint> object,
+ or is invalid and not allocated from Scheme. */
+
+static breakpoint_smob *
+bpscm_get_valid_or_scm_breakpoint_smob_arg_unsafe (SCM self, int arg_pos,
+ const char *func_name)
+{
+ breakpoint_smob *bp_smob
+ = bpscm_get_breakpoint_smob_arg_unsafe (self, arg_pos, func_name);
+
+ if (!bpscm_is_valid (bp_smob) && !bp_smob->is_scheme_bkpt)
+ gdbscm_invalid_object_error (func_name, arg_pos, self,
+ _("<gdb:breakpoint>"));
+
+ return bp_smob;
+}
\f
/* Breakpoint methods. */
@@ -928,7 +947,8 @@ static SCM
gdbscm_breakpoint_stop (SCM self)
{
breakpoint_smob *bp_smob
- = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+ = bpscm_get_valid_or_scm_breakpoint_smob_arg_unsafe (self, SCM_ARG1,
+ FUNC_NAME);
return bp_smob->stop;
}
@@ -940,32 +960,36 @@ static SCM
gdbscm_set_breakpoint_stop_x (SCM self, SCM newvalue)
{
breakpoint_smob *bp_smob
- = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- const struct extension_language_defn *extlang = NULL;
+ = bpscm_get_valid_or_scm_breakpoint_smob_arg_unsafe (self, SCM_ARG1,
+ FUNC_NAME);
SCM_ASSERT_TYPE (gdbscm_is_procedure (newvalue)
|| gdbscm_is_false (newvalue),
newvalue, SCM_ARG2, FUNC_NAME,
_("procedure or #f"));
- if (bp_smob->bp->cond_string != NULL)
- extlang = get_ext_lang_defn (EXT_LANG_GDB);
- if (extlang == NULL)
- extlang = get_breakpoint_cond_ext_lang (bp_smob->bp, EXT_LANG_GUILE);
- if (extlang != NULL)
+ if (bp_smob->bp != nullptr)
{
- char *error_text
- = xstrprintf (_("Only one stop condition allowed. There is"
- " currently a %s stop condition defined for"
- " this breakpoint."),
- ext_lang_capitalized_name (extlang));
-
- scm_dynwind_begin ((scm_t_dynwind_flags) 0);
- gdbscm_dynwind_xfree (error_text);
- gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, error_text);
- /* The following line, while unnecessary, is present for completeness
- sake. */
- scm_dynwind_end ();
+ const struct extension_language_defn *extlang = nullptr;
+ if (bp_smob->bp->cond_string != nullptr)
+ extlang = get_ext_lang_defn (EXT_LANG_GDB);
+ if (extlang == nullptr)
+ extlang = get_breakpoint_cond_ext_lang (bp_smob->bp, EXT_LANG_GUILE);
+ if (extlang != nullptr)
+ {
+ char *error_text
+ = xstrprintf (_("Only one stop condition allowed. There is"
+ " currently a %s stop condition defined for"
+ " this breakpoint."),
+ ext_lang_capitalized_name (extlang));
+
+ scm_dynwind_begin ((scm_t_dynwind_flags) 0);
+ gdbscm_dynwind_xfree (error_text);
+ gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, error_text);
+ /* The following line, while unnecessary, is present for
+ completeness sake. */
+ scm_dynwind_end ();
+ }
}
bp_smob->stop = newvalue;
diff --git a/gdb/testsuite/gdb.guile/scm-breakpoint.exp b/gdb/testsuite/gdb.guile/scm-breakpoint.exp
index be898cacaa7..6964066dd34 100644
--- a/gdb/testsuite/gdb.guile/scm-breakpoint.exp
+++ b/gdb/testsuite/gdb.guile/scm-breakpoint.exp
@@ -383,10 +383,45 @@ proc_with_prefix test_bkpt_eval_funcs { } {
"= 4" \
"check non firing same-location breakpoint eval function was also called at each stop 2"
+ # Check that stop funcs can be manipulated on invalid Scheme-created
+ # breakpoints.
+
+ delete_breakpoints
+ gdb_test "guile (print (breakpoint-valid? eval-bp1))" "= #f" \
+ "check Scheme-created breakpoint is invalid"
+ gdb_scm_test_silent_cmd "guile (set-breakpoint-stop! eval-bp1 (const 'test!))" \
+ "check setting stop procedure on invalid Scheme-created breakpoint"
+ gdb_test "guile (print ((breakpoint-stop eval-bp1)))" "= test!" \
+ "check stop procedure on invalid Scheme-created breakpoint was successfully set"
+
+ # Check that stop funcs can be manipulated on breakpoint wrappers.
+
+ gdb_breakpoint "main"
+ gdb_scm_test_silent_cmd "guile (define bp-wrapper (car (breakpoints)))" \
+ "get breakpoint wrapper"
+ gdb_test "guile (print (breakpoint-valid? bp-wrapper))" "= #t" \
+ "check breakpoint wrapper is valid"
+ gdb_scm_test_silent_cmd "guile (set-breakpoint-stop! bp-wrapper (const 'test!))" \
+ "check setting stop procedure on breakpoit wrapper"
+ gdb_test "guile (print ((breakpoint-stop bp-wrapper)))" "= test!" \
+ "check stop procedure on breakpoint wrapper was successfully set"
+
+ # Check that stop funcs cannot be manipulated on invalid breakpoint
+ # wrappers.
+
+ delete_breakpoints
+ gdb_test "guile (print (breakpoint-valid? bp-wrapper))" "= #f" \
+ "check breakpoint wrapper is invalid"
+ gdb_test "guile (set-breakpoint-stop! bp-wrapper (const 'test!))" \
+ "ERROR:.*Invalid object: <gdb:breakpoint>.*" \
+ "check stop procedure cannot be set on invalid breakpoint wrapper"
+ gdb_test "guile (breakpoint-stop bp-wrapper)" \
+ "ERROR:.*Invalid object: <gdb:breakpoint>.*" \
+ "check stop procedure cannot be retrieved from invalid breakpoint wrapper"
+
# Check we cannot assign a condition to a breakpoint with a stop-func,
# and cannot assign a stop-func to a breakpoint with a condition.
- delete_breakpoints
set cond_bp [gdb_get_line_number "Break at multiply."]
gdb_scm_test_silent_cmd "guile (define eval-bp1 (make-bp-eval \"$cond_bp\"))" \
"create eval-bp1 breakpoint 2"
--
2.31.1
next reply other threads:[~2021-07-28 23:16 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-07-28 23:16 George Barrett [this message]
2021-08-25 18:07 ` [PING] " George Barrett
2021-08-26 1:38 ` Simon Marchi
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='&mr9pm79twbmfxhnjpgw3f5d7fia0/vpu&msv32ihkw74tae&vx&@mail.bob131.so' \
--to=bob@bob131.so \
--cc=gdb-patches@sourceware.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).