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