* Merged 8.1 branch into the main trunk

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
+
+
+
+
+
+
+
+
+
+
+
+
+