merge trunk

8 files changed, 70 insertions, 23 deletions

diff --git a/tests/init.test b/tests/init.test
index 2a81b52..a241c0b 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -18,6 +18,19 @@ if {"::tcltest" ni [namespace children]} {
 # Clear out any namespaces called test_ns_*
 catch {namespace delete {*}[namespace children :: test_ns_*]}
 
+test init-0.1 {no error on initialization phase (init.tcl)} -setup {
+    interp create slave
+} -body {
+    slave eval {
+	list [set v [info exists ::errorInfo]] \
+		[if {$v} {set ::errorInfo}] \
+	     [set v [info exists ::errorCode]] \
+		[if {$v} {set ::errorCode}]
+    }
+} -cleanup {
+    interp delete slave
+} -result {0 {} 0 {}}
+
 # Six cases - white box testing
 
 test init-1.1 {auto_qualify - absolute cmd - namespace} {
diff --git a/tests/internals.tcl b/tests/internals.tcl
index 6b5bb87..e859afe 100644
--- a/tests/internals.tcl
+++ b/tests/internals.tcl
@@ -21,7 +21,7 @@ namespace path ::tcltest
 # Options:
 #	-addmem - set additional memory limit (in bytes) as difference (extra memory needed to run a test)
 #	-maxmem - set absolute maximum address space limit (in bytes)
-# 
+#
 proc testWithLimit args {
     set body [lindex $args end]
     array set in [lrange $args 0 end-1]
@@ -45,7 +45,7 @@ proc testWithLimit args {
 		    incr in(-addmem) 20000000
 		    # + size of locale-archive (may be up to 100MB):
 		    incr in(-addmem) [expr {
-			[file exists /usr/lib/locale/locale-archive] ? 
+			[file exists /usr/lib/locale/locale-archive] ?
 			[file size /usr/lib/locale/locale-archive] : 0
 		    }]
 		}
diff --git a/tests/oo.test b/tests/oo.test
index 3b56f30..c73c36c 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -313,6 +313,40 @@ test oo-1.18.3 {Bug 21c144f0f5} -setup {
 } -cleanup {
     interp delete slave
 }
+test oo-1.18.4 {correct handling of cleanup in superclass set error} -setup {
+    interp create slave
+} -body {
+    slave eval {
+	oo::class create A
+	oo::class create B {
+	    superclass oo::class
+	    constructor {} {
+		next {superclass A}
+		next {superclass -append A}
+	    }
+	}
+	[B create C] create d
+    }
+} -returnCodes error -cleanup {
+    interp delete slave
+} -result {class should only be a direct superclass once}
+test oo-1.18.5 {correct handling of cleanup in superclass set error} -setup {
+    interp create slave
+} -body {
+    slave eval {
+	oo::class create A
+	oo::class create B {
+	    superclass oo::class
+	    constructor {c} {
+		next {superclass A}
+		next [list superclass -append {*}$c]
+	    }
+	}
+	[B create C {B C}] create d
+    }
+} -returnCodes error -cleanup {
+    interp delete slave
+} -result {attempt to form circular dependency graph}
 test oo-1.19 {basic test of OO functionality: teardown order} -body {
     oo::object create o
     namespace delete [info object namespace o]
diff --git a/tests/registry.test b/tests/registry.test
index 86f4ef3..8cfd5be 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -19,7 +19,7 @@ testConstraint reg 0
 if {[testConstraint win]} {
     if {![catch {
 	    ::tcltest::loadTestedCommands
-	    set ::regver [package require registry 1.3.4]
+	    set ::regver [package require registry 1.3.5]
 	}]} {
 	testConstraint reg 1
     }
@@ -33,7 +33,7 @@ testConstraint english [expr {
 
 test registry-1.0 {check if we are testing the right dll} {win reg} {
     set ::regver
-} {1.3.4}
+} {1.3.5}
 test registry-1.1 {argument parsing for registry command} {win reg} {
     list [catch {registry} msg] $msg
 } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
diff --git a/tests/string.test b/tests/string.test
index b58aea2..9b51702 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -31,7 +31,7 @@ proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s}
 testConstraint testobj [expr {[info commands testobj] ne {}}]
 testConstraint testindexobj [expr {[info commands testindexobj] ne {}}]
 testConstraint testevalex [expr {[info commands testevalex] ne {}}]
-testConstraint tip389 [expr {[string length \U010000] == 2}]
+testConstraint fullutf [expr {[string length \U010000] == 1}]
 
 # Used for constraining memory leak tests
 testConstraint memory [llength [info commands memory]]
@@ -505,9 +505,9 @@ test string-5.19.$noComp {string index, bytearray object out of bounds} {
 test string-5.20.$noComp {string index, bytearray object out of bounds} {
     run {string index [binary format I* {0x50515253 0x52}] 20}
 } {}
-test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} tip389 {
+test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} fullutf {
     run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]}
-} [list \U100000 {} b]
+} [list \U100000 b {}]
 
 
 proc largest_int {} {
@@ -1502,9 +1502,9 @@ test string-12.22.$noComp {string range, shimmering binary/index} {
     binary scan $s a* x
     run {string range $s $s end}
 } 000000001
-test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} tip389 {
+test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} fullutf {
     run {list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]}
-} [list \U100000 {} b]
+} [list \U100000 b {}]
 
 test string-13.1.$noComp {string repeat} {
     list [catch {run {string repeat}} msg] $msg
@@ -1743,10 +1743,10 @@ test string-17.7.$noComp {string totitle, unicode} {
 test string-17.8.$noComp {string totitle, compiled} {
     lindex [run {string totitle [list aa bb [list cc]]}] 0
 } Aa
-test string-17.9.$noComp {string totitle, surrogates, bug [11ae2be95dac9417]} tip389 {
+test string-17.9.$noComp {string totitle, surrogates, bug [11ae2be95dac9417]} fullutf {
     run {list [string totitle a\U118c0c 1 1] [string totitle a\U118c0c 2 2] \
 	[string totitle a\U118c0c 3 3]}
-} [list a\U118a0c a\U118c0C a\U118c0C]
+} [list a\U118a0c a\U118c0C a\U118c0c]
 
 test string-18.1.$noComp {string trim} {
     list [catch {run {string trim}} msg] $msg
diff --git a/tests/stringObj.test b/tests/stringObj.test
index 8b10897..9c32dd6 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -23,7 +23,7 @@ catch [list package require -exact Tcltest [info patchlevel]]
 testConstraint testobj [llength [info commands testobj]]
 testConstraint testbytestring [llength [info commands testbytestring]]
 testConstraint testdstring [llength [info commands testdstring]]
-testConstraint tip389 [expr {[string length \U010000] == 2}]
+testConstraint fullutf [expr {[string length \U010000] == 1}]
 
 test stringObj-1.1 {string type registration} testobj {
     set t [testobj types]
@@ -465,19 +465,19 @@ test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj {
     teststringobj set 1 foo
     teststringobj appendself 1 3
 } foo
-test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj tip389} {
+test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj fullutf} {
     teststringobj set 1 foo
     teststringobj appendself2 1 0
 } foofoo
-test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj tip389} {
+test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj fullutf} {
     teststringobj set 1 foo
     teststringobj appendself2 1 1
 } foooo
-test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj tip389} {
+test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj fullutf} {
     teststringobj set 1 foo
     teststringobj appendself2 1 2
 } fooo
-test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj tip389} {
+test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj fullutf} {
     teststringobj set 1 foo
     teststringobj appendself2 1 3
 } foo
diff --git a/tests/utf.test b/tests/utf.test
index 1d0f63a..adcbb87 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -21,7 +21,7 @@ testConstraint testbytestring [llength [info commands testbytestring]]
 catch {unset x}
 
 # Some tests require support for 4-byte UTF-8 sequences
-testConstraint tip389 [expr {[string length \U010000] == 2}]
+testConstraint fullutf [expr {[string length \U010000] == 1}]
 
 test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} testbytestring {
     expr {"\x01" eq [testbytestring "\x01"]}
@@ -84,12 +84,12 @@ test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} testbytestrin
 test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestring {
     string length [testbytestring "\xE4\xB9\x8E"]
 } {1}
-test utf-2.8 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {tip389 testbytestring} -body {
+test utf-2.8 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {fullutf testbytestring} -body {
     string length [testbytestring "\xF0\x90\x80\x80"]
-} -result {2}
-test utf-2.9 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {tip389 testbytestring} -body {
+} -result {1}
+test utf-2.9 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {fullutf testbytestring} -body {
     string length [testbytestring "\xF4\x8F\xBF\xBF"]
-} -result {2}
+} -result {1}
 test utf-2.10 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, underflow} testbytestring {
     string length [testbytestring "\xF0\x8F\xBF\xBF"]
 } {4}
diff --git a/tests/winDde.test b/tests/winDde.test
index 412c476..acba304 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -20,7 +20,7 @@ testConstraint dde 0
 if {[testConstraint win]} {
     if {![catch {
 	    ::tcltest::loadTestedCommands
-	    set ::ddever [package require dde 1.4.2]
+	    set ::ddever [package require dde 1.4.3]
 	    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
 	testConstraint dde 1
     }
@@ -104,7 +104,7 @@ proc createChildProcess {ddeServerName args} {
 # -------------------------------------------------------------------------
 test winDde-1.0 {check if we are testing the right dll} {win dde} {
     set ::ddever
-} {1.4.2}
+} {1.4.3}
 
 test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
     list [dde servername foobar] [dde servername] [dde servername self]