os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/winDde.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/winDde.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,183 @@
1.4 +# This file tests the tclWinDde.c file.
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1999 by Scriptics Corporation.
1.11 +#
1.12 +# See the file "license.terms" for information on usage and redistribution
1.13 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.14 +#
1.15 +# RCS: @(#) $Id: winDde.test,v 1.13.2.2 2005/06/21 22:59:03 patthoyts Exp $
1.16 +
1.17 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.18 + package require tcltest
1.19 + namespace import -force ::tcltest::*
1.20 +}
1.21 +
1.22 +if {$tcl_platform(platform) == "windows"} {
1.23 + if [catch {
1.24 + set lib [lindex [glob -directory [file join [pwd] [file dirname \
1.25 + [info nameofexecutable]]] tcldde*.dll] 0]
1.26 + load $lib dde
1.27 + }] {
1.28 + puts "WARNING: Unable to find the dde package. Skipping dde tests."
1.29 + ::tcltest::cleanupTests
1.30 + return
1.31 + }
1.32 +}
1.33 +
1.34 +set scriptName script1.tcl
1.35 +
1.36 +proc createChildProcess { ddeServerName } {
1.37 + file delete -force $::scriptName
1.38 +
1.39 + set f [open $::scriptName w+]
1.40 + puts $f {
1.41 + if {[lsearch [namespace children] ::tcltest] == -1} {
1.42 + package require tcltest
1.43 + namespace import -force ::tcltest::*
1.44 + }
1.45 + if [catch {
1.46 + set lib [lindex [glob -directory \
1.47 + [file join [pwd] [file dirname [info nameofexecutable]]] \
1.48 + tcldde*.dll] 0]
1.49 + load $lib dde
1.50 + }] {
1.51 + puts "Unable to find the dde package. Skipping dde tests."
1.52 + ::tcltest::cleanupTests
1.53 + return
1.54 + }
1.55 + }
1.56 + puts $f [list dde servername $ddeServerName]
1.57 + puts $f {
1.58 + after 200 {set ready 1}
1.59 + vwait ready
1.60 + puts ready
1.61 + vwait done
1.62 + after 200 {set final 1}
1.63 + vwait final
1.64 + exit
1.65 + }
1.66 + close $f
1.67 +
1.68 + set f [open |[list [interpreter] $::scriptName] r]
1.69 + fconfigure $f -buffering line -blocking 1
1.70 + gets $f
1.71 + return $f
1.72 +}
1.73 +
1.74 +test winDde-1.1 {Settings the server's topic name} {pcOnly} {
1.75 + list [dde servername foobar] [dde servername] [dde servername self]
1.76 +} {foobar foobar self}
1.77 +
1.78 +test winDde-2.1 {Checking for other services} {pcOnly} {
1.79 + expr [llength [dde services {} {}]] >= 0
1.80 +} 1
1.81 +
1.82 +test winDde-2.2 {Checking for existence, with service and topic specified} \
1.83 + {pcOnly} {
1.84 + llength [dde services TclEval self]
1.85 +} 1
1.86 +
1.87 +test winDde-2.3 {Checking for existence, with only the service specified} \
1.88 + {pcOnly} {
1.89 + expr [llength [dde services TclEval {}]] >= 1
1.90 +} 1
1.91 +
1.92 +test winDde-3.1 {DDE execute locally} {pcOnly} {
1.93 + set a ""
1.94 + dde execute TclEval self {set a "foo"}
1.95 + set a
1.96 +} foo
1.97 +
1.98 +test winDde-3.2 {DDE execute -async locally} {pcOnly} {
1.99 + set a ""
1.100 + dde execute -async TclEval self {set a "foo"}
1.101 + update
1.102 + set a
1.103 +} foo
1.104 +
1.105 +test winDde-3.3 {DDE request locally} {pcOnly} {
1.106 + set a ""
1.107 + dde execute TclEval self {set a "foo"}
1.108 + dde request TclEval self a
1.109 +} foo
1.110 +
1.111 +test winDde-3.4 {DDE eval locally} {pcOnly} {
1.112 + set a ""
1.113 + dde eval self set a "foo"
1.114 +} foo
1.115 +
1.116 +test winDde-3.5 {DDE request locally} {pcOnly} {
1.117 + set a ""
1.118 + dde execute TclEval self {set a "foo"}
1.119 + dde request -binary TclEval self a
1.120 +} "foo\x00"
1.121 +
1.122 +test winDde-4.1 {DDE execute remotely} {stdio pcOnly} {
1.123 + list [catch {
1.124 + set a ""
1.125 + set child [createChildProcess child]
1.126 + dde execute TclEval child {set a "foo"}
1.127 + dde execute TclEval child {set done 1}
1.128 + set a
1.129 + } err] $err
1.130 +} [list 0 ""]
1.131 +
1.132 +test winDde-4.2 {DDE execute remotely} {stdio pcOnly} {
1.133 + list [catch {
1.134 + set a ""
1.135 + set child [createChildProcess child]
1.136 + dde execute -async TclEval child {set a "foo"}
1.137 + after 400 {set ::_dde_forever 1} ; vwait ::_dde_forever; #update
1.138 + dde execute TclEval child {set done 1}
1.139 + set a
1.140 + } err] $err
1.141 +} [list 0 ""]
1.142 +
1.143 +test winDde-4.3 {DDE request locally} {stdio pcOnly} {
1.144 + list [catch {
1.145 + set a ""
1.146 + set child [createChildProcess child]
1.147 + dde execute TclEval child {set a "foo"}
1.148 + set a [dde request TclEval child a]
1.149 + dde execute TclEval child {set done 1}
1.150 + set a
1.151 + } err] $err
1.152 +} [list 0 foo]
1.153 +
1.154 +test winDde-4.4 {DDE eval locally} {stdio pcOnly} {
1.155 + list [catch {
1.156 + set a ""
1.157 + set child [createChildProcess child]
1.158 + set a [dde eval child set a "foo"]
1.159 + dde execute TclEval child {set done 1}
1.160 + set a
1.161 + } err] $err
1.162 +} [list 0 foo]
1.163 +
1.164 +test winDde-5.1 {check for bad arguments} {pcOnly} {
1.165 + catch {dde execute "" "" "" ""} result
1.166 + set result
1.167 +} {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
1.168 +
1.169 +test winDde-5.2 {check for bad arguments} {pcOnly} {
1.170 + catch {dde execute "" "" ""} result
1.171 + set result
1.172 +} {cannot execute null data}
1.173 +
1.174 +test winDde-5.3 {check for bad arguments} {pcOnly} {
1.175 + catch {dde execute -foo "" "" ""} result
1.176 + set result
1.177 +} {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
1.178 +
1.179 +test winDde-5.4 {DDE eval bad arguments} {pcOnly} {
1.180 + list [catch {dde eval "" "foo"} msg] $msg
1.181 +} {1 {invalid service name ""}}
1.182 +
1.183 +#cleanup
1.184 +file delete -force $::scriptName
1.185 +::tcltest::cleanupTests
1.186 +return