merge trunk

6 files changed, 149 insertions, 16 deletions

diff --git a/tests/all.tcl b/tests/all.tcl
index b436fbe..05d3024 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -10,6 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
+package prefer latest
 package require Tcl 8.5
 package require tcltest 2.2
 namespace import tcltest::*
diff --git a/tests/io.test b/tests/io.test
index e6cea16..386179e 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -2748,13 +2748,13 @@ test io-29.33b {TIP#398, no implicit flush of nonblocking on exit} {exec} {
     set f [open $path(script2) w]
     puts $f {after 2000}
     close $f
-	set t1 [clock seconds]
+	set t1 [clock milliseconds]
 	set ff [open "|[list [interpreter] $path(script2)]" w]
 	catch {unset ::env(TCL_FLUSH_NONBLOCKING_ON_EXIT)}
 	exec [interpreter] $path(script) >@ $ff
-	set t2 [clock seconds]
+	set t2 [clock milliseconds]
 	close $ff
-	expr {($t2-$t1)/2}
+	expr {($t2-$t1)/2000 ? $t2-$t1 : 0}
 } 0
 test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac fileevent} {
     variable c 0
diff --git a/tests/oo.test b/tests/oo.test
index f3c0bda..00663e9 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1974,7 +1974,7 @@ test oo-18.1 {OO: define command support} {
 } {1 foo {foo
     while executing
 "error foo"
-    (in definition script for object "oo::object" line 1)
+    (in definition script for class "::oo::object" line 1)
     invoked from within
 "oo::define oo::object {error foo}"}}
 test oo-18.2 {OO: define command support} {
@@ -1987,7 +1987,7 @@ test oo-18.3 {OO: define command support} {
 } {1 bar {bar
     while executing
 "error bar"
-    (in definition script for object "::foo" line 1)
+    (in definition script for class "::foo" line 1)
     invoked from within
 "oo::class create foo {error bar}"}}
 test oo-18.3a {OO: define command support} {
@@ -1997,7 +1997,7 @@ test oo-18.3a {OO: define command support} {
 } {1 bar {bar
     while executing
 "error bar"
-    (in definition script for object "::foo" line 2)
+    (in definition script for class "::foo" line 2)
     invoked from within
 "oo::class create foo {
     error bar
@@ -2015,7 +2015,7 @@ test oo-18.3b {OO: define command support} {
     ("eval" body line 1)
     invoked from within
 "eval eval error bar"
-    (in definition script for object "::foo" line 2)
+    (in definition script for class "::foo" line 2)
     invoked from within
 "oo::class create foo {
     eval eval error bar
@@ -2070,6 +2070,106 @@ test oo-18.5 {OO: more error traces from the guts} -setup {
     (class "::cls" method "eval" line 1)
     invoked from within
 "obj eval {error bar}"}}
+test oo-18.6 {class construction reference management and errors} -setup {
+    oo::class create super_abc
+} -body {
+    catch {
+oo::class create abc {
+    superclass super_abc
+    ::rename abc ::def
+    ::error foo
+}
+    } msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    super_abc destroy
+} -result {foo
+    while executing
+"::error foo"
+    (in definition script for class "::def" line 4)
+    invoked from within
+"oo::class create abc {
+    superclass super_abc
+    ::rename abc ::def
+    ::error foo
+}"}
+test oo-18.7 {OO: objdefine command support} -setup {
+    oo::object create ::inst
+} -body {
+    list [catch {oo::objdefine inst {rename ::inst ::INST;error foo}} msg] $msg $errorInfo
+} -cleanup {
+    catch {::inst destroy}
+    catch {::INST destroy}
+} -result {1 foo {foo
+    while executing
+"error foo"
+    (in definition script for object "::INST" line 1)
+    invoked from within
+"oo::objdefine inst {rename ::inst ::INST;error foo}"}}
+test oo-18.8 {OO: define/self command support} -setup {
+    oo::class create master
+    oo::class create ::foo {superclass master}
+} -body {
+    catch {oo::define foo {rename ::foo ::bar; self {error foobar}}} msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    master destroy
+} -result {foobar
+    while executing
+"error foobar"
+    (in definition script for class object "::bar" line 1)
+    invoked from within
+"self {error foobar}"
+    (in definition script for class "::bar" line 1)
+    invoked from within
+"oo::define foo {rename ::foo ::bar; self {error foobar}}"}
+test oo-18.9 {OO: define/self command support} -setup {
+    oo::class create master
+    set c [oo::class create now_this_is_a_very_very_long_class_name_indeed {
+        superclass master
+    }]
+} -body {
+    catch {oo::define $c {error err}} msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    master destroy
+} -result {err
+    while executing
+"error err"
+    (in definition script for class "::now_this_is_a_very_very_long..." line 1)
+    invoked from within
+"oo::define $c {error err}"}
+test oo-18.10 {OO: define/self command support} -setup {
+    oo::class create master
+    oo::class create ::foo {superclass master}
+} -body {
+    catch {oo::define foo {self {rename ::foo {}; error foobar}}} msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    master destroy
+} -result {foobar
+    while executing
+"error foobar"
+    (in definition script for class object "::foo" line 1)
+    invoked from within
+"self {rename ::foo {}; error foobar}"
+    (in definition script for class "::foo" line 1)
+    invoked from within
+"oo::define foo {self {rename ::foo {}; error foobar}}"}
+test oo-18.11 {OO: define/self command support} -setup {
+    oo::class create master
+    oo::class create ::foo {superclass master}
+} -body {
+    catch {oo::define foo {rename ::foo {}; self {error foobar}}} msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    master destroy
+} -result {this command cannot be called when the object has been deleted
+    while executing
+"self {error foobar}"
+    (in definition script for class "::foo" line 1)
+    invoked from within
+"oo::define foo {rename ::foo {}; self {error foobar}}"}
 
 test oo-19.1 {OO: varname method} -setup {
     oo::object create inst
@@ -3189,7 +3289,7 @@ test oo-33.2 {TIP 380: slots - defaulting} -setup {
 } -cleanup {
     rename $s {}
 } -result {{} {a b c destroy unknown}}
-test oo-32.3 {TIP 380: slots - defaulting} -setup {
+test oo-33.3 {TIP 380: slots - defaulting} -setup {
     set s [SampleSlot new]
 } -body {
     oo::objdefine $s forward --default-operation  my -set
diff --git a/tests/socket.test b/tests/socket.test
index f06a548..d88eb65 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -64,7 +64,7 @@ package require tcltest 2
 namespace import -force ::tcltest::*
 
 # Some tests require the Thread package or exec command
-testConstraint thread [expr {0 == [catch {package require Thread 2.6}]}]
+testConstraint thread [expr {0 == [catch {package require Thread 2.6.6}]}]
 testConstraint exec [llength [info commands exec]]
 
 # Produce a random port number in the Dynamic/Private range
diff --git a/tests/winDde.test b/tests/winDde.test
index ca50a96..bc64a24 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -156,6 +156,20 @@ test winDde-3.5 {DDE request locally} {win dde} {
     dde execute TclEval self {set a "foo"}
     dde request -binary TclEval self a
 } "foo\x00"
+# Set variable a to A with diaeresis (unicode C4) by relying on the fact
+# that utf8 is sent (e.g. "c3 84" on the wire)
+test winDde-3.6 {DDE request utf8} {win dde} {
+    set a "not set"
+    dde execute TclEval self "set a \xc4"
+    scan $a %c
+} 196
+# Set variable a to A with diaeresis (unicode C4) using binary execute
+# and compose utf-8 (e.g. "c3 84" ) manualy
+test winDde-3.7 {DDE request binary} {win dde} {
+    set a "not set"
+    dde execute -binary TclEval self "set a \xc3\x84\x00"
+    scan $a %c
+} 196
 
 # -------------------------------------------------------------------------
 
@@ -202,13 +216,13 @@ test winDde-4.4 {DDE eval remotely} {stdio win dde} {
 
 test winDde-5.1 {check for bad arguments} -constraints {win dde} -body {
     dde execute "" "" "" ""
-} -returnCodes error -result {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
+} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}
 test winDde-5.2 {check for bad arguments} -constraints {win dde} -body {
     dde execute "" "" ""
 } -returnCodes error -result {cannot execute null data}
 test winDde-5.3 {check for bad arguments} -constraints {win dde} -body {
     dde execute -foo "" "" ""
-} -returnCodes error -result {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
+} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}
 test winDde-5.4 {DDE eval bad arguments} -constraints {win dde} -body {
     dde eval "" "foo"
 } -returnCodes error -result {invalid service name ""}
diff --git a/tests/zlib.test b/tests/zlib.test
index 6c0e4f8..5935fbe 100644
--- a/tests/zlib.test
+++ b/tests/zlib.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.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2.1
     namespace import -force ::tcltest::*
 }
@@ -70,7 +70,7 @@ test zlib-7.0 {zlib stream} -constraints zlib -returnCodes error -setup {
     $s ?
 } -cleanup {
     $s close
-} -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, put, or reset}
+} -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, header, put, or reset}
 test zlib-7.1 {zlib stream} zlib {
     set s [zlib stream compress]
     $s put -finalize abcdeEDCBA
@@ -169,7 +169,25 @@ test zlib-8.4 {transformation and flushing: Bug 3517696} -setup {
     catch {close $fd}
     removeFile $file
 } -result {}
-test zlib-8.5 {transformation and fconfigure} -setup {
+test zlib-8.5 {transformation and flushing and fileevents: Bug 3525907} -setup {
+    foreach {r w} [chan pipe] break
+} -constraints zlib -body {
+    set ::res {}
+    fconfigure $w -buffering none
+    zlib push compress $w
+    puts -nonewline $w qwertyuiop
+    chan configure $w -flush sync
+    after 500 {puts -nonewline $w asdfghjkl;close $w}
+    fconfigure $r -blocking 0 -buffering none
+    zlib push decompress $r
+    fileevent $r readable {set msg [read $r];lappend ::res $msg;if {[eof $r]} {set ::done 1}}
+    after 250 {lappend ::res MIDDLE}
+    vwait ::done
+    set ::res
+} -cleanup {
+    catch {close $r}
+} -result {qwertyuiop MIDDLE asdfghjkl}
+test zlib-8.6 {transformation and fconfigure} -setup {
     set file [makeFile {} test.z]
     set fd [open $file wb]
 } -constraints zlib -body {
@@ -179,7 +197,7 @@ test zlib-8.5 {transformation and fconfigure} -setup {
     catch {close $fd}
     removeFile $file
 } -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
-test zlib-8.6 {transformation and fconfigure} -setup {
+test zlib-8.7 {transformation and fconfigure} -setup {
     set file [makeFile {} test.gz]
     set fd [open $file wb]
 } -constraints zlib -body {
@@ -189,7 +207,7 @@ test zlib-8.6 {transformation and fconfigure} -setup {
     catch {close $fd}
     removeFile $file
 } -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
-test zlib-8.7 {transformtion and fconfigure} -setup {
+test zlib-8.8 {transformtion and fconfigure} -setup {
     lassign [chan pipe] inSide outSide
     set msg [string repeat "am i all that i am at all? i am all that i am!" 400]
     set dict "thatallam i "