tests

diff --git a/Readme.txt b/Readme.txt
index 91989bdea3b68dd883d77e64a69917c6a8e32036..995a840652f733a55cbfc379ea26aff4543710f7 100644 (file)
--- 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 f2697e5d597b6662638660856b95ed46165ccfa3..94f8c6c1d2b40d31d38d6b39b6da9963a1ac2d70 100644 (file)
--- 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}
+
+