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 12A7E385BF9D for ; Wed, 19 May 2021 23:28:34 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 12A7E385BF9D Received: from internal.mail.bob131.so (localhost [127.0.0.1]) by mail.bob131.so (Postfix) with ESMTP id 58F4253FBA; Wed, 19 May 2021 23:28:30 +0000 (UTC) DKIM-Filter: OpenDKIM Filter v2.11.0 mail.bob131.so 58F4253FBA Date: Thu, 20 May 2021 09:28:28 +1000 From: George Barrett To: gdb-patches@sourceware.org Cc: George Barrett Subject: [PATCH] guile: stop procedures on invalid breakpoints Message-ID: MIME-Version: 1.0 Content-Type: text/plain; charset="us-ascii" Content-Disposition: inline X-Spam-Status: No, score=-12.0 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.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) 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, 19 May 2021 23:28:36 -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-05-20 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-05-20 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-05-20 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 | 31 +++++++++++++++--- gdb/testsuite/gdb.guile/scm-breakpoint.exp | 37 +++++++++++++++++++++- 3 files changed, 73 insertions(+), 5 deletions(-) diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi index c7e43c8d63a..84590eb19bf 100644 --- a/gdb/doc/guile.texi +++ b/gdb/doc/guile.texi @@ -3182,6 +3182,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 @@ -3215,6 +3220,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 826dfa9b0a3..4215736ebfe 100644 --- a/gdb/guile/scm-breakpoint.c +++ b/gdb/guile/scm-breakpoint.c @@ -326,6 +326,27 @@ 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. */ @@ -918,7 +939,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; } @@ -930,7 +952,8 @@ 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); + = bpscm_get_valid_or_scm_breakpoint_smob_arg_unsafe (self, SCM_ARG1, + FUNC_NAME); const struct extension_language_defn *extlang = NULL; SCM_ASSERT_TYPE (gdbscm_is_procedure (newvalue) @@ -938,9 +961,9 @@ gdbscm_set_breakpoint_stop_x (SCM self, SCM newvalue) newvalue, SCM_ARG2, FUNC_NAME, _("procedure or #f")); - if (bp_smob->bp->cond_string != NULL) + if (bp_smob->bp != NULL && bp_smob->bp->cond_string != NULL) extlang = get_ext_lang_defn (EXT_LANG_GDB); - if (extlang == NULL) + if (bp_smob->bp != NULL && extlang == NULL) extlang = get_breakpoint_cond_ext_lang (bp_smob->bp, EXT_LANG_GUILE); if (extlang != NULL) { diff --git a/gdb/testsuite/gdb.guile/scm-breakpoint.exp b/gdb/testsuite/gdb.guile/scm-breakpoint.exp index 56058942e64..1739793465c 100644 --- a/gdb/testsuite/gdb.guile/scm-breakpoint.exp +++ b/gdb/testsuite/gdb.guile/scm-breakpoint.exp @@ -376,10 +376,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