sl@0: # Functionality covered: this file contains a collection of tests for the
sl@0: # auto loading and namespaces.
sl@0: #
sl@0: # Sourcing this file into Tcl runs the tests and generates output for
sl@0: # errors. No output means no errors were found.
sl@0: #
sl@0: # Copyright (c) 1997 Sun Microsystems, Inc.
sl@0: # Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0: #
sl@0: # See the file "license.terms" for information on usage and redistribution
sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0: #
sl@0: # RCS: @(#) $Id: init.test,v 1.9.2.2 2004/10/26 20:14:36 dgp Exp $
sl@0: 
sl@0: if {[lsearch [namespace children] ::tcltest] == -1} {
sl@0:     package require tcltest
sl@0:     namespace import -force ::tcltest::*
sl@0: }
sl@0: 
sl@0: # Clear out any namespaces called test_ns_*
sl@0: catch {eval namespace delete [namespace children :: test_ns_*]}
sl@0: 
sl@0: # Six cases - white box testing
sl@0: 
sl@0: test init-1.1 {auto_qualify - absolute cmd - namespace} {
sl@0:     auto_qualify ::foo::bar ::blue
sl@0: } ::foo::bar
sl@0: 
sl@0: test init-1.2 {auto_qualify - absolute cmd - global} {
sl@0:     auto_qualify ::global ::sub
sl@0: } global
sl@0: 
sl@0: test init-1.3 {auto_qualify - no colons cmd - global} {
sl@0:     auto_qualify nocolons ::
sl@0: } nocolons 
sl@0: 
sl@0: test init-1.4 {auto_qualify - no colons cmd - namespace} {
sl@0:     auto_qualify nocolons ::sub
sl@0: } {::sub::nocolons nocolons}
sl@0: 
sl@0: test init-1.5 {auto_qualify - colons in cmd - global} {
sl@0:     auto_qualify foo::bar ::
sl@0: } ::foo::bar
sl@0: 
sl@0: test init-1.6 {auto_qualify - colons in cmd - namespace} {
sl@0:     auto_qualify foo::bar ::sub
sl@0: } {::sub::foo::bar ::foo::bar}
sl@0: 
sl@0: # Some additional tests
sl@0: 
sl@0: test init-1.7 {auto_qualify - multiples colons 1} {
sl@0:     auto_qualify :::foo::::bar ::blue
sl@0: } ::foo::bar
sl@0: 
sl@0: test init-1.8 {auto_qualify - multiple colons 2} {
sl@0:     auto_qualify :::foo ::bar
sl@0: } foo
sl@0: 
sl@0: 
sl@0: # we use a sub interp and auto_reset and double the tests because there is 2
sl@0: # places where auto_loading occur (before loading the indexes files and after)
sl@0: 
sl@0: set testInterp [interp create]
sl@0: interp eval $testInterp [list set argv $argv]
sl@0: interp eval $testInterp [list package require tcltest]
sl@0: interp eval $testInterp [list namespace import -force ::tcltest::*]
sl@0: 
sl@0: interp eval $testInterp {
sl@0: 
sl@0: auto_reset
sl@0: catch {rename parray {}}
sl@0: 
sl@0: test init-2.0 {load parray - stage 1} {
sl@0:     set ret [catch {parray} error]
sl@0:     rename parray {} ; # remove it, for the next test - that should not fail.
sl@0:     list $ret $error
sl@0: } {1 {wrong # args: should be "parray a ?pattern?"}}
sl@0: 
sl@0: 
sl@0: test init-2.1 {load parray - stage 2} {
sl@0:     set ret [catch {parray} error]
sl@0:     list $ret $error
sl@0: } {1 {wrong # args: should be "parray a ?pattern?"}}
sl@0: 
sl@0: 
sl@0: auto_reset
sl@0: catch {rename ::safe::setLogCmd {}}
sl@0: #unset auto_index(::safe::setLogCmd)
sl@0: #unset auto_oldpath
sl@0: 
sl@0: test init-2.2 {load ::safe::setLogCmd - stage 1} {
sl@0:     ::safe::setLogCmd
sl@0:     rename ::safe::setLogCmd {} ; # should not fail
sl@0: } {}
sl@0: 
sl@0: test init-2.3 {load ::safe::setLogCmd - stage 2} {
sl@0:     ::safe::setLogCmd
sl@0:     rename ::safe::setLogCmd {} ; # should not fail
sl@0: } {}
sl@0: 
sl@0: auto_reset
sl@0: catch {rename ::safe::setLogCmd {}}
sl@0: 
sl@0: test init-2.4 {load safe:::setLogCmd - stage 1} {
sl@0:     safe:::setLogCmd ; # intentionally 3 :
sl@0:     rename ::safe::setLogCmd {} ; # should not fail
sl@0: } {}
sl@0: 
sl@0: test init-2.5 {load safe:::setLogCmd - stage 2} {
sl@0:     safe:::setLogCmd ; # intentionally 3 :
sl@0:     rename ::safe::setLogCmd {} ; # should not fail
sl@0: } {}
sl@0: 
sl@0: auto_reset
sl@0: catch {rename ::safe::setLogCmd {}}
sl@0: 
sl@0: test init-2.6 {load setLogCmd from safe:: - stage 1} {
sl@0:     namespace eval safe setLogCmd 
sl@0:     rename ::safe::setLogCmd {} ; # should not fail
sl@0: } {}
sl@0: 
sl@0: test init-2.7 {oad setLogCmd from safe::  - stage 2} {
sl@0:     namespace eval safe setLogCmd 
sl@0:     rename ::safe::setLogCmd {} ; # should not fail
sl@0: } {}
sl@0: 
sl@0: 
sl@0: 
sl@0: test init-2.8 {load tcl::HistAdd} -setup {
sl@0:     auto_reset
sl@0:     catch {rename ::tcl::HistAdd {}}
sl@0: } -body {
sl@0:     # 3 ':' on purpose
sl@0:     list [catch {tcl:::HistAdd} error] $error
sl@0: } -cleanup {
sl@0:     rename ::tcl::HistAdd {} ; 
sl@0: } -result {1 {wrong # args: should be "tcl:::HistAdd command ?exec?"}}
sl@0: 
sl@0: 
sl@0: test init-3.0 {random stuff in the auto_index, should still work} {
sl@0:     set auto_index(foo:::bar::blah) {
sl@0:         namespace eval foo {namespace eval bar {proc blah {} {return 1}}}
sl@0:     }
sl@0:     foo:::bar::blah
sl@0: } 1
sl@0: 
sl@0: # Tests that compare the error stack trace generated when autoloading
sl@0: # with that generated when no autoloading is necessary.  Ideally they
sl@0: # should be the same.
sl@0: 
sl@0: set count 0
sl@0: foreach arg [subst -nocommands -novariables {
sl@0: 		c
sl@0:                 {argument
sl@0:                 which spans
sl@0:                 multiple lines}
sl@0:                 {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack}
sl@0:                 {argument which spans multiple lines
sl@0:                 and is long enough to be truncated and
sl@0: "               <- includes a false lead in the prune point search
sl@0:                 and must be longer still to force truncation}
sl@0:                 {contrived example: rare circumstance 
sl@0: 		where the point at which to prune the
sl@0: 		error stack cannot be uniquely determined.
sl@0: 		foo bar foo
sl@0: "}
sl@0:                 {contrived example: rare circumstance 
sl@0: 		where the point at which to prune the
sl@0: 		error stack cannot be uniquely determined.
sl@0: 		foo bar
sl@0: "}
sl@0: 		{argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
sl@0: 	}] {
sl@0: 
sl@0:     test init-4.$count.0 {::errorInfo produced by [unknown]} {
sl@0: 	auto_reset
sl@0: 	catch {parray a b $arg}
sl@0: 	set first $::errorInfo
sl@0: 	catch {parray a b $arg}
sl@0: 	set second $::errorInfo
sl@0: 	string equal $first $second
sl@0:     } 1
sl@0: 
sl@0:     test init-4.$count.1 {::errorInfo produced by [unknown]} {
sl@0: 	auto_reset
sl@0: 	namespace eval junk [list array set $arg [list 1 2 3 4]]
sl@0: 	trace variable ::junk::$arg r \
sl@0: 		"[list error [subst {Variable \"$arg\" is write-only}]] ;# "
sl@0: 	catch {parray ::junk::$arg}
sl@0: 	set first $::errorInfo
sl@0: 	catch {parray ::junk::$arg}
sl@0: 	set second $::errorInfo
sl@0: 	string equal $first $second
sl@0:     } 1
sl@0: 
sl@0:     incr count
sl@0: }
sl@0: 
sl@0: cleanupTests
sl@0: }	;#  End of [interp eval $testInterp]
sl@0: 
sl@0: # cleanup
sl@0: interp delete $testInterp
sl@0: ::tcltest::cleanupTests
sl@0: return
sl@0: