This is the mail archive of the
insight@sources.redhat.com
mailing list for the Insight project.
[RFA] fix tcl command error messages
- To: Insight Mailing List <insight at sources dot redhat dot com>
- Subject: [RFA] fix tcl command error messages
- From: "Martin M. Hunt" <hunt at redhat dot com>
- Date: Mon, 29 Oct 2001 13:16:06 -0800
- Organization: Red Hat Inc
This patch fixes all the error messages so they will be returned correctly.
Martin
2001-10-29 Martin M. Hunt <hunt@redhat.com>
* generic/gdbtk-cmds.c (gdbtk_set_result): Declare
* generic/gdbtk.c (gdbtk_set_result): New function.
* generic/gdbtk-bp.c (gdb_get_breakpoint_info): Use
gdbtk_set_result().
(gdb_set_bp): Ditto.
(gdb_set_bp_addr): Ditto.
(gdb_get_tracepoint_info): Ditto.
* generic/gdbtk-cmds.c (gdb_cmd): Ditto.
(gdb_immediate_command): Ditto.
(gdb_load_info): Ditto.
(gdb_find_file_command) Ditto.
(gdb_listfuncs): Ditto.
(gdb_load_disassembly): Ditto.
(gdb_loc): Ditto.
(gdb_set_mem): Ditto.
(gdb_get_mem): Ditto.
(gdb_loadfile): Ditto.
* generic/gdbtk-stack.c (gdb_get_vars_command): Ditto.
* generic/gdbtk-varobj.c (variable_format): Ditto.
(variable_value): Ditto.
Index: gdbtk-bp.c
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/generic/gdbtk-bp.c,v
retrieving revision 1.11
diff -u -p -r1.11 gdbtk-bp.c
--- gdbtk-bp.c 2001/10/29 19:37:05 1.11
+++ gdbtk-bp.c 2001/10/29 20:13:53
@@ -309,10 +309,7 @@ gdb_get_breakpoint_info (ClientData clie
b = (bpnum <= breakpoint_list_size ? breakpoint_list[bpnum] : NULL);
if (!b || b->type != bp_breakpoint)
{
- char *err_buf;
- xasprintf (&err_buf, "Breakpoint #%d does not exist.", bpnum);
- Tcl_SetStringObj (result_ptr->obj_ptr, err_buf, -1);
- free(err_buf);
+ gdbtk_set_result (interp, "Breakpoint #%d does not exist.", bpnum);
return TCL_ERROR;
}
@@ -513,8 +510,7 @@ gdb_set_bp (ClientData clientData, Tcl_I
disp = disp_donttouch;
else
{
- Tcl_SetObjResult (interp,
- Tcl_NewStringObj ("type must be \"temp\" or \"normal\"", -1));
+ gdbtk_set_result (interp, "type must be \"temp\" or \"normal\"");
return TCL_ERROR;
}
@@ -586,8 +583,7 @@ gdb_set_bp_addr (ClientData clientData,
disp = disp_donttouch;
else
{
- Tcl_SetObjResult (interp,
- Tcl_NewStringObj ("type must be \"temp\" or \"normal\"", -1));
+ gdbtk_set_result (interp, "type must be \"temp\" or \"normal\"");
return TCL_ERROR;
}
@@ -831,10 +825,7 @@ gdb_get_tracepoint_info (ClientData clie
if (tp == NULL)
{
- char *buff;
- xasprintf (&buff, "Tracepoint #%d does not exist", tpnum);
- Tcl_SetStringObj (result_ptr->obj_ptr, buff, -1);
- free(buff);
+ gdbtk_set_result (interp, "Tracepoint #%d does not exist", tpnum);
return TCL_ERROR;
}
Index: gdbtk-cmds.c
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/generic/gdbtk-cmds.c,v
retrieving revision 1.42
diff -u -p -r1.42 gdbtk-cmds.c
--- gdbtk-cmds.c 2001/10/29 19:37:05 1.42
+++ gdbtk-cmds.c 2001/10/29 20:13:55
@@ -688,8 +688,7 @@ gdb_cmd (clientData, interp, objc, objv)
{
if (Tcl_GetBooleanFromObj (NULL, objv[2], &from_tty) != TCL_OK)
{
- Tcl_SetStringObj (result_ptr->obj_ptr, "from_tty must be a boolean.",
- -1);
+ gdbtk_set_result (interp, "from_tty must be a boolean.");
return TCL_ERROR;
}
}
@@ -758,8 +757,7 @@ gdb_immediate_command (clientData, inter
{
if (Tcl_GetBooleanFromObj (NULL, objv[2], &from_tty) != TCL_OK)
{
- Tcl_SetStringObj (result_ptr->obj_ptr, "from_tty must be a boolean.",
- -1);
+ gdbtk_set_result (interp, "from_tty must be a boolean.");
return TCL_ERROR;
}
}
@@ -923,14 +921,14 @@ gdb_load_info (clientData, interp, objc,
loadfile_bfd = bfd_openr (filename, gnutarget);
if (loadfile_bfd == NULL)
{
- Tcl_SetStringObj (result_ptr->obj_ptr, "Open failed", -1);
+ gdbtk_set_result (interp, "Open of %s failed", filename);
return TCL_ERROR;
}
old_cleanups = make_cleanup_bfd_close (loadfile_bfd);
if (!bfd_check_format (loadfile_bfd, bfd_object))
{
- Tcl_SetStringObj (result_ptr->obj_ptr, "Bad Object File", -1);
+ gdbtk_set_result (interp, "Bad Object File");
return TCL_ERROR;
}
@@ -1109,8 +1107,7 @@ gdb_find_file_command (clientData, inter
/* We should always get a symtab. */
if (!st)
{
- Tcl_SetStringObj ( result_ptr->obj_ptr,
- "File not found in symtab (2)", -1);
+ gdbtk_set_result (interp, "File not found in symtab (2)");
return TCL_ERROR;
}
@@ -1282,7 +1279,6 @@ gdb_search (clientData, interp, objc, ob
if (objc < 3)
{
Tcl_WrongNumArgs (interp, 1, objv, "option regexp ?arg ...?");
- result_ptr->flags |= GDBTK_IN_TCL_RESULT;
return TCL_ERROR;
}
@@ -1477,10 +1473,11 @@ gdb_listfuncs (clientData, interp, objc,
symtab = full_lookup_symtab (Tcl_GetStringFromObj (objv[1], NULL));
if (!symtab)
{
- Tcl_SetStringObj (result_ptr->obj_ptr, "No such file", -1);
+ gdbtk_set_result (interp, "No such file (%s)",
+ Tcl_GetStringFromObj (objv[1], NULL));
return TCL_ERROR;
}
-
+
if (mangled == NULL)
{
mangled = Tcl_NewBooleanObj (1);
@@ -1651,14 +1648,13 @@ gdb_load_disassembly (ClientData clientD
if ( Tk_NameToWindow (interp, client_data.widget,
Tk_MainWindow (interp)) == NULL)
{
- Tcl_SetStringObj (result_ptr->obj_ptr, "Invalid widget name.", -1);
+ gdbtk_set_result (interp, "Invalid widget name.");
return TCL_ERROR;
}
if (!Tcl_GetCommandInfo (interp, client_data.widget, &client_data.cmd))
{
- Tcl_SetStringObj (result_ptr->obj_ptr, "Can't get widget command info",
- -1);
+ gdbtk_set_result (interp, "Can't get widget command info");
return TCL_ERROR;
}
@@ -1669,8 +1665,7 @@ gdb_load_disassembly (ClientData clientD
mixed_source_and_assembly = 0;
else
{
- Tcl_SetStringObj (result_ptr->obj_ptr,
- "Second arg must be 'source' or 'nosource'", -1);
+ gdbtk_set_result (interp, "Second arg must be 'source' or 'nosource'");
return TCL_ERROR;
}
@@ -1695,7 +1690,7 @@ gdb_load_disassembly (ClientData clientD
client_data.map_arr = "map_array";
if (Tcl_UpVar (interp, "1", map_name, client_data.map_arr, 0) !=
TCL_OK) {
- Tcl_SetStringObj (result_ptr->obj_ptr, "Can't link map array.", -1);
+ gdbtk_set_result (interp, "Can't link map array.");
return TCL_ERROR;
}
@@ -2376,7 +2371,7 @@ gdb_loc (ClientData clientData, Tcl_Inte
if (sals.nelts != 1)
{
- Tcl_SetStringObj (result_ptr->obj_ptr, "Ambiguous line spec", -1);
+ gdbtk_set_result (interp, "Ambiguous line spec", -1);
return TCL_ERROR;
}
resolve_sal_pc (&sal);
@@ -2538,11 +2533,7 @@ gdb_set_mem (clientData, interp, objc, o
if (size < 0)
{
/* Error in input */
- char *res;
-
- xasprintf (&res, "Invalid hexadecimal input: \"0x%s\"", hexstr);
- Tcl_SetObjResult (interp, Tcl_NewStringObj (res, -1));
- free (res);
+ gdbtk_set_result (interp, "Invalid hexadecimal input: \"0x%s\"",
hexstr);
return TCL_ERROR;
}
@@ -2589,7 +2580,7 @@ gdb_get_mem (ClientData clientData, Tcl_
}
else if (size <= 0)
{
- Tcl_SetObjResult (interp, Tcl_NewStringObj ("Invalid size, must be >
0", -1));
+ gdbtk_set_result (interp, "Invalid size, must be > 0");
return TCL_ERROR;
}
@@ -2600,8 +2591,7 @@ gdb_get_mem (ClientData clientData, Tcl_
}
else if (nbytes <= 0)
{
- Tcl_SetObjResult (interp,
- Tcl_NewStringObj ("Invalid number of bytes, must be > 0", -1));
+ gdbtk_set_result (interp, "Invalid number of bytes, must be > 0");
return TCL_ERROR;
}
@@ -2612,8 +2602,7 @@ gdb_get_mem (ClientData clientData, Tcl_
}
else if (bpr <= 0)
{
- Tcl_SetObjResult (interp,
- Tcl_NewStringObj ("Invalid bytes per row, must be > 0", -1));
+ gdbtk_set_result (interp, "Invalid bytes per row, must be > 0");
return TCL_ERROR;
}
@@ -2623,7 +2612,7 @@ gdb_get_mem (ClientData clientData, Tcl_
mbuf = (char *) malloc (nbytes + 32);
if (!mbuf)
{
- Tcl_SetObjResult (interp, Tcl_NewStringObj ("Out of memory.", -1));
+ gdbtk_set_result (interp, "Out of memory.");
return TCL_ERROR;
}
@@ -2773,8 +2762,7 @@ gdb_loadfile (ClientData clientData, Tcl
if (!Tcl_GetCommandInfo (interp, widget, &text_cmd))
{
- Tcl_SetStringObj (result_ptr->obj_ptr, "Can't get widget command info",
- -1);
+ gdbtk_set_result (interp, "Can't get widget command info");
return TCL_ERROR;
}
@@ -2784,15 +2772,14 @@ gdb_loadfile (ClientData clientData, Tcl
symtab = full_lookup_symtab (file);
if (!symtab)
{
- Tcl_SetStringObj ( result_ptr->obj_ptr, "File not found in symtab",
-1);
+ gdbtk_set_result (interp, "File not found in symtab");
return TCL_ERROR;
}
file = symtab_to_filename ( symtab );
if ((fp = fopen ( file, "r" )) == NULL)
{
- Tcl_SetStringObj ( result_ptr->obj_ptr, "Can't open file for reading",
- -1);
+ gdbtk_set_result (interp, "Can't open file for reading");
return TCL_ERROR;
}
@@ -2823,8 +2810,8 @@ gdb_loadfile (ClientData clientData, Tcl
ltable = (char *)malloc (LTABLE_SIZE);
if (ltable == NULL)
{
- Tcl_SetStringObj ( result_ptr->obj_ptr, "Out of memory.", -1);
fclose (fp);
+ gdbtk_set_result (interp, "Out of memory.");
return TCL_ERROR;
}
@@ -2844,10 +2831,9 @@ gdb_loadfile (ClientData clientData, Tcl
ltable_size *= 2;
if (new_ltable == NULL)
{
- Tcl_SetStringObj ( result_ptr->obj_ptr, "Out of memory.",
- -1);
free (ltable);
fclose (fp);
+ gdbtk_set_result (interp, "Out of memory.");
return TCL_ERROR;
}
ltable = new_ltable;
Index: gdbtk-cmds.h
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/generic/gdbtk-cmds.h,v
retrieving revision 1.1
diff -u -p -r1.1 gdbtk-cmds.h
--- gdbtk-cmds.h 2001/05/10 18:04:23 1.1
+++ gdbtk-cmds.h 2001/10/29 20:13:55
@@ -50,6 +50,9 @@ extern char *pc_function_name (CORE_ADDR
a Tcl list object. */
extern void sprintf_append_element_to_obj (Tcl_Obj * objp, char *format,
...);
+/* printf-like function to return error messages */
+extern void gdbtk_set_result (Tcl_Interp *interp, const char *fmt,...);
+
/* Module init routines: Each module of commands should be declared here. */
extern int Gdbtk_Breakpoint_Init (Tcl_Interp *interp);
extern int Gdbtk_Stack_Init (Tcl_Interp *interp);
Index: gdbtk-stack.c
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/generic/gdbtk-stack.c,v
retrieving revision 1.4
diff -u -p -r1.4 gdbtk-stack.c
--- gdbtk-stack.c 2001/10/17 20:35:32 1.4
+++ gdbtk-stack.c 2001/10/29 20:13:55
@@ -101,7 +101,6 @@ gdb_block_vars (clientData, interp, objc
if (objc < 3)
{
Tcl_WrongNumArgs (interp, 1, objv, "startAddr endAddr");
- result_ptr->flags |= GDBTK_IN_TCL_RESULT;
return TCL_ERROR;
}
@@ -319,8 +318,7 @@ gdb_get_vars_command (clientData, interp
sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
if (sals.nelts == 0)
{
- Tcl_SetStringObj (result_ptr->obj_ptr,
- "error decoding line", -1);
+ gdbtk_set_result (interp, "error decoding line");
return TCL_ERROR;
}
@@ -479,7 +477,6 @@ gdb_stack (clientData, interp, objc, obj
if (objc < 3)
{
Tcl_WrongNumArgs (interp, 1, objv, "start count");
- result_ptr->flags |= GDBTK_IN_TCL_RESULT;
return TCL_ERROR;
}
Index: gdbtk-varobj.c
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/generic/gdbtk-varobj.c,v
retrieving revision 1.9
diff -u -p -r1.9 gdbtk-varobj.c
--- gdbtk-varobj.c 2001/10/17 20:35:32 1.9
+++ gdbtk-varobj.c 2001/10/29 20:13:55
@@ -510,11 +510,9 @@ variable_format (interp, objc, objv, var
varobj_set_display_format (var, FORMAT_OCTAL);
else
{
- Tcl_Obj *obj = Tcl_NewStringObj (NULL, 0);
- Tcl_AppendStringsToObj (obj, "unknown display format \"",
- fmt, "\": must be: \"natural\", \"binary\""
- ", \"decimal\", \"hexadecimal\", or \"octal\"", NULL);
- Tcl_SetObjResult (interp, obj);
+ gdbtk_set_result (interp, "unknown display format \"",
+ fmt, "\": must be: \"natural\", \"binary\""
+ ", \"decimal\", \"hexadecimal\", or \"octal\"");
return TCL_ERROR;
}
}
@@ -597,9 +595,7 @@ variable_value (interp, objc, objv, var)
s = Tcl_GetStringFromObj (objv[2], NULL);
if (!varobj_set_value (var, s))
{
- r = error_last_message ();
- Tcl_SetObjResult (interp, Tcl_NewStringObj (r, -1));
- FREEIF (r);
+ gdbtk_set_result (interp, "%s", error_last_message());
return TCL_ERROR;
}
}
Index: gdbtk.c
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/generic/gdbtk.c,v
retrieving revision 1.23
diff -u -p -r1.23 gdbtk.c
--- gdbtk.c 2001/10/04 15:01:35 1.23
+++ gdbtk.c 2001/10/29 20:13:55
@@ -751,3 +751,16 @@ tk_command (cmd, from_tty)
do_cleanups (old_chain);
}
+void
+gdbtk_set_result (Tcl_Interp *interp, const char *fmt,...)
+{
+ va_list args;
+ char *buf;
+
+ va_start (args, fmt);
+ xvasprintf (&buf, fmt, args);
+ va_end (args);
+ Tcl_SetObjResult (interp, Tcl_NewStringObj (buf, -1));
+ xfree(buf);
+}
+