diff options
Diffstat (limited to 'tests/filebox.test')
| -rw-r--r-- | tests/filebox.test | 77 |
1 files changed, 44 insertions, 33 deletions
diff --git a/tests/filebox.test b/tests/filebox.test index 02e9295..e4bc512 100644 --- a/tests/filebox.test +++ b/tests/filebox.test @@ -3,15 +3,24 @@ # for Tcl tests. # # Copyright (c) 1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: filebox.test,v 1.5 1998/12/07 23:29:00 hershey Exp $ +# RCS: @(#) $Id: filebox.test,v 1.6 1999/04/16 01:51:37 stanton Exp $ # +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + set tk_strictMotif_old $tk_strictMotif +# Some tests require user interaction on non-unix platform + +set ::tcltest::testConfig(nonUnixUserInteraction) \ + [expr {$::tcltest::testConfig(userInteraction) || \ + $::tcltest::testConfig(unixOnly)}] + #---------------------------------------------------------------------- # # Procedures needed by this test file @@ -90,17 +99,18 @@ proc SendButtonPress {parent btn type} { # #---------------------------------------------------------------------- -if {[string compare test [info procs test]] == 1} { - source defs -} - if {$tcl_platform(platform) == "unix"} { set modes "0 1" } else { set modes 1 } -set unknownOptionsMsg {1 {unknown option "-foo", must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent or -title}} +set unknownOptionsMsg {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}} + +set tmpFile "filebox.tmp" +makeFile { + # this file can be empty! +} $tmpFile foreach mode $modes { @@ -118,11 +128,11 @@ foreach mode $modes { # foreach command "tk_getOpenFile tk_getSaveFile" { - test filebox-1.1 "$command command" { list [catch {$command -foo} msg] $msg } $unknownOptionsMsg + catch {$command -foo 1} msg regsub -all , $msg "" options regsub \"-foo\" $options "" options @@ -156,10 +166,6 @@ foreach mode $modes { set isNative 0 } - if {$isNative && ![info exists INTERACTIVE]} { - continue - } - set parent . set verylongstring longstring: @@ -174,52 +180,48 @@ foreach mode $modes { # set verylongstring $verylongstring$verylongstring set color #404040 - test filebox-2.1 "$command command" { + test filebox-2.1 "$command command" {nonUnixUserInteraction} { ToPressButton $parent cancel $command -title "Press Cancel ($verylongstring)" -parent $parent } "" - if {$command == "tk_getSaveFile"} { set fileName "12x 455" set fileDir [pwd] set pathName [file join [pwd] $fileName] } else { - set thisFile [info script] - set fileName [file tail $thisFile] - - # this file should be in the current working dir + set fileName $tmpFile set fileDir [pwd] set pathName [file join $fileDir $fileName] } - test filebox-2.2 "$command command" { + test filebox-2.2 "$command command" {nonUnixUserInteraction} { ToPressButton $parent ok set choice [$command -title "Press Ok" \ -parent $parent -initialfile $fileName -initialdir $fileDir] } $pathName - test filebox-2.3 "$command command" { + test filebox-2.3 "$command command" {nonUnixUserInteraction} { ToEnterFileByKey $parent $fileName $fileDir set choice [$command -title "Enter \"$fileName\" and press Ok" \ -parent $parent -initialdir $fileDir] } $pathName - test filebox-2.4 "$command command" { + test filebox-2.4 "$command command" {nonUnixUserInteraction} { ToPressButton $parent ok set choice [$command -title "Enter \"$fileName\" and press Ok" \ -parent $parent -initialdir . \ -initialfile $fileName] } $pathName - test filebox-2.5 "$command command" { + test filebox-2.5 "$command command" {nonUnixUserInteraction} { ToPressButton $parent ok set choice [$command -title "Enter \"$fileName\" and press Ok" \ -parent $parent -initialdir /badpath \ -initialfile $fileName] } $pathName - test filebox-2.6 "$command command" { + test filebox-2.6 "$command command" {nonUnixUserInteraction} { toplevel .t1; toplevel .t2 ToPressButton .t1 ok set choice {} @@ -264,7 +266,7 @@ foreach mode $modes { } foreach x [lsort -integer [array names filters]] { - test filebox-3.$x "$command command" { + test filebox-3.$x "$command command" {nonUnixUserInteraction} { ToPressButton $parent ok set choice [$command -title "Press Ok" -filetypes $filters($x)\ -parent $parent -initialfile $fileName -initialdir $fileDir] @@ -288,10 +290,19 @@ foreach mode $modes { set tk_strictMotif $tk_strictMotif_old -if {$isNative && ![info exists INTERACTIVE]} { - puts " Some tests were skipped because they could not be performed" - puts " automatically on this platform. If you wish to execute them" - puts " interactively, set the TCL variable INTERACTIVE and re-run" - puts " the test." - return -} +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + |