From 671bcba7bb5831707282a085723aaf9c2812fd9a Mon Sep 17 00:00:00 2001
From: Kevin B Kenny <kennykb@acm.org>
Date: Mon, 26 Nov 2007 20:00:52 +0000
Subject: * 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.

---
 ChangeLog          |  9 ++++++++
 library/tkfbox.tcl |  9 ++++----
 tests/filebox.test | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 78 insertions(+), 5 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 5fd055c..cf57bd5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2007-11-26  Kevin Kenny  <kennykb@acm.org>
+
+	* 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.
+	
 2007-11-25  Joe English  <jenglish@users.sourceforge.net>
 
 	* generic/ttk/ttkManager.h, generic/ttk/ttkManager.c,
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index 51c7d9c..82f4075 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -11,7 +11,7 @@
 #	files by clicking on the file icons or by entering a filename
 #	in the "Filename:" entry.
 #
-# RCS: @(#) $Id: tkfbox.tcl,v 1.66 2007/11/21 16:29:08 dkf Exp $
+# RCS: @(#) $Id: tkfbox.tcl,v 1.67 2007/11/26 20:00:52 kennykb Exp $
 #
 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
 #
@@ -1682,13 +1682,14 @@ proc ::tk::dialog::file::VerifyFileName {w filename} {
 	    $data(ent) icursor end
 	}
 	CHDIR {
-	    tk_messageBox -type ok -parent $w -message -icon warning \
-		    [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $path]
+	    tk_messageBox -type ok -parent $w -icon warning -message  \
+		[mc "Cannot change to the directory\
+                     \"%1\$s\".\nPermission denied." $path]
 	    $data(ent) selection range 0 end
 	    $data(ent) icursor end
 	}
 	ERROR {
-	    tk_messageBox -type ok -parent $w -message -icon warning \
+	    tk_messageBox -type ok -parent $w -icon warning -message \
 		    [mc "Invalid file name \"%1\$s\"." $path]
 	    $data(ent) selection range 0 end
 	    $data(ent) icursor end
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
-- 
cgit v0.12