From: Vince Darley <vincentdarley@sourceforge.net>
Date: Fri, 9 Nov 2001 11:37:25 +0000 (+0000)
Subject: tests
X-Git-Tag: vfs-1-2~79
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=4c2a5ec65b89820b29af5da2410d436a1645e16f;p=tclvfs

tests
---

diff --git a/ChangeLog b/ChangeLog
index 523c266..bc4aa64 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,6 @@
+2001-11-09 Vince Darley <vincentdarley@sourceforge.net>
+	* tests/vfs*.test: better tests; more platform independent.
+
 2001-11-08  Vince Darley <vincentdarley@sourceforge.net>
 	* generic/vfs.c: made code thread-safe.  Disallow
 	safe interpreters from using vfs code since they can then
diff --git a/tests/vfs.test b/tests/vfs.test
index 5459725..20e93c1 100644
--- a/tests/vfs.test
+++ b/tests/vfs.test
@@ -17,6 +17,21 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 
 package require vfs
 
+proc filelistrelative {filelist} {
+    set dir [file normalize [file dirname [info script]]]
+    set len [string length $dir]
+    incr len
+    set res {}
+    foreach d $filelist {
+	if {[string first $dir $d] == 0} {
+	   lappend res [string range $d $len end]
+       } else {
+	   lappend res $d
+       }
+    }
+    set res
+}
+
 test vfs-1.1 {mount unmount} {
     catch {unset res}
     vfs::filesystem mount foo bar
@@ -35,16 +50,16 @@ vfs::filesystem mount foo bar
 test vfs-2.1 {mount unmount in sub interp} {
     catch {interp delete a}
     catch {unset res}
+    set res {}
     interp create a
     a eval {package require vfs}
     a eval {vfs::filesystem mount foo2 bar2}
-    lappend res [vfs::filesystem info]
+    eval lappend res [vfs::filesystem info]
     a eval {vfs::filesystem unmount foo2}
     interp delete a
-    lappend res [vfs::filesystem info]
-    set res
-} {{C:/Tcl-source/tclvfs/tests/foo2 C:/Tcl-source/tclvfs/tests/foo}\
-  C:/Tcl-source/tclvfs/tests/foo}
+    eval lappend res [vfs::filesystem info]
+    filelistrelative $res
+} {foo2 foo foo}
 
 test vfs-2.2 {mount, delete sub interp} {
     catch {interp delete a}
@@ -52,12 +67,12 @@ test vfs-2.2 {mount, delete sub interp} {
     interp create a
     a eval {package require vfs}
     a eval {vfs::filesystem mount foo2 bar2}
-    lappend res [vfs::filesystem info]
+    set res {}
+    eval lappend res [vfs::filesystem info]
     interp delete a
-    lappend res [vfs::filesystem info]
-    set res
-} {{C:/Tcl-source/tclvfs/tests/foo2 C:/Tcl-source/tclvfs/tests/foo}\
-  C:/Tcl-source/tclvfs/tests/foo}
+    eval lappend res [vfs::filesystem info]
+    filelistrelative $res
+} {foo2 foo foo}
 
 vfs::filesystem unmount foo