diff options
| author | Kevin B Kenny <kennykb@acm.org> | 2007-11-26 20:00:52 (GMT) |
|---|---|---|
| committer | Kevin B Kenny <kennykb@acm.org> | 2007-11-26 20:00:52 (GMT) |
| commit | 671bcba7bb5831707282a085723aaf9c2812fd9a (patch) | |
| tree | abab5c23247a029471a38a8a7e3ceac3752cdf76 /tests/filebox.test | |
| parent | 37a492a973a6293e2324e7a9d66dee21daf1d033 (diff) | |
| download | tk-671bcba7bb5831707282a085723aaf9c2812fd9a.zip tk-671bcba7bb5831707282a085723aaf9c2812fd9a.tar.gz tk-671bcba7bb5831707282a085723aaf9c2812fd9a.tar.bz2 | |
* library/tkfbox.tcl (VerifyFileName): Corrected a couple
of typos in handling of bad file names. [Bug #1822076]
* tests/filebox.test (filebox-7.1, filebox-7.2): Added
test cases that exercise the above bug.
Thanks to Christoph Bauer (fridolin@users.sf.net) for the
patch.
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 |