better tests

diff --git a/ChangeLog b/ChangeLog
index b5b81adf5afbdc34b9e49634c7e62719d2f7b4af..482b8282b465ed17a3d9f8ced09fcc7f8df1f067 100644 (file)
--- 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 8b65227cf436d4a5ee45c417ec4ef8dabb4e7221..c6e4215ab33a48a546eb2c46aca20fccc7e6b037 100644 (file)
--- 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 3001c546aebd0dbe0b43f7896ee52136a81a6909..d64d63be4ff3b13233f3859c4a4132c54871a0b7 100644 (file)
--- 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]