From fa839dce12c20b16a8736752fd93063afc2c6446 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 18 Jan 2006 19:48:11 +0000 Subject: Fix test suite bugs exposed by -singleproc 1 -debug 1 run. Each test file needs to avoid stomping on the assumptions of other files, and protect against getting stomped as well. --- tests/basic.test | 18 +++++++++++++----- tests/dict.test | 4 ++-- tests/error.test | 4 ++-- tests/eval.test | 6 +++--- tests/interp.test | 4 +++- tests/namespace.test | 5 ++++- 6 files changed, 27 insertions(+), 14 deletions(-) diff --git a/tests/basic.test b/tests/basic.test index 2dc628d..ec6ad18 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -15,7 +15,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: basic.test,v 1.40 2005/05/10 18:34:56 kennykb Exp $ +# RCS: @(#) $Id: basic.test,v 1.41 2006/01/18 19:48:11 dgp Exp $ # package require tcltest 2 @@ -438,7 +438,7 @@ test basic-26.1 {Tcl_EvalObj: preserve object while evaling it} -setup { rename myHandler {} } -result "foo\n while executing\n\"error foo\"" -test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} { +test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body { # # Follow the pure-list branch in a manner that # a - the pure-list internal rep is destroyed by shimmering @@ -455,9 +455,13 @@ test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} { error "BAD CALL" } catch {eval $SRC} -} 1 +} -result 1 -cleanup { + rename foo {} + rename $::SRC {} + unset ::SRC +} -test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} { +test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body { # # Follow the pure-list branch in a manner that # a - the pure-list internal rep is destroyed by shimmering @@ -473,7 +477,11 @@ test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} { info level 0 } catch {eval $SRC} -} 0 +} -result 0 -cleanup { + rename foo {} + rename $::SRC {} + unset ::SRC +} test basic-27.1 {Tcl_ExprLong} {emptyTest} { } {} diff --git a/tests/dict.test b/tests/dict.test index 1f8e310..79bce48 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: dict.test,v 1.17 2005/12/18 22:42:18 dkf Exp $ +# RCS: @(#) $Id: dict.test,v 1.18 2006/01/18 19:48:11 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -551,7 +551,7 @@ test dict-14.17 {dict for command in compilation context} { } dicttest } {a 0} -test dict-14.17 {dict for command in compilation context} { +test dict-14.18 {dict for command in compilation context} { # Bug 1382528 proc dicttest {} { dict for {k v} {} {} ;# Note empty dict diff --git a/tests/error.test b/tests/error.test index d8bfaba..9f55de8 100644 --- a/tests/error.test +++ b/tests/error.test @@ -11,13 +11,14 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: error.test,v 1.14 2006/01/11 17:34:54 dgp Exp $ +# RCS: @(#) $Id: error.test,v 1.15 2006/01/18 19:48:11 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } +namespace eval ::tcl::test::error { proc foo {} { global errorInfo set a [catch {format [error glorp2]} b] @@ -220,7 +221,6 @@ test error-6.9 {catch must reset error state} { list $errorCode } {NONE} -namespace eval ::tcl::test::error { test error-7.0 {Bug 1397843} -body { variable cmds proc EIWrite args { diff --git a/tests/eval.test b/tests/eval.test index eefa96f..a068c1b 100644 --- a/tests/eval.test +++ b/tests/eval.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: eval.test,v 1.7 2005/09/06 14:40:11 dkf Exp $ +# RCS: @(#) $Id: eval.test,v 1.8 2006/01/18 19:48:11 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -68,7 +68,7 @@ test eval-3.3 {eval and canonical lists} { set cmd [list list 1 2 3 4 5] # Force existance of utf-8 rep set dummy($cmd) $cmd - unset dummy($cmd) + unset dummy eval $cmd } {1 2 3 4 5} test eval-3.4 {concatenating eval and canonical lists} { @@ -77,7 +77,7 @@ test eval-3.4 {concatenating eval and canonical lists} { # Force existance of utf-8 rep set dummy($cmd) $cmd set dummy($cmd2) $cmd2 - unset dummy($cmd) dummy($cmd2) + unset dummy eval $cmd $cmd2 } {1 2 3 4 5} diff --git a/tests/interp.test b/tests/interp.test index d2acbdd..94657e2 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: interp.test,v 1.47 2005/10/10 17:33:26 dkf Exp $ +# RCS: @(#) $Id: interp.test,v 1.48 2006/01/18 19:48:11 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -1724,6 +1724,7 @@ test interp-24.1 {result resetting on error} { set l }] interp delete a + rename foo {} set l } {1 {1 2 3} 1 {3 4 5}} test interp-24.2 {result resetting on error} { @@ -1740,6 +1741,7 @@ test interp-24.2 {result resetting on error} { set l }] interp delete a + rename foo {} set l } {1 {1 2 3} 1 {3 4 5}} test interp-24.3 {result resetting on error} { diff --git a/tests/namespace.test b/tests/namespace.test index c198a48..83cad11 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: namespace.test,v 1.50 2006/01/09 18:35:01 dgp Exp $ +# RCS: @(#) $Id: namespace.test,v 1.51 2006/01/18 19:48:11 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -2353,6 +2353,9 @@ test namespace-51.13 {name resolution path control} -body { catch {namespace delete ::test_ns_4} } test namespace-51.14 {name resolution path control} -body { + foreach cmd [info commands foo*] { + rename $cmd {} + } proc foo0 {} {} namespace eval ::test_ns_1 { proc foo1 {} {} -- cgit v0.12