summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorpatthoyts <patthoyts@users.sourceforge.net>2003-05-16 17:29:48 (GMT)
committerpatthoyts <patthoyts@users.sourceforge.net>2003-05-16 17:29:48 (GMT)
commit1e9f014619fc9378af51b46c9d2885235415c120 (patch)
treeee8888cd91836d4978a525fb48cd08f025351d3c /tests
parentdad6fa2036b108d4d7dfc733e4f5379d37770999 (diff)
downloadtcl-1e9f014619fc9378af51b46c9d2885235415c120.zip
tcl-1e9f014619fc9378af51b46c9d2885235415c120.tar.gz
tcl-1e9f014619fc9378af51b46c9d2885235415c120.tar.bz2
* library/dde/pkgIndex.tcl: Applied TIP #130 which provides
* tests/winDde.test: for unique dde server names. Added * win/tclWinDde.c: some more tests. Fixes [Bug 219293]
Diffstat (limited to 'tests')
-rw-r--r--tests/winDde.test159
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: