diff options
| author | Ben Elliston <bje@gnu.org> | 2011-03-03 00:06:01 +1100 |
|---|---|---|
| committer | Ben Elliston <bje@gnu.org> | 2011-03-03 00:06:18 +1100 |
| commit | 9dc6ca1204a51cab84c2a98d902d06f7d2ca426f (patch) | |
| tree | 8b4c419315b75d300e3db1d9aa16fe0c703dd3fa | |
| parent | 119f94fff1cf10945c8df44b903c2ff430107e68 (diff) | |
| download | dejagnu-9dc6ca1204a51cab84c2a98d902d06f7d2ca426f.zip dejagnu-9dc6ca1204a51cab84c2a98d902d06f7d2ca426f.tar.gz dejagnu-9dc6ca1204a51cab84c2a98d902d06f7d2ca426f.tar.bz2 | |
* lib/framework.exp (unknown): Rename the native Tcl ::unknown
proc to ::tcl_unknown. If ::tcl_unknown returns a failure result,
then fall back to the conventional DejaGnu handling. Report from
David Byron <dbyron@dbyron.com>.
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | lib/framework.exp | 31 |
2 files changed, 25 insertions, 13 deletions
@@ -1,3 +1,10 @@ +2011-03-03 Ben Elliston <bje@gnu.org> + + * lib/framework.exp (unknown): Rename the native Tcl ::unknown + proc to ::tcl_unknown. If ::tcl_unknown returns a failure result, + then fall back to the conventional DejaGnu handling. Report from + David Byron <dbyron@dbyron.com>. + 2011-03-03 Maciej W. Rozycki <macro@codesourcery.com> * lib/remote.exp (remote_expect): Pass all exception conditions up diff --git a/lib/framework.exp b/lib/framework.exp index ca672a0..b7b5c48 100644 --- a/lib/framework.exp +++ b/lib/framework.exp @@ -259,21 +259,26 @@ proc isnative { } { # unknown -- called by expect if a proc is called that doesn't exist # -proc unknown { args } { - global errorCode - global errorInfo - global exit_status +# Rename unknown to tcl_unknown so that we can wrap tcl_unknown. +# This allows Tcl package autoloading to work in the modern age. - clone_output "ERROR: (DejaGnu) proc \"$args\" does not exist." - if {[info exists errorCode]} { - send_error "The error code is $errorCode\n" - } - if {[info exists errorInfo]} { - send_error "The info on the error is:\n$errorInfo\n" - } +rename ::unknown ::tcl_unknown +proc unknown args { + if {[catch {uplevel 1 ::tcl_unknown $args} msg]} { + global errorCode + global errorInfo + global exit_status - set exit_status 1 - log_and_exit + clone_output "ERROR: (DejaGnu) proc \"$args\" does not exist." + if {[info exists errorCode]} { + send_error "The error code is $errorCode\n" + } + if {[info exists errorInfo]} { + send_error "The info on the error is:\n$errorInfo\n" + } + set exit_status 1 + log_and_exit + } } # Print output to stdout (or stderr) and to log file |