summaryrefslogtreecommitdiffstats
path: root/tests/filebox.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/filebox.test')
-rw-r--r--tests/filebox.test77
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
+
+
+
+
+
+
+
+
+
+
+
+
+