imported Itcl 3.3ITCL_3_3

18 files changed, 139 insertions, 205 deletions

diff --git a/itcl/itcl/tests/all.tcl b/itcl/itcl/tests/all.tcl
index ddefa468dd7..3f36351e2f1 100644
--- a/itcl/itcl/tests/all.tcl
+++ b/itcl/itcl/tests/all.tcl
@@ -9,114 +9,9 @@
 # 
 # RCS: @(#) $Id$
 
-package require tcltest
-namespace import -force ::tcltest::*
+package require tcltest 2.1
 
-# Look for the -exedir flag and find a suitable tclsh executable.
+tcltest::testsDirectory [file dir [info script]]
+tcltest::runAllTests
 
-if {(![info exists argv]) || ([llength $argv] < 1)} {
-    set flagArray {}
-} else {
-    set flagArray $argv
-}
-
-array set flag $flagArray
-if {[info exists flag(-exedir)]} {
-    set shell [lindex \
-	    [glob -nocomplain \
-	    [file join $flag(-exedir) tclsh*.bin] \
-	    [file join $flag(-exedir) tclsh*]] 0]
-} else {
-    set shell $::tcltest::tcltest
-}
-
-set ::tcltest::testSingleFile false
-
-# use [pwd] trick to expand relative file paths to absolute paths - MMc
-set cwd [pwd]
-cd [file dirname [info script]]
-set ::tcltest::testsDirectory [pwd]
-cd $cwd
-
-set logfile [file join $::tcltest::temporaryDirectory Log.txt]
-
-puts stdout "Using interp: $shell"
-puts stdout "Running tests in working dir: $::tcltest::testsDirectory"
-if {[llength $::tcltest::skip] > 0} {
-    puts stdout "Skipping tests that match:  $::tcltest::skip"
-}
-if {[llength $::tcltest::match] > 0} {
-    puts stdout "Only running tests that match:  $::tcltest::match"
-}
-
-if {[llength $::tcltest::skipFiles] > 0} {
-    puts stdout "Skipping test files that match:  $::tcltest::skipFiles"
-}
-if {[llength $::tcltest::matchFiles] > 0} {
-    puts stdout "Only sourcing test files that match:  $::tcltest::matchFiles"
-}
-
-set timeCmd {clock format [clock seconds]}
-puts stdout "Tests began at [eval $timeCmd]"
-
-# source each of the specified tests
-foreach file [lsort [::tcltest::getMatchingFiles]] {
-    set tail [file tail $file]
-    puts stdout $tail
-
-    # Change to the tests directory so the value of the following
-    # variable is set correctly when we spawn the child test processes
-
-    cd $::tcltest::testsDirectory
-    set cmd [concat [list | $shell $file] [split $argv] \
-	    [list -outfile $logfile]]
-    if {[catch {
-	set pipeFd [open $cmd "r"] 
-	while {[gets $pipeFd line] >= 0} {
-	    puts $::tcltest::outputChannel $line
-	}
-	close $pipeFd
-    } msg]} {
-	# Print results to ::tcltest::outputChannel.
-	puts $::tcltest::outputChannel $msg
-    }
-
-    # Now concatenate the temporary log file to
-    # ::tcltest::outputChannel 
-    if {[catch {
-	set fd [open $logfile "r"]
-	while {![eof $fd]} {
-	    gets $fd line
-	    if {![eof $fd]} {
-		if {[regexp {^([^:]+):\tTotal\t([0-9]+)\tPassed\t([0-9]+)\tSkipped\t([0-9]+)\tFailed\t([0-9]+)} $line null testFile Total Passed Skipped Failed]} {
-		    foreach index [list "Total" "Passed" "Skipped" \
-			    "Failed"] {
-			incr ::tcltest::numTests($index) [set $index]
-		    }
-		    incr ::tcltest::numTestFiles
-		    if {$Failed > 0} {
-			lappend ::tcltest::failFiles $testFile
-		    }
-		}
-		puts $::tcltest::outputChannel $line
-	    }
-	}
-	close $fd
-    } msg]} {
-	puts $::tcltest::outputChannel $msg
-    }
-}
-
-set numFailures [llength $::tcltest::failFiles]
-
-# cleanup
-puts stdout "\nTests ended at [eval $timeCmd]"
-::tcltest::cleanupTests 1
-
-if {$numFailures > 0} {
-    return -code error -errorcode $numFailures \
-	    -errorinfo "Found $numFailures test file failures"
-} else {
-    return
-}
-exit
+return
diff --git a/itcl/itcl/tests/basic.test b/itcl/itcl/tests/basic.test
index c60054644f6..ae5d83a0235 100644
--- a/itcl/itcl/tests/basic.test
+++ b/itcl/itcl/tests/basic.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-package require Itcl
+::tcltest::loadTestedCommands
 
 # ----------------------------------------------------------------------
 #  Simple class definition
@@ -94,6 +94,33 @@ test basic-1.11 {find command supports object names starting with -} {
     Counter -foo
     itcl::find objects -class Counter -foo
 } {-foo}
+test basic-1.12 {is command with class argument} {
+    itcl::is class Counter
+} {1}
+
+test basic-1.13 {is command with class argument (global namespace)} {
+    itcl::is class ::Counter
+} {1}
+
+test basic-1.14 {is command with class argument (wrapped in code command)} {
+    itcl::is class [itcl::code Counter]
+} {1}
+
+test basic-1.14 {is command with class argument (class does not exist)} {
+    itcl::is class Count
+} {0}
+
+test basic-1.15 {is command with object argument} {
+    itcl::is object -foo
+} {1}
+
+test basic-1.16 {is command with object argument (object does not exist)} {
+    itcl::is object xxx
+} {0}
+
+test basic-1.15 {is command with object argument (with code command)} {
+    itcl::is object [itcl::code -- -foo]
+} {1}
 
 # ----------------------------------------------------------------------
 #  #auto names
@@ -186,7 +213,13 @@ test basic-4.4 {objects can be created from the new class} {
     list [Counter #auto] [Counter #auto]
 } {counter0 counter1}
 
-test basic-4.5 {when a class is destroyed, its objects are deleted} {
+test basic-4.5 {namespaces for #auto are prepended to the command name} {
+    namespace eval someNS1 {}
+    namespace eval someNS2 {}
+    list [Counter someNS1::#auto] [Counter someNS2::#auto]
+} [list someNS1::counter2 someNS2::counter3]
+
+test basic-4.6 {when a class is destroyed, its objects are deleted} {
     list [lsort [itcl::find objects counter*]] \
          [itcl::delete class Counter] \
          [lsort [itcl::find objects counter*]]
@@ -297,7 +330,7 @@ test basic-6.2 {test array access for instance variables} {
 
 test basic-6.3 {test array access for commons} {
     lsort [test_arrays0 do array get colors]
-} {#0000ff #00ff00 #ff0000 blue green red}
+} [list #0000ff #00ff00 #ff0000 blue green red]
 
 test basic-6.4 {test array access for instance variables via "upvar"} {
     test_arrays0 do test_arrays_get nums
diff --git a/itcl/itcl/tests/body.test b/itcl/itcl/tests/body.test
index 079a69cf94b..f22b05ba79c 100644
--- a/itcl/itcl/tests/body.test
+++ b/itcl/itcl/tests/body.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-package require Itcl
+::tcltest::loadTestedCommands
 
 # ----------------------------------------------------------------------
 #  Test "body" command
diff --git a/itcl/itcl/tests/chain.test b/itcl/itcl/tests/chain.test
index 12cd2660447..8f55fc45330 100644
--- a/itcl/itcl/tests/chain.test
+++ b/itcl/itcl/tests/chain.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-package require Itcl
+::tcltest::loadTestedCommands
 
 # ----------------------------------------------------------------------
 #  Chaining methods and procs
diff --git a/itcl/itcl/tests/delete.test b/itcl/itcl/tests/delete.test
index dc320824643..1d2950cf563 100644
--- a/itcl/itcl/tests/delete.test
+++ b/itcl/itcl/tests/delete.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-package require Itcl
+::tcltest::loadTestedCommands
 
 # ----------------------------------------------------------------------
 #  Deleting classes and objects
diff --git a/itcl/itcl/tests/ensemble.test b/itcl/itcl/tests/ensemble.test
index e818e123aca..eb19ec09eaf 100644
--- a/itcl/itcl/tests/ensemble.test
+++ b/itcl/itcl/tests/ensemble.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-package require Itcl
+::tcltest::loadTestedCommands
 
 test ensemble-1.1 {ensemble name must be specified} {
     list [catch {itcl::ensemble} msg] $msg
@@ -45,8 +45,13 @@ test ensemble-1.4 {invoking ensemble parts} {
 } {{one: 1} {two: 2 3} {three: 3 4 5}}
 
 test ensemble-1.5 {invoking parts with improper arguments} {
-    list [catch "test_numbers three x" msg] $msg
-} {1 {no value given for parameter "y" to "test_numbers three"}}
+    set res [catch "test_numbers three x" msg]
+    if {[package vsatisfies [package provide Tcl] 8.4]} {
+	lappend res [string match "wrong # args*" $msg]
+    } else {
+	lappend res [string match "no value given*" $msg]
+    }
+} {1 1}
 
 test ensemble-1.6 {errors trigger a usage summary} {
     list [catch "test_numbers foo x y" msg] $msg
diff --git a/itcl/itcl/tests/import.test b/itcl/itcl/tests/import.test
index af28b6e0f42..34c60885097 100644
--- a/itcl/itcl/tests/import.test
+++ b/itcl/itcl/tests/import.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
-
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-package require Itcl
+::tcltest::loadTestedCommands
 
 # ----------------------------------------------------------------------
 #  Test "itcl::import::stub" command
@@ -40,15 +40,15 @@ test import-1.3 {"stub exists" requires one argument} {
 } {1 {wrong # args: should be "itcl::import::stub exists name"} 1 {wrong # args: should be "itcl::import::stub exists name"}}
 
 set interp [interp create]
-$interp eval {
-    package require Itcl
+$interp eval [subst -novariables {
+    [::tcltest::configure -load]
     proc auto_load {cmd {namespace {}}} {
         global debug
-        proc $cmd {args} [format {return "%s: $args"} $cmd]
+        proc $cmd {args} \[format {return "%s: $args"} $cmd\]
         append debug "(auto_load: $cmd)"
         return 1
     }
-}
+}]
 
 test import-1.4 {"stub create" creates a stub that triggers autoloading} {
     $interp eval {
@@ -64,7 +64,7 @@ test import-1.5 {"stub exists" recognizes stubs created by "stub create"} {
     $interp eval {
         set debug ""
         itcl::import::stub create foo::bar::stub1
-        proc foo::bar::proc1 {args} {return "proc1: $args"}
+        proc foo::bar::proc1 {{args {}}} {return "proc1: $args"}
         list [itcl::import::stub exists foo::bar::stub1] \
              [itcl::import::stub exists foo::bar::proc1]
     }
@@ -88,13 +88,13 @@ catch {interp delete $interp}
 #  Test "itcl::import::stub" command
 # ----------------------------------------------------------------------
 set interp [interp create]
-$interp eval {
-    package require Itcl
+$interp eval [subst -novariables {
+    [::tcltest::configure -load]
     proc auto_load {cmd {namespace {}}} {
-        proc $cmd {args} [format {return "%s: $args"} $cmd]
+        proc $cmd {args} \[format {return "%s: $args"} $cmd\]
         return 1
     }
-}
+}]
 
 test import-2.1 {initialize some commands for autoloading} {
     $interp eval {
diff --git a/itcl/itcl/tests/info.test b/itcl/itcl/tests/info.test
index 628d890a284..e207ce208ed 100644
--- a/itcl/itcl/tests/info.test
+++ b/itcl/itcl/tests/info.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-package require Itcl
+::tcltest::loadTestedCommands
 
 # ----------------------------------------------------------------------
 #  Class definition with one of everything
diff --git a/itcl/itcl/tests/inherit.test b/itcl/itcl/tests/inherit.test
index e20d5065e78..73a6339fe1c 100644
--- a/itcl/itcl/tests/inherit.test
+++ b/itcl/itcl/tests/inherit.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-package require Itcl
+::tcltest::loadTestedCommands
 
 # ----------------------------------------------------------------------
 #  Test construction/destruction with inheritance
diff --git a/itcl/itcl/tests/interp.test b/itcl/itcl/tests/interp.test
index 8b0015203a7..3493c2ee4ef 100644
--- a/itcl/itcl/tests/interp.test
+++ b/itcl/itcl/tests/interp.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-package require Itcl
+::tcltest::loadTestedCommands
 
 # ----------------------------------------------------------------------
 #  Make sure that slave interpreters can be created and loaded
diff --git a/itcl/itcl/tests/local.test b/itcl/itcl/tests/local.test
index 49430025431..4412ca9618a 100644
--- a/itcl/itcl/tests/local.test
+++ b/itcl/itcl/tests/local.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-package require Itcl
+::tcltest::loadTestedCommands
 
 # ----------------------------------------------------------------------
 #  Test "local" to create objects that only exist within a proc
diff --git a/itcl/itcl/tests/methods.test b/itcl/itcl/tests/methods.test
index 9906e889080..625007b751c 100644
--- a/itcl/itcl/tests/methods.test
+++ b/itcl/itcl/tests/methods.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-package require Itcl
+::tcltest::loadTestedCommands
 
 # ----------------------------------------------------------------------
 #  Methods with various argument lists
diff --git a/itcl/itcl/tests/mkindex.itcl b/itcl/itcl/tests/mkindex.itcl
index bef0fb5358e..5480c670af7 100644
--- a/itcl/itcl/tests/mkindex.itcl
+++ b/itcl/itcl/tests/mkindex.itcl
@@ -23,7 +23,6 @@
 # they are prefaced with white space.
 #
 namespace import itcl::*
-namespace import blt::*
 
 class Simple1 {
     variable x 0
@@ -35,11 +34,6 @@ class Simple1 {
     public method bump {}
   }
 
-itcl_class OldStyle {
-  public x 0
-  method foo {args} {return $args}
-}
-
 itcl::ensemble ens {
     part one {x} {}
     part two {x y} {}
diff --git a/itcl/itcl/tests/mkindex.test b/itcl/itcl/tests/mkindex.test
index bc20a242dbb..f63a1d6bbe0 100644
--- a/itcl/itcl/tests/mkindex.test
+++ b/itcl/itcl/tests/mkindex.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-package require Itcl
+::tcltest::loadTestedCommands
 
 # ----------------------------------------------------------------------
 #  Test "auto_mkindex" in the presence of class definitions
@@ -29,7 +29,14 @@ test mkindex-1.1 {remove any existing tclIndex file} {
 } {0}
 
 test mkindex-1.2 {build tclIndex based on a test file} {
+    if {[pwd] != $::tcltest::testsDirectory} {
+	file copy -force [file join $::tcltest::testsDirectory mkindex.itcl] \
+		./mkindex.itcl
+    }
     auto_mkindex . mkindex.itcl
+    if {[pwd] != $::tcltest::testsDirectory} {
+	file delete -force ./mkindex.itcl
+    }
     file exists tclIndex
 } {1}
 
@@ -46,7 +53,8 @@ test mkindex-1.3 {examine tclIndex} {
         }
         set result
     }
-} "{::Simple2::bump $element} {::Simple2::by $element} {::buried::deep::within $element} {::buried::ens $element} {::buried::inside $element} {::buried::inside::bump $element} {::buried::inside::by $element} {::buried::inside::find $element} {::buried::under::neath $element} {::top::find $element} {::top::notice $element} {OldStyle $element} {Simple1 $element} {Simple2 $element} {ens $element} {top $element}"
+} "{::Simple2::bump $element} {::Simple2::by $element} {::buried::deep::within $element} {::buried::ens $element} {::buried::inside $element} {::buried::inside::bump $element} {::buried::inside::by $element} {::buried::inside::find $element} {::buried::under::neath $element} {::top::find $element} {::top::notice $element} {Simple1 $element} {Simple2 $element} {ens $element} {top $element}"
 
+::tcltest::removeFile tclIndex
 ::tcltest::cleanupTests
 return
diff --git a/itcl/itcl/tests/namespace.test b/itcl/itcl/tests/namespace.test
index 31150f0f19c..eb8fcd5e285 100644
--- a/itcl/itcl/tests/namespace.test
+++ b/itcl/itcl/tests/namespace.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-package require Itcl
+::tcltest::loadTestedCommands
 
 # ----------------------------------------------------------------------
 #  Classes within namespaces
diff --git a/itcl/itcl/tests/protection.test b/itcl/itcl/tests/protection.test
index 180e1137852..8fe99d724bb 100644
--- a/itcl/itcl/tests/protection.test
+++ b/itcl/itcl/tests/protection.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-package require Itcl
+::tcltest::loadTestedCommands
 
 # ----------------------------------------------------------------------
 #  Class members are protected by access restrictions
diff --git a/itcl/itcl/tests/scope.test b/itcl/itcl/tests/scope.test
index 345790fb806..bd0bc3d43e0 100644
--- a/itcl/itcl/tests/scope.test
+++ b/itcl/itcl/tests/scope.test
@@ -13,12 +13,12 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::test
+}
 
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-package require Itcl
+::tcltest::loadTestedCommands
 
 # ----------------------------------------------------------------------
 #  Syntax of the "scope" command
diff --git a/itcl/itcl/tests/tclIndex b/itcl/itcl/tests/tclIndex
index f63ca93c630..4f6bdaeb971 100644
--- a/itcl/itcl/tests/tclIndex
+++ b/itcl/itcl/tests/tclIndex
@@ -8,7 +8,6 @@
 
 set auto_index(Simple1) [list source [file join $dir mkindex.itcl]]
 set auto_index(Simple2) [list source [file join $dir mkindex.itcl]]
-set auto_index(OldStyle) [list source [file join $dir mkindex.itcl]]
 set auto_index(ens) [list source [file join $dir mkindex.itcl]]
 set auto_index(::Simple2::bump) [list source [file join $dir mkindex.itcl]]
 set auto_index(::Simple2::by) [list source [file join $dir mkindex.itcl]]