diff options
| -rw-r--r-- | gdb/.Sanitize | 36 | ||||
| -rw-r--r-- | gdb/gdbtk.c | 52 |
2 files changed, 74 insertions, 14 deletions
diff --git a/gdb/.Sanitize b/gdb/.Sanitize index f4b5770..163f702 100644 --- a/gdb/.Sanitize +++ b/gdb/.Sanitize @@ -834,6 +834,42 @@ else done fi +# This is a temporary measure to sanitize out references to the +# startup code need by the TclPro debugger. When that goes out +# of alpha, we can remove this. + +if ( echo $* | grep keep\-tclpro > /dev/null ) ; then + for i in * ; do + if test ! -d $i && (grep sanitize-tclpro $i > /dev/null) ; then + echo Keeping \"tclpro\" stuff in $i, but editing out sanitize lines... + cp $i new + sed -e '/start\-sanitize\-tclpro/d' -e '/end\-sanitize\-tclpro/d' < $i > new + if [ -n "${safe}" -a ! -f .Recover/$i ] ; then + echo Caching $i in .Recover... + mv $i .Recover + fi + mv new $i + fi + done +else + for i in * ; do + if test ! -d $i && (grep sanitize-tclpro $i > /dev/null) ; then + if [ -n "${verbose}" ] ; then + echo Removing traces of \"tclpro\" from $i... + fi + cp $i new + sed '/start\-sanitize\-tclpro/,/end-\sanitize\-tclpro/d' < $i > new + if [ -n "${safe}" -a ! -f .Recover/$i ] ; then + if [ -n "${verbose}" ] ; then + echo Caching $i in .Recover... + fi + mv $i .Recover + fi + mv new $i + fi + done +fi + if ( echo $* | grep keep\-mswin > /dev/null ) ; then for i in * ; do if test ! -d $i && (grep sanitize-mswin $i > /dev/null) ; then diff --git a/gdb/gdbtk.c b/gdb/gdbtk.c index 4718e15..15e5ed1 100644 --- a/gdb/gdbtk.c +++ b/gdb/gdbtk.c @@ -1338,17 +1338,16 @@ call_obj_wrapper (clientData, interp, objc, objv) running_now = 0; Tcl_Eval (interp, "gdbtk_tcl_idle"); - - - /* if the error message is in RESULT instead of ERROR_STRING we copy it - back to ERROR_STRING and free RESULT */ - - if ((Tcl_DStringLength (&error_string) == 0) && (Tcl_DStringLength (&result) > 0)) - { - Tcl_DStringAppend (&error_string, Tcl_DStringValue (&result), Tcl_DStringLength (&result)); - Tcl_DStringFree (&result); - } - + /* if the error message is in RESULT instead of ERROR_STRING we copy it + back to ERROR_STRING and free RESULT */ + + if ((Tcl_DStringLength (&error_string) == 0) && + (Tcl_DStringLength (&result) > 0)) + { + Tcl_DStringAppend (&error_string, Tcl_DStringValue (&result), + Tcl_DStringLength (&result)); + Tcl_DStringFree (&result); + } } /* do not suppress any errors -- a remote target could have errored */ @@ -2454,8 +2453,27 @@ gdbtk_find_main"; fputs_unfiltered_hook = gdbtk_fputs; - if (Tcl_EvalFile (interp, gdbtk_file) != TCL_OK) - { +/* start-sanitize-tclpro */ +#ifdef TCLPRO_DEBUGGER + { + Tcl_DString source_cmd; + + Tcl_DStringInit (&source_cmd); + Tcl_DStringAppend (&source_cmd, + "if {[info exists env(TCLPRO_DEBUG_DIR)]} {source [file join $env(TCLPRO_DEBUG_DIR) src loader.tcl];", -1); + Tcl_DStringAppend (&source_cmd, "debugger_init; debugger_eval {source {", -1); + Tcl_DStringAppend (&source_cmd, gdbtk_file, -1); + Tcl_DStringAppend (&source_cmd, "}}} else {source {", -1); + Tcl_DStringAppend (&source_cmd, gdbtk_file, -1); + Tcl_DStringAppend (&source_cmd, "}}", -1); + if (Tcl_GlobalEval (interp, Tcl_DStringValue (&source_cmd)) != TCL_OK) +#else +/* end-sanitize-tclpro */ + if (Tcl_EvalFile (interp, gdbtk_file) != TCL_OK) +/* start-sanitize-tclpro */ +#endif +/* end-sanitize-tclpro */ + { char *msg; /* Force errorInfo to be set up propertly. */ @@ -2473,7 +2491,13 @@ gdbtk_find_main"; error (""); } - +/* start-sanitize-tclpro */ +#ifdef TCLPRO_DEBUGGER + Tcl_DStringFree(&source_cmd); + } +#endif +/* end-sanitize-tclpro */ + #ifdef IDE /* start-sanitize-ide */ /* Don't do this until we have initialized. Otherwise, we may get a |