This is the mail archive of the insight@sources.redhat.com mailing list for the Insight project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

Re: Patch: restoring multi-line breakpoint commands


On Tue, 2 Oct 2001, Keith Seitz wrote:

> Tom wrot:
> >
> > Yeah.  When I was digging around I noticed that gdb command chains use
> > a weird data structure.  It didn't occur to me, though, that
> > gdb_get_breakpoint_info() might not handle them correctly.
>
> Just testing it now...

Ok, I've got something. Man, my head hurts from trying to switch from
regexps <8.1 and regexp>=8.1!!

Can you give this patch a look over and tell me if you see anything
glaringly wrong? (Man, uiout would be perfect for this! If only Andrew had
time to finish his print_stop_reason tweak, we'd snarf our uiout builder
and start using/building libgdb!)

Here's the test I've done for bp commands to check this (I've been
opening a console window, setting a bp at main, and sourcing a file with
these gdb commands):

commands
set $i=0
printf "Hello!\n"
while ($i<10)
if (($i%2) ==0)
printf "** i=%d **\n", $i
else
printf "i=%d\n", $i
end
set $i=$i+1
end
end

Here's the patch (note the sessions patch includes your patch already):

Index: generic/gdbtk-bp.c
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/generic/gdbtk-bp.c,v
retrieving revision 1.9
diff -u -p -r1.9 gdbtk-bp.c
--- gdbtk-bp.c	2001/08/03 03:37:40	1.9
+++ gdbtk-bp.c	2001/10/03 20:18:39
@@ -116,6 +116,8 @@ static int gdb_trace_status (ClientData,
 			     Tcl_Obj * CONST[]);
 static int gdb_tracepoint_exists_command (ClientData, Tcl_Interp *,
 					  int, Tcl_Obj * CONST objv[]);
+static Tcl_Obj *get_breakpoint_commands (struct command_line *cmd);
+
 static int tracepoint_exists (char *args);

 /* Breakpoint/tracepoint events and related functions */
@@ -349,11 +351,8 @@ gdb_get_breakpoint_info (ClientData clie
   Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 			    Tcl_NewIntObj (b->ignore_count));

-  new_obj = Tcl_NewObj ();
-  for (cmd = b->commands; cmd; cmd = cmd->next)
-    Tcl_ListObjAppendElement (NULL, new_obj,
-			      Tcl_NewStringObj (cmd->line, -1));
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, new_obj);
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+			    get_breakpoint_commands (b->commands));

   Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 			    Tcl_NewStringObj (b->cond_string, -1));
@@ -371,6 +370,75 @@ gdb_get_breakpoint_info (ClientData clie
   return TCL_OK;
 }

+/* Helper function for gdb_get_breakpoint_info, this function is
+   responsible for figuring out what to type at the "commands" command
+   in gdb's cli in order to get at the same command list passed here.
+
+   NOTE: cannot use sprintf_append_element_to_obj with anything from
+   gdb, since those things could contain unescaped sequences. */
+static Tcl_Obj *
+get_breakpoint_commands (struct command_line *cmd)
+{
+  Tcl_Obj *obj, *tmp;
+
+  obj = Tcl_NewObj ();
+  while (cmd != NULL)
+    {
+      switch (cmd->control_type)
+	{
+	case simple_control:
+	  /* A simple command. Just append it. */
+	  Tcl_ListObjAppendElement (NULL, obj,
+				    Tcl_NewStringObj (cmd->line, -1));
+	  break;
+
+	case break_control:
+	  /* A loop_break */
+	  sprintf_append_element_to_obj (obj, "loop_break");
+	  break;
+
+	case continue_control:
+	  /* A loop_continue */
+	  sprintf_append_element_to_obj (obj, "loop_continue");
+	  break;
+
+	case while_control:
+	  /* A while loop. Must append "end" to the end of it. */
+	  tmp = Tcl_NewStringObj ("while ", -1);
+	  Tcl_AppendToObj (tmp, cmd->line, -1);
+	  Tcl_ListObjAppendElement (NULL, obj, tmp);
+	  Tcl_ListObjAppendList (NULL, obj,
+				    get_breakpoint_commands (*cmd->body_list));
+	  sprintf_append_element_to_obj (obj, "end");
+	  break;
+
+	case if_control:
+	  /* An if statement. cmd->body_list[0] is the true part,
+	     cmd->body_list[1] contains the "else" (false) part. */
+	  tmp = Tcl_NewStringObj ("if ", -1);
+	  Tcl_AppendToObj (tmp, cmd->line, -1);
+	  Tcl_ListObjAppendElement (NULL, obj, tmp);
+	  Tcl_ListObjAppendList (NULL, obj,
+				 get_breakpoint_commands (cmd->body_list[0]));
+	  if (cmd->body_count == 2)
+	    {
+	      sprintf_append_element_to_obj (obj, "else");
+	      Tcl_ListObjAppendList (NULL, obj,
+					get_breakpoint_commands(cmd->body_list[1]));
+	    }
+	  sprintf_append_element_to_obj (obj, "end");
+	  break;
+
+	case invalid_control:
+	  /* Something invalid. Just skip it. */
+	  break;
+	}
+
+      cmd = cmd->next;
+    }
+
+  return obj;
+}

 /* This implements the tcl command gdb_get_breakpoint_list
  * It builds up a list of the current breakpoints.
Index: library/session.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/session.tcl,v
retrieving revision 1.7
diff -u -p -r1.7 session.tcl
--- session.tcl	2001/06/11 23:08:05	1.7
+++ session.tcl	2001/10/03 20:19:11
@@ -89,9 +89,19 @@ proc SESSION_recreate_bps {specs} {
       gdb_cmd "cond \$bpnum $condition"
     }

+    # escape "$", "[", and "]"
+    if {[info tclversion] >= 8.1} {
+      set expr {([\[\]\$])}
+    } else {
+      set expr {([][$])}
+    }
+    regsub -all -- $expr $commands \
+      {[format "\\%c" [scan {\1} %c x; set x]]} new_commands
+    set commands [subst -nobackslashes -novariables $new_commands]
     if {[llength $commands]} {
       lappend commands end
-      gdb_cmd "commands \$bpnum\n[join $commands \n]"
+      eval gdb_run_readline_command_no_output [list "commands \$bpnum"] \
+	$commands
     }
   }
 }


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]