diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/winDde.test | 159 |
1 files changed, 140 insertions, 19 deletions
diff --git a/tests/winDde.test b/tests/winDde.test index bcf0c9b..a1a8dab 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winDde.test,v 1.14 2003/03/22 23:01:22 patthoyts Exp $ +# RCS: @(#) $Id: winDde.test,v 1.15 2003/05/16 17:29:49 patthoyts Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -28,17 +28,24 @@ if {$tcl_platform(platform) == "windows"} { } } -set scriptName script1.tcl +# ------------------------------------------------------------------------- +# Setup a script for a test server +# + +set scriptName [makeFile {} script1.tcl] proc createChildProcess { ddeServerName } { file delete -force $::scriptName set f [open $::scriptName w+] puts $f { + # DDE child server - + # if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } + # Load the dde package to test. if [catch { set lib [lindex [glob -directory \ [file join [pwd] [file dirname [info nameofexecutable]]] \ @@ -49,9 +56,20 @@ proc createChildProcess { ddeServerName } { ::tcltest::cleanupTests return } + + # If an error occurs during the tests, this process may end up not + # being closed down. To deal with this we create a 30s timeout. + proc DoTimeout {} { + global done + puts stderr "winDde.test child process $ddeServerName timed out." + set done 1 + } + set timeout [after 30000 DoTimeout] } + # set the dde server name to the supplied argument. puts $f [list dde servername $ddeServerName] puts $f { + # run the server and handle final cleanup. puts ready flush stdout vwait done @@ -60,12 +78,15 @@ proc createChildProcess { ddeServerName } { } close $f + # run the child server script. set f [open |[list [interpreter] $::scriptName] r] fconfigure $f -buffering line gets $f line return $f } +# ------------------------------------------------------------------------- + test winDde-1.1 {Settings the server's topic name} {pcOnly} { list [dde servername foobar] [dde servername] [dde servername self] } {foobar foobar self} @@ -89,6 +110,8 @@ test winDde-2.4 {Checking for existence, with only the topic specified} \ expr [llength [dde services {} self]] >= 1 } 1 +# ------------------------------------------------------------------------- + test winDde-3.1 {DDE execute locally} {pcOnly} { set a "" dde execute TclEval self {set a "foo"} @@ -119,43 +142,51 @@ test winDde-3.5 {DDE request locally} {pcOnly} { dde request -binary TclEval self a } "foo\x00" +# ------------------------------------------------------------------------- + test winDde-4.1 {DDE execute remotely} {stdio pcOnly} { set a "" - set child [createChildProcess child] - dde execute TclEval child {set a "foo"} - dde execute TclEval child {set done 1} - + set name child-4.1 + set child [createChildProcess $name] + dde execute TclEval $name {set a "foo"} + dde execute TclEval $name {set done 1} + update set a } "" test winDde-4.2 {DDE execute async remotely} {stdio pcOnly} { set a "" - set child [createChildProcess child] - dde execute -async TclEval child {set a "foo"} - dde execute TclEval child {set done 1} - + set name child-4.2 + set child [createChildProcess $name] + dde execute -async TclEval $name {set a "foo"} + dde execute TclEval $name {set done 1} + update set a } "" test winDde-4.3 {DDE request remotely} {stdio pcOnly} { set a "" - set child [createChildProcess child] - dde execute TclEval child {set a "foo"} - set a [dde request TclEval child a] - dde execute TclEval child {set done 1} - + set name chile-4.3 + set child [createChildProcess $name] + dde execute TclEval $name {set a "foo"} + set a [dde request TclEval $name a] + dde execute TclEval $name {set done 1} + update set a } foo test winDde-4.4 {DDE eval remotely} {stdio pcOnly} { set a "" - set child [createChildProcess child] - set a [dde eval child set a "foo"] - dde execute TclEval child {set done 1} - + set name child-4.4 + set child [createChildProcess $name] + set a [dde eval $name set a "foo"] + dde execute TclEval $name {set done 1} + update set a } foo +# ------------------------------------------------------------------------- + test winDde-5.1 {check for bad arguments} {pcOnly} { catch {dde execute "" "" "" ""} result set result @@ -175,7 +206,97 @@ test winDde-5.4 {DDE eval bad arguments} {pcOnly} { list [catch {dde eval "" "foo"} msg] $msg } {1 {invalid service name ""}} +# ------------------------------------------------------------------------- + +test winDde-6.1 {DDE servername bad arguments} {pcOnly} { + list [catch {dde servername -z -z -z} msg] $msg +} {1 {wrong # args: should be "dde servername ?-exact? ?--? ?serverName?"}} + +test winDde-6.2 {DDE servername set name} {pcOnly} { + list [catch {dde servername -- winDde-6.2} msg] $msg +} {0 winDde-6.2} + +test winDde-6.3 {DDE servername set exact name} {pcOnly} { + list [catch {dde servername -exact winDde-6.3} msg] $msg +} {0 winDde-6.3} + +test winDde-6.4 {DDE servername set exact name} {pcOnly} { + list [catch {dde servername -exact -- winDde-6.4} msg] $msg +} {0 winDde-6.4} + +test winDde-6.5 {DDE remote servername collision} {stdio pcOnly} { + set a "" + set name child-6.5 + set child [createChildProcess $name] + list [catch { + set a [dde servername -- $name] + dde execute TclEval $name {set done 1} + update + set a + } r] $r +} {0 {child-6.5 #2}} + +test winDde-6.6 {DDE remote servername collision force} {stdio pcOnly} { + set a "" + set name child-6.6 + set child [createChildProcess $name] + list [catch { + set a [dde servername -exact -- $name] + dde execute TclEval $name {set done 1} + update + set a + } r] $r +} {0 child-6.6} + +# ------------------------------------------------------------------------- + +test winDde-7.1 {DDE in slave interpreter} {pcOnly} { + global slave + set name slave-7.1 + list [catch { + set slave [interp create $name] + $slave eval [list load $lib dde] + $slave eval [list dde servername $name] + } msg] $msg +} {0 slave-7.1} + +test winDde-7.2 {DDE present in slave interp} {pcOnly} { + global slave + list [catch { + dde services TclEval $slave + } msg] $msg +} [list 0 [list [list TclEval $slave]]] + +test winDde-7.3 {DDE slave servername collision force} {pcOnly} { + global slave + list [catch {dde servername -exact -- $slave} msg] $msg +} [list 0 $slave] + +test winDde-7.4 {DDE slave servername collision} {pcOnly} { + global slave + list [catch {dde servername -- $slave} msg] $msg +} [list 0 [list $slave "#2"]] + +test winDde-7.5 {DDE slave cleanup} {pcOnly} { + global slave + list [catch { + interp delete $slave + set s [dde services TclEval {}] + set m [list [list TclEval $slave]] + if {[lsearch -exact $s $m] != -1} { + set s + } + } msg] $msg +} {0 {}} + +# ------------------------------------------------------------------------- + #cleanup +catch {interp delete $slave}; # ensure we clean up the slave. file delete -force $::scriptName ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: |