diff options
Diffstat (limited to 'tests/init.test')
| -rw-r--r-- | tests/init.test | 88 |
1 files changed, 33 insertions, 55 deletions
diff --git a/tests/init.test b/tests/init.test index 4e9f8bb..41b8382 100644 --- a/tests/init.test +++ b/tests/init.test @@ -1,16 +1,16 @@ -# Functionality covered: this file contains a collection of tests for the -# auto loading and namespaces. +# Functionality covered: this file contains a collection of tests for the auto +# loading and namespaces. # -# Sourcing this file into Tcl runs the tests and generates output for -# errors. No output means no errors were found. +# Sourcing this file into Tcl runs the tests and generates output for errors. +# No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: init.test,v 1.18 2007/12/13 15:26:06 dgp Exp $ +# RCS: @(#) $Id: init.test,v 1.19 2009/07/25 22:00:10 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -19,45 +19,36 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # Clear out any namespaces called test_ns_* catch {namespace delete {*}[namespace children :: test_ns_*]} - + # Six cases - white box testing test init-1.1 {auto_qualify - absolute cmd - namespace} { auto_qualify ::foo::bar ::blue } ::foo::bar - test init-1.2 {auto_qualify - absolute cmd - global} { auto_qualify ::global ::sub } global - test init-1.3 {auto_qualify - no colons cmd - global} { auto_qualify nocolons :: } nocolons - test init-1.4 {auto_qualify - no colons cmd - namespace} { auto_qualify nocolons ::sub } {::sub::nocolons nocolons} - test init-1.5 {auto_qualify - colons in cmd - global} { auto_qualify foo::bar :: } ::foo::bar - test init-1.6 {auto_qualify - colons in cmd - namespace} { auto_qualify foo::bar ::sub } {::sub::foo::bar ::foo::bar} - # Some additional tests - test init-1.7 {auto_qualify - multiples colons 1} { auto_qualify :::foo::::bar ::blue } ::foo::bar - test init-1.8 {auto_qualify - multiple colons 2} { auto_qualify :::foo ::bar } foo - - -# we use a sub interp and auto_reset and double the tests because there is 2 + +# We use a sub-interp and auto_reset and double the tests because there is 2 # places where auto_loading occur (before loading the indexes files and after) set testInterp [interp create] @@ -69,63 +60,48 @@ interp eval $testInterp { auto_reset catch {rename parray {}} - + test init-2.0 {load parray - stage 1} { set ret [catch {parray} error] - rename parray {} ; # remove it, for the next test - that should not fail. + rename parray {} ;# remove it, for the next test - that should not fail. list $ret $error } {1 {wrong # args: should be "parray a ?pattern?"}} - - test init-2.1 {load parray - stage 2} { set ret [catch {parray} error] list $ret $error } {1 {wrong # args: should be "parray a ?pattern?"}} - - auto_reset catch {rename ::safe::setLogCmd {}} #unset auto_index(::safe::setLogCmd) #unset auto_oldpath - test init-2.2 {load ::safe::setLogCmd - stage 1} { ::safe::setLogCmd - rename ::safe::setLogCmd {} ; # should not fail + rename ::safe::setLogCmd {} ;# should not fail } {} - test init-2.3 {load ::safe::setLogCmd - stage 2} { ::safe::setLogCmd - rename ::safe::setLogCmd {} ; # should not fail + rename ::safe::setLogCmd {} ;# should not fail } {} - auto_reset catch {rename ::safe::setLogCmd {}} - test init-2.4 {load safe:::setLogCmd - stage 1} { - safe:::setLogCmd ; # intentionally 3 : - rename ::safe::setLogCmd {} ; # should not fail + safe:::setLogCmd ;# intentionally 3 : + rename ::safe::setLogCmd {} ;# should not fail } {} - test init-2.5 {load safe:::setLogCmd - stage 2} { - safe:::setLogCmd ; # intentionally 3 : - rename ::safe::setLogCmd {} ; # should not fail + safe:::setLogCmd ;# intentionally 3 : + rename ::safe::setLogCmd {} ;# should not fail } {} - auto_reset catch {rename ::safe::setLogCmd {}} - test init-2.6 {load setLogCmd from safe:: - stage 1} { namespace eval safe setLogCmd - rename ::safe::setLogCmd {} ; # should not fail + rename ::safe::setLogCmd {} ;# should not fail } {} - test init-2.7 {oad setLogCmd from safe:: - stage 2} { namespace eval safe setLogCmd - rename ::safe::setLogCmd {} ; # should not fail + rename ::safe::setLogCmd {} ;# should not fail } {} - - - test init-2.8 {load tcl::HistAdd} -setup { auto_reset catch {rename ::tcl::HistAdd {}} @@ -133,20 +109,19 @@ test init-2.8 {load tcl::HistAdd} -setup { # 3 ':' on purpose list [catch {tcl:::HistAdd} error] $error } -cleanup { - rename ::tcl::HistAdd {} ; -} -result {1 {wrong # args: should be "tcl:::HistAdd command ?exec?"}} - - + rename ::tcl::HistAdd {} +} -result {1 {wrong # args: should be "tcl:::HistAdd event ?exec?"}} + test init-3.0 {random stuff in the auto_index, should still work} { set auto_index(foo:::bar::blah) { namespace eval foo {namespace eval bar {proc blah {} {return 1}}} } foo:::bar::blah } 1 - -# Tests that compare the error stack trace generated when autoloading -# with that generated when no autoloading is necessary. Ideally they -# should be the same. + +# Tests that compare the error stack trace generated when autoloading with +# that generated when no autoloading is necessary. Ideally they should be the +# same. set count 0 foreach arg [subst -nocommands -novariables { @@ -180,7 +155,6 @@ foreach arg [subst -nocommands -novariables { set second $::errorInfo string equal $first $second } 1 - test init-4.$count.1 {::errorInfo produced by [unknown]} { auto_reset namespace eval junk [list array set $arg [list 1 2 3 4]] @@ -195,7 +169,7 @@ foreach arg [subst -nocommands -novariables { incr count } - + test init-5.0 {return options passed through ::unknown} -setup { catch {rename xxx {}} set ::auto_index(::xxx) {proc ::xxx {} { @@ -208,7 +182,7 @@ test init-5.0 {return options passed through ::unknown} -setup { } -cleanup { unset ::auto_index(::xxx) } -result {2 xxx {-errorcode NONE -code 1 -level 1} 2 xxx {-code 1 -level 1 -errorcode NONE}} - + cleanupTests } ;# End of [interp eval $testInterp] @@ -217,3 +191,7 @@ interp delete $testInterp ::tcltest::cleanupTests return +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: |