see backport log in ChangeLog for specific file backports from 8.4aCVS

FossilOrigin-Name: 6defc375da7f53c897947de6051d97cbc0a30fc8

15 files changed, 365 insertions, 92 deletions

diff --git a/tests/binary.test b/tests/binary.test
index 07790a2..c87deb6 100644
--- a/tests/binary.test
+++ b/tests/binary.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: binary.test,v 1.7 2000/04/10 17:18:57 ericm Exp $
+# RCS: @(#) $Id: binary.test,v 1.7.2.1 2001/04/03 22:54:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -42,7 +42,6 @@ test binary-1.4 {Tcl_BinaryObjCmd: format} {
 } {}
 
 
-
 test binary-2.1 {Tcl_BinaryObjCmd: format} {
     list [catch {binary format a } msg] $msg
 } {1 {not enough arguments for all format specifiers}}
@@ -1464,15 +1463,3 @@ test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} {} {
 # cleanup
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/clock.test b/tests/clock.test
index 2b9803c..aa84f6d 100644
--- a/tests/clock.test
+++ b/tests/clock.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: clock.test,v 1.13.2.1 2000/08/07 21:30:35 hobbs Exp $
+# RCS: @(#) $Id: clock.test,v 1.13.2.2 2001/04/03 22:54:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -38,11 +38,11 @@ test clock-2.2 {clock clicks tests} {
 test clock-2.3 {clock clicks tests} {
     list [catch {clock clicks foo} msg] $msg
 } {1 {bad switch "foo": must be -milliseconds}}
-test clock-2.3 {clock clicks tests} {
+test clock-2.4 {clock clicks tests} {
     expr [clock clicks -milliseconds]+1
     concat {}
 } {}
-test clock-2.2 {clock clicks tests, millisecond timing test} {
+test clock-2.5 {clock clicks tests, millisecond timing test} {
     set start [clock clicks -milli]
     after 10
     set end [clock clicks -milli]
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 68e4255..ebf27e6 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.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: cmdAH.test,v 1.10 2000/04/10 17:18:57 ericm Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.10.2.1 2001/04/03 22:54:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -1491,23 +1491,78 @@ test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} {
 } {1 {user "woohgy" doesn't exist}}
 
 # channels
+# In testing 'file channels', we need to make sure that a channel
+# created in one interp isn't visible in another.
+
+interp create simpleInterp
+interp create -safe safeInterp
+interp c
+safeInterp expose file file
 
 test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} {
     list [catch {file channels a b} msg] $msg
 } {1 {wrong # args: should be "file channels ?pattern?"}}
 test cmdAH-31.2 {Tcl_FileObjCmd: channels, too many args} {
-    file chan
-} {stderr stdout stdin}
-test cmdAH-31.3 {Tcl_FileObjCmd: channels, too many args} {
+    # Normal interps start out with only the standard channels
+    lsort [simpleInterp eval [list file chan]]
+} [lsort {stderr stdout stdin}]
+test cmdAH-31.3 {Tcl_FileObjCmd: channels, globbing} {
     string equal [file channels] [file channels *]
 } {1}
-test cmdAH-31.4 {Tcl_FileObjCmd: channels} {
-    set old [file channels gorp.file]
-    set f [open gorp.file w]
-    set new [file channels file*]
-    close $f
-    string equal $f $new
+test cmdAH-31.4 {Tcl_FileObjCmd: channels, globbing} {
+    lsort [file channels std*]
+} [lsort {stdout stderr stdin}]
+
+set newFileId [open gorp.file w]
+
+test cmdAH-31.5 {Tcl_FileObjCmd: channels} {
+    set res [file channels $newFileId]
+    string equal $newFileId $res
 } {1}
+test cmdAH-31.6 {Tcl_FileObjCmd: channels in other interp} {
+    # Safe interps start out with no channels
+    safeInterp eval [list file channels]
+} {}
+test cmdAH-31.7 {Tcl_FileObjCmd: channels in other interp} {
+    list [catch {safeInterp eval [list puts $newFileId "hello"]} msg] $msg
+} [list 1 "can not find channel named \"$newFileId\""]
+
+interp share {} $newFileId safeInterp
+interp share {} stdout safeInterp
+
+test cmdAH-31.8 {Tcl_FileObjCmd: channels in other interp} {
+    # $newFileId should now be visible in both interps
+    list [file channels $newFileId] \
+	    [safeInterp eval [list file channels $newFileId]]
+} [list $newFileId $newFileId]
+test cmdAH-31.9 {Tcl_FileObjCmd: channels in other interp} {
+    lsort [safeInterp eval [list file channels]]
+} [lsort [list stdout $newFileId]]
+test cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} {
+    # we can now write to $newFileId from slave
+    safeInterp eval [list puts $newFileId "hello"]
+} {}
+
+interp transfer {} $newFileId safeInterp
+
+test cmdAH-31.11 {Tcl_FileObjCmd: channels in other interp} {
+    # $newFileId should now be visible only in safeInterp
+    list [file channels $newFileId] \
+	    [safeInterp eval [list file channels $newFileId]]
+} [list {} $newFileId]
+test cmdAH-31.12 {Tcl_FileObjCmd: channels in other interp} {
+    lsort [safeInterp eval [list file channels]]
+} [lsort [list stdout $newFileId]]
+test cmdAH-31.13 {Tcl_FileObjCmd: channels in other interp} {
+    safeInterp eval [list close $newFileId]
+    safeInterp eval [list file channels]
+} {stdout}
+
+# This shouldn't work, but just in case a test above failed...
+catch {close $newFileId}
+
+interp delete safeInterp
+interp delete simpleInterp
 
 # cleanup
 catch {testsetplatform $platform}
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index b4b23f0..df4b2ce 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -8,7 +8,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdIL.test,v 1.12 2000/04/10 17:18:57 ericm Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.12.2.1 2001/04/03 22:54:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -82,6 +82,22 @@ test cmdIL-1.23 {Tcl_LsortObjCmd procedure, unique sort with index} {
     # lsort -unique should return the last unique item
     lsort -unique -index 0 {{a b} {c b} {a c} {d a}}
 } {{a c} {c b} {d a}}
+test cmdIL-1.24 {Tcl_LsortObjCmd procedure, order of -index and -command} {
+    catch {rename 1 ""}
+    proc testcmp {a b} {return [string compare $a $b]}
+    set l [list [list a b] [list c d]]
+    set result [list [catch {lsort -command testcmp -index 1 $l} msg] $msg]
+    rename testcmp ""
+    set result
+} [list 0 [list [list a b] [list c d]]]
+test cmdIL-1.25 {Tcl_LsortObjCmd procedure, order of -index and -command} {
+    catch {rename 1 ""}
+    proc testcmp {a b} {return [string compare $a $b]}
+    set l [list [list a b] [list c d]]
+    set result [list [catch {lsort -index 1 -command testcmp $l} msg] $msg]
+    rename testcmp ""
+    set result
+} [list 0 [list [list a b] [list c d]]]
 
 # Can't think of any good tests for the MergeSort and MergeLists
 # procedures, except a bunch of random lists to sort.
diff --git a/tests/execute.test b/tests/execute.test
index 4b11822..13da21d 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -14,7 +14,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: execute.test,v 1.8 2000/04/10 17:18:58 ericm Exp $
+# RCS: @(#) $Id: execute.test,v 1.8.2.1 2001/04/03 22:54:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -583,6 +583,12 @@ test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName o
     p
 } {}
 
+test execute-6.2 {Evaluate an expression in a variable; compile the first time, do not the second} {
+    set w {3*5}
+    proc a {obj} {expr $obj}
+    set res "[a $w]:[a $w]"
+} {15:15}
+
 # cleanup
 catch {eval namespace delete [namespace children :: test_ns_*]}
 catch {rename foo ""}
diff --git a/tests/fCmd.test b/tests/fCmd.test
index c6cf426..5fa97c3 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.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: fCmd.test,v 1.8 2000/04/10 17:18:59 ericm Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.8.2.1 2001/04/03 22:54:38 hobbs Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -509,12 +509,13 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {pcOnly} {
     catch {file delete -force c:/tcl8975@ d:/tcl8975@}
     file mkdir c:/tcl8975@
     if [catch {file rename c:/tcl8975@ d:/}] {
-	list d:/tcl8975@
+	set msg d:/tcl8975@
     } else {
 	set msg [glob c:/tcl8975@ d:/tcl8975@]
 	file delete -force d:/tcl8975@
-	set msg
     }
+    file delete -force c:/tcl8975@
+    set msg
 } {d:/tcl8975@}
 test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \
 	{unixOnly notRoot} {
diff --git a/tests/interp.test b/tests/interp.test
index 6cad192..e0fb84a 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.11 2000/04/10 17:19:00 ericm Exp $
+# RCS: @(#) $Id: interp.test,v 1.11.2.1 2001/04/03 22:54:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -635,7 +635,10 @@ test interp-17.5 {alias loop prevention} {
 # the bugs as a core dump.
 #
 
-if {[info commands testinterpdelete] != ""} {
+if {[info commands testinterpdelete] == ""} {
+    puts "This application hasn't been compiled with the \"testinterpdelete\""
+    puts "command, so I can't test slave delete calls"
+} else {
     test interp-18.1 {testing Tcl_DeleteInterp vs slaves} {
 	list [catch {testinterpdelete} msg] $msg
     } {1 {wrong # args: should be "testinterpdelete path"}}
@@ -2353,6 +2356,24 @@ test interp-31.1 {alias invocation scope} {
     set result
 } ok
 
+test interp-32.1 { parent's working directory should
+                   be inherited by a child interp } {
+    set parent [pwd]
+    set i [interp create]
+    set child [$i eval pwd]
+    interp delete $i
+    file mkdir cwd_test
+    cd cwd_test
+    lappend parent [pwd]
+    set i [interp create]
+    lappend child [$i eval pwd]
+    cd ..
+    file delete cwd_test
+    interp delete $i
+    expr {[string equal $parent $child] ? 1 :
+             "\{$parent\} != \{$child\}"}
+} 1
+
 # cleanup
 foreach i [interp slaves] {
   interp delete $i
diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test
index 928d2e9..63987d8 100644
--- a/tests/pkgMkIndex.test
+++ b/tests/pkgMkIndex.test
@@ -8,7 +8,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: pkgMkIndex.test,v 1.16 2000/04/10 17:19:03 ericm Exp $
+# RCS: @(#) $Id: pkgMkIndex.test,v 1.16.2.1 2001/04/03 22:54:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -165,7 +165,7 @@ proc pkgtest::createIndex { args } {
  
     if {[catch {
 	file delete [file join $dirPath pkgIndex.tcl]
-	eval pkg_mkIndex $options $dirPath $patternList
+	eval pkg_mkIndex $options [list $dirPath] $patternList
     } err]} {
 	return [list 1 $err]
     }
@@ -362,6 +362,26 @@ test pkgMkIndex-13.1 {proc names with embedded spaces} {
     pkgtest::runIndex -lazy $fullPkgPath spacename.tcl
 } {0 {{spacename:1.0 {tclPkgSetup {spacename.tcl source {{a b} {c d}}}}}}}
 
+# Test the pkg_compareExtension helper function
+test pkgMkIndex-14.1 {pkg_compareExtension} {unixOnly} {
+    pkg_compareExtension foo.so .so
+} 1
+test pkgMkIndex-14.2 {pkg_compareExtension} {unixOnly} {
+    pkg_compareExtension foo.so.bar .so
+} 0
+test pkgMkIndex-14.3 {pkg_compareExtension} {unixOnly} {
+    pkg_compareExtension foo.so.1 .so
+} 1
+test pkgMkIndex-14.4 {pkg_compareExtension} {unixOnly} {
+    pkg_compareExtension foo.so.1.2 .so
+} 1
+test pkgMkIndex-14.5 {pkg_compareExtension} {unixOnly} {
+    pkg_compareExtension foo .so
+} 0
+test pkgMkIndex-14.6 {pkg_compareExtension} {unixOnly} {
+    pkg_compareExtension foo.so.1.2.bar .so
+} 0
+
 # cleanup
 
 namespace delete pkgtest
diff --git a/tests/regexp.test b/tests/regexp.test
index e891b54..be8cbbb 100644
--- a/tests/regexp.test
+++ b/tests/regexp.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: regexp.test,v 1.13 2000/04/10 21:08:27 ericm Exp $
+# RCS: @(#) $Id: regexp.test,v 1.13.2.1 2001/04/03 22:54:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -526,21 +526,15 @@ test regexp-18.10 {regexp -all} {
     # Go to index 3; this is past the end of the string, so stop.
     regexp -all -inline {a*} aba
 } {a {} a}
+test regexp-18.11 {regexp -all} {
+    regexp -all -inline {^a} aaaa
+} {a}
+
+test regexp-19.1 {regsub null replacement} {
+    regsub -all {@} {@hel@lo@} "\0a\0" result
+    list $result [string length $result]
+} "\0a\0hel\0a\0lo\0a\0 14"
 
 # cleanup
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/scan.test b/tests/scan.test
index 2624dd2..bc8168f 100644
--- a/tests/scan.test
+++ b/tests/scan.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: scan.test,v 1.10 2000/04/10 17:19:04 ericm Exp $
+# RCS: @(#) $Id: scan.test,v 1.10.2.1 2001/04/03 22:54:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -324,6 +324,35 @@ test scan-4.61 {Tcl_ScanObjCmd, set errors} {
     set result
 } {1 {couldn't set variable "z"couldn't set variable "y"} abc}
 
+# procedure that returns the range of integers
+
+proc int_range {} {
+    for { set MIN_INT 1 } { $MIN_INT > 0 } {} {
+	set MIN_INT [expr { $MIN_INT << 1 }]
+    }
+    set MAX_INT [expr { ~ $MIN_INT }]
+    return [list $MIN_INT $MAX_INT]
+}
+
+test scan-4.62 {scanning of large and negative octal integers} {
+    foreach { MIN_INT MAX_INT } [int_range] {}
+    set scanstring [format {%o %o %o} -1 $MIN_INT $MAX_INT]
+    list [scan $scanstring {%o %o %o} a b c] \
+	[expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
+} {3 1 1 1}
+test scan-4.63 {scanning of large and negative hex integers} {
+    foreach { MIN_INT MAX_INT } [int_range] {}
+    set scanstring [format {%x %x %x} -1 $MIN_INT $MAX_INT]
+    list [scan $scanstring {%x %x %x} a b c] \
+	[expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
+} {3 1 1 1}
+
+# clean up from last two tests
+
+catch {
+    rename int_range {}
+}
+
 test scan-5.1 {integer scanning} {
     set a {}; set b {}; set c {}; set d {}
     list [scan "-20 1476 \n33 0" "%d %d %d %d" a b c d] $a $b $c $d
@@ -630,17 +659,3 @@ test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
 # cleanup
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/stack.test b/tests/stack.test
index 19a5104..0f57617 100644
--- a/tests/stack.test
+++ b/tests/stack.test
@@ -4,12 +4,12 @@
 # built-in commands.  Sourcing this file into Tcl runs the tests and
 # generates output for errors.  No output means no errors were found.
 #
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-2000 Ajuba Solutions.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: stack.test,v 1.8 2000/04/10 17:19:04 ericm Exp $
+# RCS: @(#) $Id: stack.test,v 1.8.2.1 2001/04/03 22:54:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -17,8 +17,28 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 }
 
 # Note that a failure in this test results in a crash of the executable.
+# In order to avoid that, we do a basic check of the current stacksize.
+# This size can be changed with ulimit (ksh/bash/sh) or limit (csh/tcsh).
 
-test stack-1.1 {maxNestingDepth reached on infinite recursion} {
+# This doesn't catch all cases, for example threads of lower stacksize
+# can still squeak through.  A core check is really needed. -- JH
+
+if {[string equal $::tcl_platform(platform) "unix"]} {
+    set stackSize [exec /bin/sh -c "ulimit -s"]
+    if {[string is integer $stackSize] && ($stackSize < 2400)} {
+        puts stderr "WARNING: the default application stacksize of $stackSize\
+                may cause Tcl to\ncrash due to stack overflow before the\
+                recursion limit is reached.\nA minimum stacksize of 2400\
+                kbytes is recommended.\nSkipping inifite recursion test."
+        set ::tcltest::testConstraints(minStack2400) 0
+    } else {
+        set ::tcltest::testConstraints(minStack2400) 1
+    }
+} else {
+    set ::tcltest::testConstraints(minStack2400) 1
+}
+
+test stack-1.1 {maxNestingDepth reached on infinite recursion} {minStack2400} {
     proc recurse {} { return [recurse] }
     catch {recurse} rv
     rename recurse {}
diff --git a/tests/string.test b/tests/string.test
index 0de9388..47b4b3f 100644
--- a/tests/string.test
+++ b/tests/string.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: string.test,v 1.23 2000/04/10 17:19:04 ericm Exp $
+# RCS: @(#) $Id: string.test,v 1.23.2.1 2001/04/03 22:54:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -255,6 +255,12 @@ test string-5.17 {string index, bad integer} {
 test string-5.18 {string index, bad integer} {
     list [catch {string index "abc" end-00289} msg] $msg
 } {1 {expected integer but got "-00289" (looks like invalid octal number)}}
+test string-5.19 {string index, bytearray object out of bounds} {
+    string index [binary format I* {0x50515253 0x52}] -1
+} {}
+test string-5.20 {string index, bytearray object out of bounds} {
+    string index [binary format I* {0x50515253 0x52}] 20
+} {}
 
 
 proc largest_int {} {
@@ -680,6 +686,15 @@ test string-10.13 {string map, -nocase unicode} {
 test string-10.14 {string map, -nocase null arguments} {
     string map -nocase {{} abc} foo
 } foo
+test string-10.15 {string map, one pair case} {
+    string map -nocase {abc 32} aAbCaBaAbAbcAb
+} {a32aBaAb32Ab}
+test string-10.16 {string map, one pair case} {
+    string map -nocase {ab 4321} aAbCaBaAbAbcAb
+} {a4321C4321a43214321c4321}
+test string-10.17 {string map, one pair case} {
+    string map {Ab 4321} aAbCaBaAbAbcAb
+} {a4321CaBa43214321c4321}
 
 test string-11.1 {string match, too few args} {
     list [catch {string match a} msg] $msg
@@ -798,6 +813,43 @@ test string-11.37 {string match nocase} {
 test string-11.38 {string match case, reverse range} {
     string match {[A-fh-Z]} g
 } 1
+test string-11.39 {string match, *\ case} {
+    string match {*\abc} abc
+} 1
+test string-11.40 {string match, *special case} {
+    string match {*[ab]} abc
+} 0
+test string-11.41 {string match, *special case} {
+    string match {*[ab]*} abc
+} 1
+test string-11.42 {string match, *special case} {
+    string match "*\\" "\\"
+} 0
+test string-11.43 {string match, *special case} {
+    string match "*\\\\" "\\"
+} 1
+test string-11.44 {string match, *special case} {
+    string match "*???" "12345"
+} 1
+test string-11.45 {string match, *special case} {
+    string match "*???" "12"
+} 0
+test string-11.46 {string match, *special case} {
+    string match "*\\*" "abc*"
+} 1
+test string-11.47 {string match, *special case} {
+    string match "*\\*" "*"
+} 1
+test string-11.48 {string match, *special case} {
+    string match "*\\*" "*abc"
+} 0
+test string-11.49 {string match, *special case} {
+    string match "?\\*" "a*"
+} 1
+test string-11.50 {string match, *special case} {
+    string match "\\" "\\"
+} 0
+
 
 test string-12.1 {string range} {
     list [catch {string range} msg] $msg
@@ -884,6 +936,28 @@ test string-13.6 {string repeat} {
 test string-13.7 {string repeat} {
     list [catch {string repeat abc end} msg] $msg
 } {1 {expected integer but got "end"}}
+test string-13.8 {string repeat} {
+    string repeat {} -1000
+} {}
+test string-13.9 {string repeat} {
+    string repeat {} 0
+} {}
+test string-13.10 {string repeat} {
+    string repeat def 0
+} {}
+test string-13.11 {string repeat} {
+    string repeat def 1
+} def
+test string-13.12 {string repeat} {
+    string repeat ab\u7266cd 3
+} ab\u7266cdab\u7266cdab\u7266cd
+test string-13.13 {string repeat} {
+    string repeat \x00 3
+} \x00\x00\x00
+test string-13.14 {string repeat} {
+    # The string range will ensure us that string repeat gets a unicode string
+    string repeat [string range ab\u7266cd 2 3] 3
+} \u7266c\u7266c\u7266c
 
 test string-14.1 {string replace} {
     list [catch {string replace} msg] $msg
@@ -1163,9 +1237,3 @@ test string-22.13 {string wordstart, unicode} {
 # cleanup
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
diff --git a/tests/stringObj.test b/tests/stringObj.test
index 188003c..a0c755e 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: stringObj.test,v 1.10.2.1 2000/08/07 21:32:25 hobbs Exp $
+# RCS: @(#) $Id: stringObj.test,v 1.10.2.2 2001/04/03 22:54:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
diff --git a/tests/subst.test b/tests/subst.test
index b360b6f..1399bfa 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -6,12 +6,12 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-2000 Ajuba Solutions.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: subst.test,v 1.6 2000/04/10 17:19:05 ericm Exp $
+# RCS: @(#) $Id: subst.test,v 1.6.2.1 2001/04/03 22:54:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -109,18 +109,70 @@ test subst-7.7 {switches} {
     subst -nov -nob -noc {abc $x [expr 1+2] \\\x41}
 } {abc $x [expr 1+2] \\\x41}
 
+test subst-8.1 {return in a subst} {
+    subst {foo [return {x}; bogus code] bar}
+} {foo x bar}
+test subst-8.2 {return in a subst} {
+    subst {foo [return x ; bogus code] bar}
+} {foo x bar}
+test subst-8.3 {return in a subst} {
+    subst {foo [if 1 { return {x}; bogus code }] bar}
+} {foo x bar}
+test subst-8.4 {return in a subst} {
+    subst {[eval {return hi}] there}
+} {hi there}
+test subst-8.5 {return in a subst} {
+    subst {foo [return {]}; bogus code] bar}
+} {foo ] bar}
+test subst-8.6 {return in a subst} {
+    subst {foo [return {x}; bogus code bar}
+} {foo x}
+test subst-8.7 {return in a subst, parse error} {
+    subst {foo [return {x} ; set a {}" ; stuff] bar}
+} {foo xset a {}" ; stuff] bar}
+test subst-8.8 {return in a subst, parse error} {
+    subst {foo [return {x} ; set bar baz ; set a {}" ; stuff] bar}
+} {foo xset bar baz ; set a {}" ; stuff] bar}
+
+test subst-9.1 {error in a subst} {
+    list [catch {subst {[error foo; bogus code]bar}} msg] $msg
+} {1 foo}
+test subst-9.2 {error in a subst} {
+    list [catch {subst {[if 1 { error foo; bogus code}]bar}} msg] $msg
+} {1 foo}
+
+test subst-10.1 {break in a subst} {
+    subst {foo [break; bogus code] bar}
+} {foo  bar}
+test subst-10.2 {break in a subst} {
+    subst {foo [break; return x; bogus code] bar}
+} {foo  bar}
+test subst-10.3 {break in a subst} {
+    subst {foo [if 1 { break; bogus code}] bar}
+} {foo  bar}
+test subst-10.4 {break in a subst, parse error} {
+    subst {foo [break ; set a {}{} ; stuff] bar}
+} {foo set a {}{} ; stuff] bar}
+test subst-10.5 {break in a subst, parse error} {
+    subst {foo [break ;set bar baz ;set a {}{} ; stuff] bar}
+} {foo set bar baz ;set a {}{} ; stuff] bar}
+
+test subst-11.1 {continue in a subst} {
+    subst {foo [continue; bogus code] bar}
+} {foo  bar}
+test subst-11.2 {continue in a subst} {
+    subst {foo [continue; return x; bogus code] bar}
+} {foo  bar}
+test subst-11.3 {continue in a subst} {
+    subst {foo [if 1 { continue; bogus code}] bar}
+} {foo  bar}
+test subst-11.4 {continue in a subst, parse error} {
+    subst {foo [continue ; set a {}{} ; stuff] bar}
+} {foo set a {}{} ; stuff] bar}
+test subst-11.5 {continue in a subst, parse error} {
+    subst {foo [continue ;set bar baz ;set a {}{} ; stuff] bar}
+} {foo set bar baz ;set a {}{} ; stuff] bar}
+
 # cleanup
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/unixInit.test b/tests/unixInit.test
index 746114c..1ae5407 100644
--- a/tests/unixInit.test
+++ b/tests/unixInit.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: unixInit.test,v 1.13 2000/04/10 17:19:05 ericm Exp $
+# RCS: @(#) $Id: unixInit.test,v 1.13.2.1 2001/04/03 22:54:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -150,6 +150,24 @@ test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} \
     # would need test command to get defaultLibDir and compare it to
     # [lindex $auto_path end]
 } {}
+test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unixOnly} {
+    file delete -force /tmp/sparkly
+    file delete -force /tmp/lib
+    file mkdir /tmp/sparkly
+    file copy $::tcltest::tcltest /tmp/sparkly/tcltest
+
+    file mkdir /tmp/lib/tcl[info tclversion]
+    close [open /tmp/lib/tcl[info tclversion]/init.tcl w]
+
+    set allAbsolute 1
+    foreach dir [getlibpath /tmp/sparkly/tcltest] {
+	set allAbsolute [expr {$allAbsolute \
+		&& [string equal absolute [file pathtype $dir]]}]
+    }
+    file delete -force /tmp/sparkly
+    file delete -force /tmp/lib
+    set allAbsolute
+} 1
 test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly installedTcl} {
     set env(LANG) C