merged tcl 8.1 branch back into the main trunk

1 files changed, 152 insertions, 0 deletions

diff --git a/tests/winDde.test b/tests/winDde.test
new file mode 100644
index 0000000..e9b65d8
--- /dev/null
+++ b/tests/winDde.test
@@ -0,0 +1,152 @@
+# This file tests the tclWinDde.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1999 by Scriptics Corporation.
+#
+# 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.2 1999/04/16 00:47:37 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {$tcl_platform(platform) == "windows"} {
+    if [catch {
+	set lib [lindex [glob [file join [pwd] [file dirname \
+		[info nameofexecutable]] tcldde*.dll]] 0]
+	load $lib dde
+    }] {
+	puts "Unable to find the dde package. Skipping registry tests."
+	::tcltest::cleanupTests
+	return
+    }
+}
+
+set scriptName script1.tcl
+
+
+proc createChildProcess { ddeServerName } {
+    
+    file delete -force $::scriptName
+    
+    set f [open $::scriptName w+]
+    puts $f {
+	if [catch {
+	    set lib [lindex [glob [file join [pwd] [file dirname \
+		    [info nameofexecutable]] tcldde*.dll]] 0]
+	    load $lib dde
+	}] {
+	    puts "Unable to find the dde package. Skipping registry tests."
+	    ::tcltest::cleanupTests
+	    return
+	}
+    }
+    puts $f "dde servername $ddeServerName"
+    puts $f {
+	puts ready
+	vwait done
+	update
+	exit
+    }
+    close $f
+    
+    set f [open "|$::tcltest $::scriptName" r]
+    gets $f
+    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}
+
+test winDde-2.1 {Checking for other services} {pcOnly} {
+    expr [llength [dde services {} {}]] >= 0
+} 1
+
+test winDde-2.2 {Checking for existence, with service and topic specified} \
+	{pcOnly} {
+    llength [dde services TclEval self]
+} 1
+
+test winDde-2.3 {Checking for existence, with only the service specified} \
+	{pcOnly} {
+    expr [llength [dde services TclEval {}]] >= 1
+} 1
+
+test winDde-3.1 {DDE execute locally} {pcOnly} {
+    set a ""
+    dde execute TclEval self {set a "foo"}
+    set a
+} foo
+
+test winDde-3.2 {DDE execute -async locally} {pcOnly} {
+    set a ""
+    dde execute -async TclEval self {set a "foo"}
+    update
+    set a
+} foo
+
+test winDde-3.3 {DDE request locally} {pcOnly} {
+    set a ""
+    dde execute TclEval self {set a "foo"}
+    dde request TclEval self a
+} foo
+
+test winDde-3.4 {DDE eval locally} {pcOnly} {
+    set a ""
+    dde eval self set a "foo"
+} foo
+
+test winDde-4.1 {DDE execute remotely} {pcOnly} {
+    set a ""
+    set child [createChildProcess child]
+    dde execute TclEval child {set a "foo"}
+
+    dde execute TclEval child {set done 1}
+
+    set a
+} ""
+
+test winDde-4.2 {DDE execute remotely} {pcOnly} {
+    set a ""
+    set child [createChildProcess child]
+    dde execute -async TclEval child {set a "foo"}
+
+    dde execute TclEval child {set done 1}
+
+    set a
+} ""
+
+test winDde-4.3 {DDE request locally} {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 a
+} foo
+
+test winDde-4.4 {DDE eval locally} {pcOnly} {
+    set a ""
+    set child [createChildProcess child]
+    set a [dde eval child set a "foo"]
+
+    dde execute TclEval child {set done 1}
+
+    set a
+} foo
+
+
+#cleanup
+file delete -force $::scriptName
+::tcltest::cleanupTests
+return
+