# 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. if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } if {$tcl_platform(platform) == "windows"} { if [catch { set lib [lindex [glob -directory [file join [pwd] [file dirname \ [info nameofexecutable]]] tcldde*.dll] 0] load $lib dde }] { puts "WARNING: Unable to find the dde package. Skipping dde tests." ::tcltest::cleanupTests return } } set scriptName script1.tcl proc createChildProcess { ddeServerName } { file delete -force $::scriptName set f [open $::scriptName w+] puts $f { if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } if [catch { set lib [lindex [glob -directory \ [file join [pwd] [file dirname [info nameofexecutable]]] \ tcldde*.dll] 0] load $lib dde }] { puts "Unable to find the dde package. Skipping dde tests." ::tcltest::cleanupTests return } } puts $f [list dde servername $ddeServerName] puts $f { after 200 {set ready 1} vwait ready puts ready vwait done after 200 {set final 1} vwait final exit } close $f set f [open |[list [interpreter] $::scriptName] r] fconfigure $f -buffering line -blocking 1 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-3.5 {DDE request locally} {pcOnly} { set a "" dde execute TclEval self {set a "foo"} dde request -binary TclEval self a } "foo\x00" # ------------------------------------------------------------------------- test winDde-4.1 {DDE execute remotely} {stdio pcOnly} { set a "" 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 name child-4.2 set child [createChildProcess $name] dde execute -async TclEval $name {set a "foo"} update dde execute TclEval $name {set done 1} update set a } "" test winDde-4.3 {DDE request remotely} {stdio pcOnly} { set a "" 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 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 } {wrong # args: should be "dde execute ?-async? serviceName topicName value"} test winDde-5.2 {check for bad arguments} {pcOnly} { catch {dde execute "" "" ""} result set result } {cannot execute null data} test winDde-5.3 {check for bad arguments} {pcOnly} { catch {dde execute -foo "" "" ""} result set result } {wrong # args: should be "dde execute ?-async? serviceName topicName value"} test winDde-5.4 {DDE eval bad arguments} {pcOnly} { list [catch {dde eval "" "foo"} msg] $msg } {1 {invalid service name ""}} # ------------------------------------------------------------------------- #cleanup #catch {interp delete $slave}; # ensure we clean up the slave. file delete -force $::scriptName ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: