Split create-breakpoint! into make-breakpoint, register-breakpoint!.
authorDoug Evans <xdje42@gmail.com>
Thu, 5 Jun 2014 02:44:30 +0000 (19:44 -0700)
committerDoug Evans <xdje42@gmail.com>
Thu, 5 Jun 2014 02:44:30 +0000 (19:44 -0700)
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.

gdb/ChangeLog
gdb/doc/ChangeLog
gdb/doc/guile.texi
gdb/guile/lib/gdb.scm
gdb/guile/scm-breakpoint.c
gdb/testsuite/ChangeLog
gdb/testsuite/gdb.guile/scm-breakpoint.exp

index 7c43607..719ae72 100644 (file)
@@ -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
index 237c9a4..ee67472 100644 (file)
@@ -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
index 3f8c4e4..bd1040c 100644 (file)
@@ -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
index f81433b..d628f00 100644 (file)
  WP_ACCESS
 
  make-breakpoint
- breakpoint-delete!
+ register-breakpoint!
+ delete-breakpoint!
  breakpoints
  breakpoint?
  breakpoint-valid?
index 7edb97d..f4c0f0b 100644 (file)
 #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,
 \f
 /* 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" },
+
+  { "register-breakpoint!", 1, 0, 0, gdbscm_register_breakpoint_x,
+    "\
+Register a <gdb:breakpoint> object with GDB." },
 
-  { "breakpoint-delete!", 1, 0, 0, gdbscm_breakpoint_delete_x,
+  { "delete-breakpoint!", 1, 0, 0, gdbscm_delete_breakpoint_x,
     "\
 Delete the breakpoint from GDB." },
 
index 3bc33b4..98b5e45 100644 (file)
@@ -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
index fd7c970..d181710 100644 (file)
@@ -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