diff options
Diffstat (limited to 'tests/winDde.test')
-rw-r--r-- | tests/winDde.test | 152 |
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 + |