From a1d41e6ab15a8040828a7984500a360d0b483f9d Mon Sep 17 00:00:00 2001
From: vincentdarley <vincentdarley>
Date: Sat, 18 Mar 2006 18:15:10 +0000
Subject: fix to file writeable on windows

---
 ChangeLog          |  9 +++++++++
 tests/fCmd.test    | 17 ++++++++++++++++-
 tests/tcltest.test |  5 +++--
 tests/winFCmd.test | 10 +++++-----
 4 files changed, 33 insertions(+), 8 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 71d493b..ac31b35 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2006-03-18  Vince Darley  <vincentdarley@sourceforge.net>
+
+	* tests/fCmd.test: added knownBug test case for [Bug 1394972]
+
+	* tests/winFCmd.test:
+	* tests/tcltest.test: corrected tests to better account for
+	behaviour of writable/non-writable directories on Windows 2000/XP.
+	This, with the previous patches, closes [Bug 1193497]
+
 2006-03-17  Andreas Kupries <andreask@activestate.com>
 
 	* doc/chan.n: Updated with documentation for the commands 'chan
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 64ff595..e33d678 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: fCmd.test,v 1.50 2006/03/15 23:10:09 vincentdarley Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.51 2006/03/18 18:15:13 vincentdarley Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -2382,6 +2382,21 @@ test fCmd-30.1 {file writable on 'My Documents'} {pc 2000orNewer} {
     set res
 } {1}
 
+test fCmd-30.2 {file readable on 'NTUSER.DAT'} {pc 2000orNewer knownBug} {
+    # Apparently the OS has this file open with exclusive permissions
+    # Windows doesn't provide any way to determine that fact without
+    # actually trying to open the file (open NTUSER.dat r), which
+    # fails.  Hence this isn't really a knownBug in Tcl, but an OS
+    # limitation.  But, perhaps in the future that limitation will be
+    # lifted.
+    if {[file exists "~/NTUSER.DAT"]} {
+	set res [file readable "~/NTUSER.DAT"]
+    } else {
+	set res 0
+    }
+    set res
+} {0}
+
 # cleanup
 cleanup
 ::tcltest::cleanupTests
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 1547a87..7515a80 100755
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -6,7 +6,7 @@
 # Copyright (c) 2000 by Ajuba Solutions
 # All rights reserved.
 #
-# RCS: @(#) $Id: tcltest.test,v 1.52 2005/05/10 18:35:24 kennykb Exp $
+# RCS: @(#) $Id: tcltest.test,v 1.53 2006/03/18 18:15:13 vincentdarley Exp $
 
 # Note that there are several places where the value of 
 # tcltest::currentFailure is stored/reset in the -setup/-cleanup
@@ -551,13 +551,14 @@ set notWriteableDir [file join [temporaryDirectory] notwriteable]
 makeDirectory notreadable
 makeDirectory notwriteable
 
-switch $tcl_platform(platform) {
+switch -- $tcl_platform(platform) {
     "unix" {
 	file attributes $notReadableDir -permissions 00333
 	file attributes $notWriteableDir -permissions 00555
     }
     default {
 	catch {file attributes $notWriteableDir -readonly 1}
+	catch {testchmod 000 $notWriteableDir}
     }
 }
 
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 51c0726..3ffaed2 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: winFCmd.test,v 1.38 2005/05/10 18:35:25 kennykb Exp $
+# RCS: @(#) $Id: winFCmd.test,v 1.39 2006/03/18 18:15:13 vincentdarley Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -703,11 +703,11 @@ test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \
 test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} {win} {
     cleanup
     file mkdir td1
-    testchmod 000 td1
     createfile td1/tf1 tf1
+    testchmod 000 td1
     testfile cpdir td1 td2
     list [file exists td2] [file writable td2]
-} {1 0}
+} {1 1}
 test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} {win} {
     cleanup
     file mkdir td1
@@ -759,11 +759,11 @@ test winFCmd-7.18 {TraverseWinTree: recurse on files: several files and dir} \
 test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} {win} {
     cleanup
     file mkdir td1
-    testchmod 000 td1
     createfile td1/tf1 tf1
+    testchmod 000 td1
     testfile cpdir td1 td2
     list [file exists td2] [file writable td2]
-} {1 0}
+} {1 1}
 test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} \
 	{win} {
     cleanup
-- 
cgit v0.12