From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail.bob131.so (server2.bob131.so [128.199.153.143]) by sourceware.org (Postfix) with ESMTPS id AFB64385C403 for ; Wed, 25 Aug 2021 18:07:53 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org AFB64385C403 Received: from internal.mail.bob131.so (localhost [127.0.0.1]) by mail.bob131.so (Postfix) with ESMTP id 528EC3E838 for ; Wed, 25 Aug 2021 18:07:20 +0000 (UTC) DKIM-Filter: OpenDKIM Filter v2.11.0 mail.bob131.so 528EC3E838 References: <&mr9pm79twbmfxhnjpgw3f5d7fia0/vpu&msv32ihkw74tae&vx&@mail.bob131.so> From: George Barrett To: gdb-patches@sourceware.org Subject: [PING] [PATCH v3] guile: stop procedures on invalid breakpoints In-reply-to: <&mr9pm79twbmfxhnjpgw3f5d7fia0/vpu&msv32ihkw74tae&vx&@mail.bob131.so> Message-ID: Date: Thu, 26 Aug 2021 04:07:18 +1000 MIME-Version: 1.0 Content-Type: text/plain X-Spam-Status: No, score=-12.1 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 25 Aug 2021 18:08:04 -0000 Pinging. If everything looks alright, I'd appreciate if someone could merge it on my behalf. Thanks. On Thu, Jul 29, 2021 at 09:16:41 +1000, George Barrett wrote: > Stop procedures on 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 objects allocated from Scheme. > > This commit changes the above-mentioned procedures to accept invalid > 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 > > * 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 > > * guile.texi (Breakpoints In Guile): Add note that > breakpoint-stop and set-breakpoint-stop! may be used on > invalid objects if they originated from > Scheme. > > gdb/testsuite/ChangeLog: > > 2021-07-29 George Barrett > > * gdb.guile/scm-breakpoint.exp (test_bkpt_eval_funcs): Add > tests for stop procedure manipulation on invalid > objects originating from Scheme. > Add tests for stop procedure manipulation on valid and invalid > 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 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, > + _("")); > + > + return bp_smob; > +} > > /* 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: .*" \ > + "check stop procedure cannot be set on invalid breakpoint wrapper" > + gdb_test "guile (breakpoint-stop bp-wrapper)" \ > + "ERROR:.*Invalid object: .*" \ > + "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