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 7C31F385481F for ; Wed, 28 Jul 2021 23:16:45 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 7C31F385481F Received: from internal.mail.bob131.so (localhost [127.0.0.1]) by mail.bob131.so (Postfix) with ESMTP id 2B93953CF7; Wed, 28 Jul 2021 23:16:43 +0000 (UTC) DKIM-Filter: OpenDKIM Filter v2.11.0 mail.bob131.so 2B93953CF7 Date: Thu, 29 Jul 2021 09:16:41 +1000 From: George Barrett To: gdb-patches@sourceware.org Cc: George Barrett Subject: [PATCH v3] guile: stop procedures on invalid breakpoints Message-ID: <&mr9pm79twbmfxhnjpgw3f5d7fia0/vpu&msv32ihkw74tae&vx&@mail.bob131.so> MIME-Version: 1.0 Content-Type: text/plain; charset="us-ascii" Content-Disposition: inline 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, 28 Jul 2021 23:16:47 -0000 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