sl@0: # This file tests the tclWinDde.c file.
sl@0: #
sl@0: # This file contains a collection of tests for one or more of the Tcl
sl@0: # built-in commands.  Sourcing this file into Tcl runs the tests and
sl@0: # generates output for errors.  No output means no errors were found.
sl@0: #
sl@0: # Copyright (c) 1999 by Scriptics Corporation.
sl@0: #
sl@0: # See the file "license.terms" for information on usage and redistribution
sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0: #
sl@0: # RCS: @(#) $Id: winDde.test,v 1.13.2.2 2005/06/21 22:59:03 patthoyts Exp $
sl@0: 
sl@0: if {[lsearch [namespace children] ::tcltest] == -1} {
sl@0:     package require tcltest
sl@0:     namespace import -force ::tcltest::*
sl@0: }
sl@0: 
sl@0: if {$tcl_platform(platform) == "windows"} {
sl@0:     if [catch {
sl@0: 	set lib [lindex [glob -directory [file join [pwd] [file dirname \
sl@0: 		[info nameofexecutable]]] tcldde*.dll] 0]
sl@0: 	load $lib dde
sl@0:     }] {
sl@0: 	puts "WARNING: Unable to find the dde package. Skipping dde tests."
sl@0: 	::tcltest::cleanupTests
sl@0: 	return
sl@0:     }
sl@0: }
sl@0: 
sl@0: set scriptName script1.tcl
sl@0: 
sl@0: proc createChildProcess { ddeServerName } {
sl@0:     file delete -force $::scriptName
sl@0: 
sl@0:     set f [open $::scriptName w+]
sl@0:     puts $f {
sl@0: 	if {[lsearch [namespace children] ::tcltest] == -1} {
sl@0: 	    package require tcltest
sl@0: 	    namespace import -force ::tcltest::*
sl@0: 	}
sl@0: 	if [catch {
sl@0: 	    set lib [lindex [glob -directory \
sl@0: 		    [file join [pwd] [file dirname [info nameofexecutable]]] \
sl@0: 		    tcldde*.dll] 0]
sl@0: 	    load $lib dde
sl@0: 	}] {
sl@0: 	    puts "Unable to find the dde package. Skipping dde tests."
sl@0: 	    ::tcltest::cleanupTests
sl@0: 	    return
sl@0: 	}
sl@0:     }
sl@0:     puts $f [list dde servername $ddeServerName]
sl@0:     puts $f {
sl@0:         after 200 {set ready 1}
sl@0:         vwait ready
sl@0: 	puts ready
sl@0: 	vwait done
sl@0: 	after 200 {set final 1}
sl@0:         vwait final
sl@0: 	exit
sl@0:     }
sl@0:     close $f
sl@0:     
sl@0:     set f [open |[list [interpreter] $::scriptName] r]
sl@0:     fconfigure $f -buffering line -blocking 1
sl@0:     gets $f
sl@0:     return $f
sl@0: }
sl@0: 
sl@0: test winDde-1.1 {Settings the server's topic name} {pcOnly} {
sl@0:     list [dde servername foobar] [dde servername] [dde servername self]
sl@0: }  {foobar foobar self}
sl@0: 
sl@0: test winDde-2.1 {Checking for other services} {pcOnly} {
sl@0:     expr [llength [dde services {} {}]] >= 0
sl@0: } 1
sl@0: 
sl@0: test winDde-2.2 {Checking for existence, with service and topic specified} \
sl@0: 	{pcOnly} {
sl@0:     llength [dde services TclEval self]
sl@0: } 1
sl@0: 
sl@0: test winDde-2.3 {Checking for existence, with only the service specified} \
sl@0: 	{pcOnly} {
sl@0:     expr [llength [dde services TclEval {}]] >= 1
sl@0: } 1
sl@0: 
sl@0: test winDde-3.1 {DDE execute locally} {pcOnly} {
sl@0:     set a ""
sl@0:     dde execute TclEval self {set a "foo"}
sl@0:     set a
sl@0: } foo
sl@0: 
sl@0: test winDde-3.2 {DDE execute -async locally} {pcOnly} {
sl@0:     set a ""
sl@0:     dde execute -async TclEval self {set a "foo"}
sl@0:     update
sl@0:     set a
sl@0: } foo
sl@0: 
sl@0: test winDde-3.3 {DDE request locally} {pcOnly} {
sl@0:     set a ""
sl@0:     dde execute TclEval self {set a "foo"}
sl@0:     dde request TclEval self a
sl@0: } foo
sl@0: 
sl@0: test winDde-3.4 {DDE eval locally} {pcOnly} {
sl@0:     set a ""
sl@0:     dde eval self set a "foo"
sl@0: } foo
sl@0: 
sl@0: test winDde-3.5 {DDE request locally} {pcOnly} {
sl@0:     set a ""
sl@0:     dde execute TclEval self {set a "foo"}
sl@0:     dde request -binary TclEval self a
sl@0: } "foo\x00"
sl@0: 
sl@0: test winDde-4.1 {DDE execute remotely} {stdio pcOnly} {
sl@0:     list [catch {
sl@0:         set a ""
sl@0:         set child [createChildProcess child]
sl@0:         dde execute TclEval child {set a "foo"}
sl@0:         dde execute TclEval child {set done 1}
sl@0:         set a
sl@0:     } err] $err
sl@0: } [list 0 ""]
sl@0: 
sl@0: test winDde-4.2 {DDE execute remotely} {stdio pcOnly} {
sl@0:     list [catch {
sl@0:         set a ""
sl@0:         set child [createChildProcess child]
sl@0:         dde execute -async TclEval child {set a "foo"}
sl@0:         after 400 {set ::_dde_forever 1} ; vwait ::_dde_forever; #update
sl@0:         dde execute TclEval child {set done 1}
sl@0:         set a
sl@0:     } err] $err
sl@0: } [list 0 ""]
sl@0: 
sl@0: test winDde-4.3 {DDE request locally} {stdio pcOnly} {
sl@0:     list [catch {
sl@0:         set a ""
sl@0:         set child [createChildProcess child]
sl@0:         dde execute TclEval child {set a "foo"}
sl@0:         set a [dde request TclEval child a]
sl@0:         dde execute TclEval child {set done 1}
sl@0:         set a
sl@0:     } err] $err
sl@0: } [list 0 foo]
sl@0: 
sl@0: test winDde-4.4 {DDE eval locally} {stdio pcOnly} {
sl@0:     list [catch {
sl@0:         set a ""
sl@0:         set child [createChildProcess child]
sl@0:         set a [dde eval child set a "foo"]
sl@0:         dde execute TclEval child {set done 1}
sl@0:         set a
sl@0:     } err] $err
sl@0: } [list 0 foo]
sl@0: 
sl@0: test winDde-5.1 {check for bad arguments} {pcOnly} {
sl@0:     catch {dde execute "" "" "" ""} result
sl@0:     set result
sl@0: } {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
sl@0: 
sl@0: test winDde-5.2 {check for bad arguments} {pcOnly} {
sl@0:     catch {dde execute "" "" ""} result
sl@0:     set result
sl@0: } {cannot execute null data}
sl@0: 
sl@0: test winDde-5.3 {check for bad arguments} {pcOnly} {
sl@0:     catch {dde execute -foo "" "" ""} result
sl@0:     set result
sl@0: } {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
sl@0: 
sl@0: test winDde-5.4 {DDE eval bad arguments} {pcOnly} {
sl@0:     list [catch {dde eval "" "foo"} msg] $msg
sl@0: } {1 {invalid service name ""}}
sl@0: 
sl@0: #cleanup
sl@0: file delete -force $::scriptName
sl@0: ::tcltest::cleanupTests
sl@0: return