tests

diff --git a/ChangeLog b/ChangeLog
index 99529dc1c78e0fd0a21dffc91586d0350afdaffc..3f137e06408fa9528ba0b51d779b42a22cd506f2 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,6 @@
 2001-11-01  Vince Darley <vincentdarley@sourceforge.net>
        * generic/vfs.c: 'vfs::mount' no longer a string-literal
+       * tests/vfs*.test: various new tests added
        
 2001-10-31  Vince Darley <vincentdarley@sourceforge.net>
        * examples/simpleExamples.tcl: a demo

diff --git a/tests/vfs.test b/tests/vfs.test
index 959194a498d5d76526e882aab245861ba89cb9e4..94d88bbc99d742a5d34e3e889e3f0d042eb2df7c 100644 (file)
--- a/tests/vfs.test
+++ b/tests/vfs.test
@@ -19,12 +19,12 @@ package require vfs
 
 test vfs-1.1 {mount unmount} {
     vfs::filesystem mount foo bar
-    set res [list [catch {vfs::filesystem unmount foo bar} err]]
+    set res [list [catch {vfs::filesystem unmount foo bar blah} err]]
     lappend res $err
     vfs::filesystem unmount foo
     unset err
     set res
-} {1 {wrong # args: should be "vfs::filesystem unmount path"}}
+} {1 {wrong # args: should be "vfs::filesystem unmount ?-volume? path"}}
 
 # cleanup
 ::tcltest::cleanupTests

diff --git a/tests/vfsUrl.test b/tests/vfsUrl.test
index 75d61c24232049460d6e93e5720611a7708479c5..60f6c40d060ca173d6751c2da3ce4a401d1ac145 100644 (file)
--- a/tests/vfsUrl.test
+++ b/tests/vfsUrl.test
@@ -16,6 +16,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 }
 
 package require vfs
+if {![auto_load ::vfs::urltype::Mount]} {
+    lappend auto_path [file join [file dirname \
+      [file dirname [file normalize [info script]]]] library]
+}
 
 test vfsUrl-1.1 {mount} {
     vfs::urltype::Mount ftp
@@ -25,6 +29,16 @@ test vfsUrl-1.2 {mount} {
     file exists ftp://ftp.scriptics.com
 } {1}
 
+test vfsUrl-1.2.1 {mounted volumes} {
+    set idx [lsearch -exact [file volumes] ftp://]
+    if {$idx < 0} {
+       set res "No ftp:// volume!"
+    } else {
+       set res "New volume 'ftp://' mounted"
+    }
+    set res
+} {New volume 'ftp://' mounted}
+
 test vfsUrl-1.3 {mount} {
     file delete -force README.tclversions
     file copy ftp://ftp.scriptics.com/pub/tcl/README.tclversions .
@@ -55,5 +69,15 @@ test vfsUrl-1.4 {file copy with typo} {
 } {file doesn't exist}
 
 # cleanup
+catch {
+    if {[lsearch -exact "ftp://" [file volumes]] != -1} {
+       vfs::urltype::Unmount ftp
+    }
+    if {[lsearch -exact "http://" [file volumes]] != -1} {
+       vfs::urltype::Unmount http
+    }
+    
+}
+
 ::tcltest::cleanupTests
 return