From 42f2ff8cdabddeb49873f763721c27049dc1df0f Mon Sep 17 00:00:00 2001
From: Vince Darley <vincentdarley@sourceforge.net>
Date: Thu, 25 Apr 2002 10:36:55 +0000
Subject: [PATCH] better tests
---
ChangeLog | 4 ++++
tests/vfs.test | 27 +++++++++++++++++++--------
tests/vfsUrl.test | 2 +-
3 files changed, 24 insertions(+), 9 deletions(-)
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]
--
2.23.0