summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/filebox.test65
1 files changed, 64 insertions, 1 deletions
diff --git a/tests/filebox.test b/tests/filebox.test
index 9e9fe11..a99f99c 100644
--- a/tests/filebox.test
+++ b/tests/filebox.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: filebox.test,v 1.19 2007/10/25 21:44:23 hobbs Exp $
+# RCS: @(#) $Id: filebox.test,v 1.20 2007/11/26 20:00:53 kennykb Exp $
#
package require tcltest 2.1
@@ -401,6 +401,69 @@ foreach mode $modes {
} $pathName[lindex $addedExtensions $x]
}
+ if {!$mode} {
+
+ test filebox-7.1-$mode "tk_getOpenFile - directory not readable" \
+ -constraints nonUnixUserInteraction \
+ -setup {
+ rename ::tk_messageBox ::saved_messageBox
+ set ::gotmessage {}
+ proc tk_messageBox args {
+ set ::gotmessage $args
+ }
+ toplevel .t1
+ file mkdir [file join $fileDir NOTREADABLE]
+ file attributes [file join $fileDir NOTREADABLE] \
+ -permissions 300
+ } \
+ -cleanup {
+ rename ::tk_messageBox {}
+ rename ::saved_messageBox ::tk_messageBox
+ unset ::gotmessage
+ destroy .t1
+ file delete -force [file join $fileDir NOTREADABLE]
+ } \
+ -body {
+ ToEnterFileByKey .t1 NOTREADABLE $fileDir
+ ToPressButton .t1 ok
+ ToPressButton .t1 cancel
+ tk_getOpenFile -parent .t1 \
+ -title "Please select the NOTREADABLE directory" \
+ -initialdir $fileDir
+ set gotmessage
+ } \
+ -match glob \
+ -result "*NOTREADABLE*"
+
+ test filebox-7.2-$mode "tk_getOpenFile - bad file name" \
+ -constraints nonUnixUserInteraction \
+ -setup {
+ rename ::tk_messageBox ::saved_messageBox
+ set ::gotmessage {}
+ proc tk_messageBox args {
+ set ::gotmessage $args
+ }
+ toplevel .t1
+ } \
+ -cleanup {
+ rename ::tk_messageBox {}
+ rename ::saved_messageBox ::tk_messageBox
+ unset ::gotmessage
+ destroy .t1
+ } \
+ -body {
+ ToEnterFileByKey .t1 RUBBISH $fileDir
+ ToPressButton .t1 ok
+ ToPressButton .t1 cancel
+ tk_getOpenFile -parent .t1 \
+ -title "Please enter RUBBISH as a file name" \
+ -initialdir $fileDir
+ set gotmessage
+ } \
+ -match glob \
+ -result "*RUBBISH*"
+ }
+
# The rest of the tests need to be executed on Unix only.
# The test whether the dialog box widgets were implemented correctly.
# These tests are not