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