From: Vince Darley <vincentdarley@sourceforge.net>
Date: Thu, 16 May 2002 16:42:28 +0000 (+0000)
Subject: tests
X-Git-Tag: vfs-1-2~41
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=09f66ac14a8dfd8dee814c61cdf245d5f209fb42;p=tclvfs

tests
---

diff --git a/Readme.txt b/Readme.txt
index 91989bd..995a840 100644
--- a/Readme.txt
+++ b/Readme.txt
@@ -72,9 +72,16 @@ vfs     |  example mount command
 zip     |  vfs::zip::Mount my.zip local
 ftp     |  vfs::ftp::Mount ftp://user:pass@ftp.foo.com/dir/name/ local
 mk4     |  vfs::mk4::Mount myMk4database local
+urltype |  vfs::urltype::Mount ftp
 test    |  vfs::test::Mount ...
+--------+-----------------------------------------------------------------
+
+These are also available, but not so heavily debugged:
+
+--------+-----------------------------------------------------------------
 ns      |  vfs::ns::Mount ::tcl local
-urltype |  vfs::urltype::Mount ftp
+webdav  |  vfs::webdav::Mount http://user:pass@foo.com/blah local
+http    |  vfs::http::Mount http://foo.com/blah local
 --------+-----------------------------------------------------------------
 
 For file-systems which make use of a local file (e.g. mounting zip or mk4
diff --git a/tests/vfsArchive.test b/tests/vfsArchive.test
index f2697e5..94f8c6c 100644
--- a/tests/vfsArchive.test
+++ b/tests/vfsArchive.test
@@ -34,9 +34,24 @@ proc makeAndMountZipArchive {} {
     return [list vfs::zip::Unmount $mount tests.zip]
 }
 
+proc makeAndMountMk4Archive {} {
+    puts stdout "Making mk4 archive of tests" ; update
+    cd [file dirname [file dirname [file normalize [info script]]]]
+    catch {file delete [file join tests tests.bin]}
+    exec sdx fs2sd tests
+    puts stdout "Done making mk4 archive"
+    cd [file dirname [info script]]
+    
+    package require vfs
+    set mount [vfs::mk4::Mount tests.bin tests.bin]
+    cd tests.bin
+    return [list vfs::mk4::Unmount $mount tests.bin]
+}
+
 # This actually calls the test suite recursively, which probably
 # causes some problems, although it shouldn't really!
 test vfsArchive-1.1 {run tests in zip archive} {nativefs} {
+    # If this test fails, you probably don't have 'zip' installed.
     set testdir [pwd]
     puts stderr $testdir
     package require vfs
@@ -57,4 +72,29 @@ test vfsArchive-1.1 {run tests in zip archive} {nativefs} {
 } {ok}
 
 
+# This actually calls the test suite recursively, which probably
+# causes some problems, although it shouldn't really!
+test vfsArchive-1.2 {run tests in mk4 archive} {nativefs} {
+    # If this test fails, you probably don't have tclkit and 'sdx'
+    # installed.  That's not a big deal.
+    set testdir [pwd]
+    puts stderr $testdir
+    package require vfs
+    if {[catch {makeAndMountMk4Archive} unmount]} {
+	set res "Couldn't make mk4 archive to test with: $unmount"
+	puts stderr $::auto_path
+    } else {
+	cd tests
+	source all.tcl
+	cd ..
+	cd ..
+	puts [pwd]
+	eval $unmount
+	set res "ok"
+    }
+    cd $testdir
+    set res
+} {ok}
+
+