From 8eff1374bfc6abe25533fb6e80fc95490ca6d1cf Mon Sep 17 00:00:00 2001 From: Keith Seitz Date: Thu, 3 May 2001 18:13:21 +0000 Subject: [PATCH] * gdbtk.c (gdbtk_init): Include the command "warp_pointer" for all platforms. Used for testing ONLY. * util.tcl (gdbtk_read_defs): If there is an error reading the testsuite definition file, print the error message to stderr, not stdout. This will allow tcl to know that an error has occurred. (find_iwidgets_library): Make it work for running testsuites from installed directory. * main.tcl: If we failed to find iwidgets, check if the testsuite is running. If it is running, do not pop up a dialog box: just print out the error and exit. Initialize _test(verbose) for the testsuite. --- gdb/gdbtk/ChangeLog | 17 +++++++++++++++++ gdb/gdbtk/generic/gdbtk.c | 7 ++++--- gdb/gdbtk/library/main.tcl | 14 ++++++++++---- gdb/gdbtk/library/util.tcl | 17 +++++++++++++---- 4 files changed, 44 insertions(+), 11 deletions(-) diff --git a/gdb/gdbtk/ChangeLog b/gdb/gdbtk/ChangeLog index 21d76cd069..9c2ed246ba 100644 --- a/gdb/gdbtk/ChangeLog +++ b/gdb/gdbtk/ChangeLog @@ -1,3 +1,20 @@ +2001-05-01 Keith Seitz + + * gdbtk.c (gdbtk_init): Include the command "warp_pointer" + for all platforms. Used for testing ONLY. + + * util.tcl (gdbtk_read_defs): If there is an error reading + the testsuite definition file, print the error message to + stderr, not stdout. This will allow tcl to know that an error + has occurred. + (find_iwidgets_library): Make it work for running testsuites + from installed directory. + + * main.tcl: If we failed to find iwidgets, check if the + testsuite is running. If it is running, do not pop up + a dialog box: just print out the error and exit. + Initialize _test(verbose) for the testsuite. + 2001-04-23 Keith Seitz * generic/gdbtk-cmds.c (gdb_get_breakpoint_info): If unable diff --git a/gdb/gdbtk/generic/gdbtk.c b/gdb/gdbtk/generic/gdbtk.c index 50027be5da..d68e214b15 100644 --- a/gdb/gdbtk/generic/gdbtk.c +++ b/gdb/gdbtk/generic/gdbtk.c @@ -462,11 +462,12 @@ gdbtk_init (argv0) error ("cygwin path command initialization failed"); if (ide_create_shell_execute_command (gdbtk_interp) != TCL_OK) error ("cygwin shell execute command initialization failed"); -#else - /* for now, this testing function is Unix only */ +#endif + + /* Only for testing -- and only when it can't be done any + other way. */ if (cyg_create_warp_pointer_command (gdbtk_interp) != TCL_OK) error ("warp_pointer command initialization failed"); -#endif /* * This adds all the Gdbtk commands. diff --git a/gdb/gdbtk/library/main.tcl b/gdb/gdbtk/library/main.tcl index 29fabc87d3..e6e532e727 100644 --- a/gdb/gdbtk/library/main.tcl +++ b/gdb/gdbtk/library/main.tcl @@ -59,10 +59,13 @@ namespace import itcl::* namespace import debug::* if {![find_iwidgets_library]} { - tk_messageBox -title Error -message "Could not find the Iwidgets libraries. -Got nameofexec: [info nameofexecutable] -Error(s) were: \n$errMsg" \ - -icon error -type ok + set msg "Could not find the Iwidgets libraries.\n\nGot nameofexec: [info nameofexecutable]\nError(s) were: \n$errMsg" + + if {![info exists ::env(GDBTK_TEST_RUNNING)] || $::env(GDBTK_TEST_RUNNING) == 0} { + puts stderr $msg + } else { + tk_messageBox -title Error -message $msg -icon error -type ok + } exit } @@ -103,6 +106,9 @@ if {$tcl_platform(platform) == "unix"} { tix resetoptions TixGray [tix cget -fontset] } +# For testing +set _test(interactive) 0 + # initialize state variables initialize_gdbtk diff --git a/gdb/gdbtk/library/util.tcl b/gdb/gdbtk/library/util.tcl index 5d32e040d7..495e71eef1 100644 --- a/gdb/gdbtk/library/util.tcl +++ b/gdb/gdbtk/library/util.tcl @@ -154,7 +154,7 @@ proc gdbtk_read_defs {} { tk_messageBox -icon error -message "Cannot load defs file:\n$errTxt" -type ok return 0 } else { - puts stdout "cannot load defs files: $errTxt\ntry setting DEFS" + puts stderr "cannot load defs files: $errTxt\ntry setting DEFS" exit 1 } } @@ -259,11 +259,20 @@ proc find_iwidgets_library {} { set iwidgetsBuildDir [glob -nocomplain [file join \ [file dirname $exec_name] \ itcl iwidgets*]] - + set initFile [file join [lindex $iwidgetsBuildDir 0] \ + unix iwidgets.tcl] + + if {[llength $iwidgetsBuildDir] == 0} { + # We could be runnning on an installed toolchain. + # Check in "normal" installed place: "../../share/iwidgets*" + set iwidgetsBuildDir [glob -nocomplain [file join \ + [file dirname [file dirname $exec_name]] \ + share iwidgets*]] + set initFile [file join [lindex $iwidgetsBuildDir 0] iwidgets.tcl] + } + if {[llength $iwidgetsSrcDir] == 1 && [llength $iwidgetsBuildDir] == 1} { # The lindex is necessary because the path may have spaces in it... - set initFile [file join [lindex $iwidgetsBuildDir 0] \ - $::tcl_platform(platform) iwidgets.tcl] set libDir [file join [lindex $iwidgetsSrcDir 0] generic] if {[file exists $initFile] && [file isdirectory $libDir]} { if {![catch {source $initFile} err]} { -- 2.11.0