summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorpatthoyts <patthoyts@users.sourceforge.net>2003-06-23 21:27:56 (GMT)
committerpatthoyts <patthoyts@users.sourceforge.net>2003-06-23 21:27:56 (GMT)
commitedc0b0eed5666acae801e952c5cd3c6bcd5fca8a (patch)
treeb5e2d479b19b959a1a4294fc5ab271991b070c1d /tests
parenta577b700081eed8aa4df896f66e1091160a91623 (diff)
downloadtcl-edc0b0eed5666acae801e952c5cd3c6bcd5fca8a.zip
tcl-edc0b0eed5666acae801e952c5cd3c6bcd5fca8a.tar.gz
tcl-edc0b0eed5666acae801e952c5cd3c6bcd5fca8a.tar.bz2
* doc/dde.n: Committed TIP #120 which provides the
* win/tclWinDde.c: dde package for safe interpreters. * tests/winDde.test: Incremented package version to 1.2.4 * library/dde/pkgIndex.tcl:
Diffstat (limited to 'tests')
-rw-r--r--tests/winDde.test264
1 files changed, 254 insertions, 10 deletions
diff --git a/tests/winDde.test b/tests/winDde.test
index 06dab25..a23650d 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -2,17 +2,18 @@
#
# 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.
+# 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.16 2003/05/16 22:00:47 patthoyts Exp $
+# RCS: @(#) $Id: winDde.test,v 1.17 2003/06/23 21:27:56 patthoyts Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
+ #tcltest::configure -verbose {pass start}
namespace import -force ::tcltest::*
}
@@ -34,10 +35,11 @@ if {$tcl_platform(platform) == "windows"} {
set scriptName [makeFile {} script1.tcl]
-proc createChildProcess { ddeServerName } {
+proc createChildProcess { ddeServerName {handler {}}} {
file delete -force $::scriptName
set f [open $::scriptName w+]
+ puts $f [list set ddeServerName $ddeServerName]
puts $f {
# DDE child server -
#
@@ -59,15 +61,37 @@ proc createChildProcess { ddeServerName } {
# If an error occurs during the tests, this process may end up not
# being closed down. To deal with this we create a 30s timeout.
- proc DoTimeout {} {
- global done
- puts stderr "winDde.test child process $ddeServerName timed out."
+ proc ::DoTimeout {} {
+ global done ddeServerName
set done 1
+ puts "winDde.test child process $ddeServerName timed out."
+ flush stdout
+ }
+ set timeout [after 30000 ::DoTimeout]
+
+ # Define a restricted handler.
+ proc Handler1 {cmd} {
+ if {$cmd eq "stop"} {set ::done 1}
+ puts $cmd ; flush stdout
+ return
+ }
+ proc Handler2 {cmd} {
+ if {$cmd eq "stop"} {set ::done 1}
+ puts [uplevel \#0 $cmd] ; flush stdout
+ return
+ }
+ proc Handler3 {prefix cmd} {
+ if {$cmd eq "stop"} {set ::done 1}
+ puts [list $prefix $cmd] ; flush stdout
+ return
}
- set timeout [after 30000 DoTimeout]
}
# set the dde server name to the supplied argument.
- puts $f [list dde servername $ddeServerName]
+ if {$handler == {}} {
+ puts $f [list dde servername $ddeServerName]
+ } else {
+ puts $f [list dde servername -handler $handler -- $ddeServerName]
+ }
puts $f {
# run the server and handle final cleanup.
after 200;# give dde a chance to get going.
@@ -212,7 +236,7 @@ test winDde-5.4 {DDE eval bad arguments} {pcOnly} {
test winDde-6.1 {DDE servername bad arguments} \
-constraints pcOnly \
-body {list [catch {dde servername -z -z -z} msg] $msg} \
- -result {1 {wrong # args: should be "dde servername ?-exact? ?--? ?serverName?"}}
+ -result {1 {wrong # args: should be "dde servername ?-exact? ?-handler proc? ?--? ?serverName?"}}
test winDde-6.2 {DDE servername set name} \
-constraints pcOnly \
@@ -338,11 +362,231 @@ test winDde-7.5 {interp name collision without -exact} \
} \
-result "dde-interp-7.5 #2"
+# -------------------------------------------------------------------------
+
+test winDde-8.1 {Safe DDE load} \
+ -constraints pcOnly \
+ -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ } \
+ -body {
+ list [catch {slave eval dde servername slave} msg] $msg
+ } \
+ -cleanup {interp delete slave} \
+ -result {1 {invalid command name "dde"}}
+
+test winDde-8.2 {Safe DDE set servername} \
+ -constraints pcOnly \
+ -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ } \
+ -body {
+ slave invokehidden dde servername slave
+ } \
+ -cleanup {interp delete slave} \
+ -result {slave}
+
+test winDde-8.3 {Safe DDE check handler required for eval} \
+ -constraints pcOnly \
+ -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave invokehidden dde servername slave
+ } \
+ -body {
+ catch {dde eval slave set a 1} msg
+ } \
+ -cleanup {interp delete slave} \
+ -result {1}
+
+test winDde-8.4 {Safe DDE check that execute is denied} \
+ -constraints pcOnly \
+ -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave invokehidden dde servername slave
+ } \
+ -body {
+ slave eval set a 1
+ list [catch {
+ dde execute TclEval slave {set a 2}
+ slave eval set a
+ } msg] $msg
+ } \
+ -cleanup {interp delete slave} \
+ -result {0 1}
+
+test winDde-8.5 {Safe DDE check that request is denied} \
+ -constraints pcOnly \
+ -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave invokehidden dde servername slave
+ } \
+ -body {
+ slave eval set a 1
+ list [catch {dde request TclEval slave a} msg] $msg
+ } \
+ -cleanup {interp delete slave} \
+ -result {1 {remote server cannot handle this command}}
+
+test winDde-8.6 {Safe DDE assign handler procedure} \
+ -constraints pcOnly \
+ -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+ } \
+ -body {
+ slave invokehidden dde servername -handler DDEACCEPT slave
+ } \
+ -cleanup {interp delete slave} \
+ -result slave
+
+test winDde-8.7 {Safe DDE check simple command} \
+ -constraints pcOnly \
+ -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+ slave invokehidden dde servername -handler DDEACCEPT slave
+ } \
+ -body {
+ list [catch {
+ dde eval slave set x 1
+ } msg] $msg
+ } \
+ -cleanup {interp delete slave} \
+ -result {0 {set x 1}}
+
+test winDde-8.8 {Safe DDE check non-list command} \
+ -constraints pcOnly \
+ -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+ slave invokehidden dde servername -handler DDEACCEPT slave
+ } \
+ -body {
+ list [catch {
+ set s "c:\\Program Files\\Microsoft Visual Studio\\"
+ dde eval slave $s
+ string compare [slave eval set DDECMD] $s
+ } msg] $msg
+ } \
+ -cleanup {interp delete slave} \
+ -result {0 0}
+
+test winDde-8.9 {Safe DDE check command evaluation} \
+ -constraints pcOnly \
+ -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel #0 $cmd]}}
+ slave invokehidden dde servername -handler DDEACCEPT slave
+ } \
+ -body {
+ list [catch {
+ dde eval slave set x 1
+ slave eval set x
+ } msg] $msg
+ } \
+ -cleanup {interp delete slave} \
+ -result {0 1}
+
+test winDde-8.10 {Safe DDE check command evaluation (2)} \
+ -constraints pcOnly \
+ -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel #0 $cmd]}}
+ slave invokehidden dde servername -handler DDEACCEPT slave
+ } \
+ -body {
+ list [catch {
+ dde eval slave [list set x 1]
+ slave eval set x
+ } msg] $msg
+ } \
+ -cleanup {interp delete slave} \
+ -result {0 1}
+
+test winDde-8.11 {Safe DDE check command evaluation (3)} \
+ -constraints pcOnly \
+ -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel #0 $cmd]}}
+ slave invokehidden dde servername -handler DDEACCEPT slave
+ } \
+ -body {
+ list [catch {
+ dde eval slave [list [list set x 1]]
+ slave eval set x
+ } msg] $msg
+ } \
+ -cleanup {interp delete slave} \
+ -result {1 {invalid command name "set x 1"}}
+
+# -------------------------------------------------------------------------
+
+test winDde-9.1 {External safe DDE check string passing} \
+ -constraints {pcOnly stdio} \
+ -setup {
+ set name child-9.1
+ set child [createChildProcess $name Handler1]
+ file copy -force script1.tcl dde-script.tcl
+ } \
+ -body {
+ list [catch {
+ dde eval $name set x 1
+ gets $child line
+ set line
+ } msg] $msg
+ } \
+ -cleanup {dde execute TclEval $name stop ; update} \
+ -result {0 {set x 1}}
+
+test winDde-9.2 {External safe DDE check command evaluation} \
+ -constraints {pcOnly stdio} \
+ -setup {
+ set name child-9.2
+ set child [createChildProcess $name Handler2]
+ file copy -force script1.tcl dde-script.tcl
+ } \
+ -body {
+ list [catch {
+ dde eval $name set x 1
+ gets $child line
+ set line
+ } msg] $msg
+ } \
+ -cleanup {dde execute TclEval $name stop ; update} \
+ -result {0 1}
+
+test winDde-9.3 {External safe DDE check prefixed arguments} \
+ -constraints {pcOnly stdio} \
+ -setup {
+ set name child-9.3
+ set child [createChildProcess $name [list Handler3 ARG]]
+ file copy -force script1.tcl dde-script.tcl
+ } \
+ -body {
+ list [catch {
+ dde eval $name set x 1
+ gets $child line
+ set line
+ } msg] $msg
+ } \
+ -cleanup {dde execute TclEval $name stop ; update} \
+ -result {0 {ARG {set x 1}}}
# -------------------------------------------------------------------------
#cleanup
-catch {interp delete $slave}; # ensure we clean up the slave.
+#catch {interp delete $slave}; # ensure we clean up the slave.
file delete -force $::scriptName
::tcltest::cleanupTests
return