* 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]

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: