4 fs fixes

4 files changed, 197 insertions, 6 deletions

diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index afcc968..7c892d5 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.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: cmdAH.test,v 1.17 2001/11/27 14:12:35 dkf Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.18 2002/03/24 11:41:50 vincentdarley Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -1496,14 +1496,18 @@ catch {unset stat}
 
 # type
 
-file delete link.file
-
 test cmdAH-29.1 {Tcl_FileObjCmd: type} {
     list [catch {file size a b} msg] $msg
 } {1 {wrong # args: should be "file size name"}}
 test cmdAH-29.2 {Tcl_FileObjCmd: type} {
     file type dir.file
 } directory
+test cmdAH-29.3.0 {Tcl_FileObjCmd: delete removes link not file} {
+    set exists [list [file exists link.file] [file exists gorp.file]]
+    file delete link.file
+    set exists2	[list [file exists link.file] [file exists gorp.file]]
+    list $exists $exists2
+} {{1 1} {0 1}}
 test cmdAH-29.3 {Tcl_FileObjCmd: type} {
     file type gorp.file
 } file
diff --git a/tests/fileName.test b/tests/fileName.test
index b7616f3..9d2e50b 100644
--- a/tests/fileName.test
+++ b/tests/fileName.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: fileName.test,v 1.16 2001/11/23 01:26:06 das Exp $
+# RCS: @(#) $Id: fileName.test,v 1.17 2002/03/24 11:41:50 vincentdarley Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -1428,9 +1428,36 @@ unset horribleglobname
 test filename-12.1 {simple globbing} {unixOrPc} {
     list [catch {glob {}} msg] $msg
 } {0 .}
+test filename-12.1.1 {simple globbing} {unixOrPc} {
+    list [catch {glob -types f {}} msg] $msg
+} {1 {no files matched glob pattern ""}}
+test filename-12.1.2 {simple globbing} {unixOrPc} {
+    list [catch {glob -types d {}} msg] $msg
+} {0 .}
+test filename-12.1.3 {simple globbing} {unixOnly} {
+    list [catch {glob -types hidden {}} msg] $msg
+} {0 .}
+test filename-12.1.4 {simple globbing} {unixpcOnly} {
+    list [catch {glob -types hidden {}} msg] $msg
+} {1 {no files matched glob pattern ""}}
+test filename-12.1.5 {simple globbing} {pcOnly} {
+    list [catch {glob -types hidden c:/} msg] $msg
+} {1 {no files matched glob pattern "c:/"}}
+test filename-12.1.6 {simple globbing} {pcOnly} {
+    list [catch {glob c:/} msg] $msg
+} {0 c:/}
 test filename-12.2 {simple globbing} {macOnly} {
     list [catch {glob {}} msg] $msg
 } {0 :}
+test filename-12.2.1 {simple globbing} {macOnly} {
+    list [catch {glob -types f {}} msg] $msg
+} {1 {no files matched glob pattern ""}}
+test filename-12.2.2 {simple globbing} {macOnly} {
+    list [catch {glob -types d {}} msg] $msg
+} {0 :}
+test filename-12.2.3 {simple globbing} {macOnly} {
+    list [catch {glob -types hidden {}} msg] $msg
+} {1 {no files matched glob pattern ""}}
 test filename-12.3 {simple globbing} {
     list [catch {glob -nocomplain \{a1,a2\}} msg] $msg
 } {0 {}}
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
new file mode 100644
index 0000000..180482b
--- /dev/null
+++ b/tests/fileSystem.test
@@ -0,0 +1,157 @@
+# This file tests the filesystem and vfs internals.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 2002 Vincent Darley.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import -force ::tcltest::*
+}
+
+makeFile "test file" gorp.file
+makeDirectory dir.file
+makeFile "test file in directory" [file join dir.file inside.file]
+
+# It would be good to be able to make these work on MacOS too.
+# If we added 'file link from to' we could easily do that.
+catch {exec ln -s gorp.file link.file}
+catch {exec ln -s inside.file dir.file/linkinside.file}
+catch {exec ln -s dir.file dir.link}
+
+test filesystem-1.0 {link normalisation} {unixOnly} {
+   string equal [file normalize gorp.file] [file normalize link.file]
+} {0}
+
+test filesystem-1.1 {link normalisation} {unixOnly} {
+   string equal [file normalize dir.file] [file normalize dir.link]
+} {0}
+
+test filesystem-1.2 {link normalisation} {unixOnly} {
+   string equal [file normalize gorp.file/foo] [file normalize link.file/foo]
+} {1}
+
+test filesystem-1.3 {link normalisation} {unixOnly} {
+   string equal [file normalize dir.file/foo] [file normalize dir.link/foo]
+} {1}
+
+test filesystem-1.4 {link normalisation} {unixOnly} {
+   string equal [file normalize dir.file/inside.file] [file normalize dir.link/inside.file]
+} {1}
+
+test filesystem-1.5 {link normalisation} {unixOnly} {
+   string equal [file normalize dir.file/linkinside.file] [file normalize dir.file/linkinside.file]
+} {1}
+
+test filesystem-1.6 {link normalisation} {unixOnly} {
+   string equal [file normalize dir.file/linkinside.file] [file normalize dir.link/inside.file]
+} {0}
+
+test filesystem-1.7 {link normalisation} {unixOnly} {
+   string equal [file normalize dir.link/linkinside.file/foo] [file normalize dir.file/inside.file/foo]
+} {1}
+
+test filesystem-1.8 {link normalisation} {unixOnly} {
+   string equal [file normalize dir.file/linkinside.filefoo] [file normalize dir.link/inside.filefoo]
+} {0}
+
+file delete -force gorp.file link.file dir.file dir.link
+
+test filesystem-2.0 {new native path} {unixOnly} {
+   foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
+       catch {file readlink $f}
+   }
+   # If we reach here we've succeeded. We used to crash above.
+   expr 1
+} {1}
+
+# Make sure the testfilesystem hasn't been registered.
+while {![catch {testfilesystem 0}]} {}
+
+test filesystem-3.0 {Tcl_FSRegister} {
+    testfilesystem 1
+} {registered}
+
+test filesystem-3.1 {Tcl_FSUnregister} {
+    testfilesystem 0
+} {unregistered}
+
+test filesystem-3.2 {Tcl_FSUnregister} {
+    list [catch {testfilesystem 0} err] $err
+} {1 failed}
+
+test filesystem-3.3 {Tcl_FSRegister} {
+    testfilesystem 1
+    testfilesystem 1
+    testfilesystem 0
+    testfilesystem 0
+} {unregistered}
+
+test filesystem-3.4 {Tcl_FSRegister} {
+    testfilesystem 1
+    file system bar
+} {reporting}
+
+test filesystem-3.5 {Tcl_FSUnregister} {
+    testfilesystem 0
+    file system bar
+} {native}
+
+test filesystem-4.0 {testfilesystem} {
+    -match glob
+    -body {
+	testfilesystem 1
+	set filesystemReport {}
+	file exists foo
+	testfilesystem 0
+	set filesystemReport
+    }
+    -result {* {access foo}}
+}
+
+test filesystem-4.1 {testfilesystem} {
+    -match glob
+    -body {
+	testfilesystem 1
+	set filesystemReport {}
+	catch {file stat foo bar}
+	testfilesystem 0
+	set filesystemReport
+    }
+    -result {* {stat foo}}
+}
+
+test filesystem-4.2 {testfilesystem} {
+    -match glob
+    -body {
+	testfilesystem 1
+	set filesystemReport {}
+	catch {file lstat foo bar}
+	testfilesystem 0
+	set filesystemReport
+    }
+    -result {* {lstat foo}}
+}
+
+test filesystem-4.3 {testfilesystem} {
+    -match glob
+    -body {
+	testfilesystem 1
+	set filesystemReport {}
+	catch {glob *}
+	testfilesystem 0
+	set filesystemReport
+    }
+    -result {* {matchindirectory */tests/} *}
+}
+
+catch {unset filesystemReport}
+# Make sure the testfilesystem hasn't been registered.
+while {![catch {testfilesystem 0}]} {}
+
+
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 992124c..1da9133 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.15 2001/11/19 17:45:12 vincentdarley Exp $
+# RCS: @(#) $Id: winFCmd.test,v 1.16 2002/03/24 11:41:51 vincentdarley Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -840,7 +840,7 @@ test winFCmd-11.4 {GetWinFileAttributes} {pcOnly} {
     close [open td1 w]
     list [catch {file attributes td1 -system} msg] $msg [cleanup]
 } {0 0 {}}
-test winfcmd-11.5 {GetWinFileAttributes} {pcOnly} {
+test winFCmd-11.5 {GetWinFileAttributes} {pcOnly} {
     # attr of relative paths that resolve to root was failing
     # don't care about answer, just that test runs.
 
@@ -851,6 +851,9 @@ test winfcmd-11.5 {GetWinFileAttributes} {pcOnly} {
     file attr . 
     cd $old
 } {}
+test winFCmd-11.6 {GetWinFileAttributes} {pcOnly} {
+    file attr c:/ -hidden
+} {0}
 
 test winFCmd-12.1 {ConvertFileNameFormat} {pcOnly} {
     cleanup