From: Vince Darley <vincentdarley@sourceforge.net>
Date: Thu, 25 Apr 2002 10:36:55 +0000 (+0000)
Subject: better tests
X-Git-Tag: vfs-1-2~58
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=42f2ff8cdabddeb49873f763721c27049dc1df0f;p=tclvfs

better tests
---

diff --git a/ChangeLog b/ChangeLog
index b5b81ad..482b828 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2002-04-25  Vince Darley <vincentdarley@sourceforge.net>
+	* tests/*: revamp of tests to be more robust, and to be
+	able to run from inside a mounted virtual filesystem.
+	
 2002-04-09  Jean-Claude Wippler <jcw@equi4.com>
 	* configure: generated and added to project
 
diff --git a/tests/vfs.test b/tests/vfs.test
index 8b65227..c6e4215 100644
--- a/tests/vfs.test
+++ b/tests/vfs.test
@@ -17,8 +17,17 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 
 package require vfs
 
-proc filelistrelative {filelist} {
-    set dir [file normalize [file dirname [file dirname [info script]]]]
+proc filelistrelative {filelist {remove ""}} {
+    if {[llength $remove]} {
+	set newlist {}
+	foreach f $filelist {
+	    if {[lsearch -exact $remove $f] == -1} {
+		lappend newlist $f
+	    }
+	}
+	set filelist $newlist
+    }
+    set dir [file normalize [file dirname [info script]]]
     set len [string length $dir]
     incr len
     set res {}
@@ -45,12 +54,12 @@ test vfs-1.1 {mount unmount} {
 
 # Test 2.x sub-interps
 
-vfs::filesystem mount foo bar
-
 test vfs-2.1 {mount unmount in sub interp} {
     catch {interp delete a}
     catch {unset res}
     set res {}
+    set remove [vfs::filesystem info]
+    vfs::filesystem mount foo bar
     interp create a
     a eval {package require vfs}
     a eval {vfs::filesystem mount foo2 bar2}
@@ -58,12 +67,15 @@ test vfs-2.1 {mount unmount in sub interp} {
     a eval {vfs::filesystem unmount foo2}
     interp delete a
     eval lappend res [vfs::filesystem info]
-    filelistrelative $res
+    vfs::filesystem unmount foo
+    filelistrelative $res $remove
 } {foo2 foo foo}
 
 test vfs-2.2 {mount, delete sub interp} {
     catch {interp delete a}
     catch {unset res}
+    set remove [vfs::filesystem info]
+    vfs::filesystem mount foo bar
     interp create a
     a eval {package require vfs}
     a eval {vfs::filesystem mount foo2 bar2}
@@ -71,11 +83,10 @@ test vfs-2.2 {mount, delete sub interp} {
     eval lappend res [vfs::filesystem info]
     interp delete a
     eval lappend res [vfs::filesystem info]
-    filelistrelative $res
+    vfs::filesystem unmount foo
+    filelistrelative $res $remove
 } {foo2 foo foo}
 
-vfs::filesystem unmount foo
-
 # cleanup
 ::tcltest::cleanupTests
 return
diff --git a/tests/vfsUrl.test b/tests/vfsUrl.test
index 3001c54..d64d63b 100644
--- a/tests/vfsUrl.test
+++ b/tests/vfsUrl.test
@@ -55,7 +55,7 @@ test vfsUrl-1.3 {mounted volumes} {
     set res
 } {New volume 'ftp://' mounted}
 
-test vfsUrl-2.1 {auto-mount ftp and copy file} {
+test vfsUrl-2.1 {auto-mount ftp and copy file} {vfsWritable} {
     file delete -force README.tclversions
     file copy ftp://ftp.scriptics.com/pub/tcl/README.tclversions $vfsTestDir
     set to [file join $vfsTestDir README.tclversions]