This is the mail archive of the
insight@sources.redhat.com
mailing list for the Insight project.
Re: Patch: restoring multi-line breakpoint commands
- To: Tom Tromey <tromey at redhat dot com>
- Subject: Re: Patch: restoring multi-line breakpoint commands
- From: Keith Seitz <keiths at cygnus dot com>
- Date: Wed, 3 Oct 2001 13:22:11 -0700 (PDT)
- cc: Insight List <insight at sourceware dot cygnus dot com>
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
}
}
}