From: Vince Darley <vincentdarley@sourceforge.net>
Date: Thu, 1 Nov 2001 16:41:31 +0000 (+0000)
Subject: tests
X-Git-Tag: vfs-1-2~95
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=351eab1e2fc2f052ea4890e59cee116da2eb333d;p=tclvfs

tests
---

diff --git a/ChangeLog b/ChangeLog
index 99529dc..3f137e0 100644
--- 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 959194a..94d88bb 100644
--- 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 75d61c2..60f6c40 100644
--- 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