From: Vince Darley <vincentdarley@sourceforge.net>
Date: Thu, 2 May 2002 20:19:03 +0000 (+0000)
Subject: more tests
X-Git-Tag: vfs-1-2~50
X-Git-Url: http://privyetmir.co.uk/gitweb?a=commitdiff_plain;h=009ff9a7a864244e3cbdd65367b30f2c94b71d85;p=tclvfs

more tests
---

diff --git a/ChangeLog b/ChangeLog
index d08af5f..b28f225 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,9 @@
-2002-04-27  Vince Darley <vincentdarley@sourceforge.net>
+2002-05-02  Vince Darley <vincentdarley@sourceforge.net>
 	* tests/vfs.test: tests work independent of directory in which
 	they run.  Tests added to check that at least 'vfs::memchan'
-	basically works.
+	basically works, and vfs::zip, vfs::crc helpers do what they
+	are supposed to.
+	* tests/vfsZip.test: test to run all tests inside a zip.
 	* mac/*: updated for removal of scripdoc.tcl and vfs.tcl
 	
 2002-04-25  Jean-Claude Wippler <jcw@equi4.com>
diff --git a/tests/vfs.test b/tests/vfs.test
index d5b5172..cec1f68 100644
--- a/tests/vfs.test
+++ b/tests/vfs.test
@@ -90,7 +90,9 @@ test vfs-2.2 {mount, delete sub interp} {
 test vfs-3.1 {vfs helpers: in memory channels} {
     close [::vfs::memchan]
     # If we get here, it's ok.  If this test fails,
-    # probably many other tests will fail too.
+    # probably many other tests will fail too.  In particular
+    # any use of 'open', 'source', 'load', and usually also
+    # 'file copy', 'file rename' in a vfs will fail.
 } {}
 
 test vfs-3.2 {vfs helpers: crc} {
diff --git a/tests/vfsZip.test b/tests/vfsZip.test
new file mode 100644
index 0000000..738637c
--- /dev/null
+++ b/tests/vfsZip.test
@@ -0,0 +1,50 @@
+# Commands covered:  the 'zip' vfs.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 2001-2002 by Vince Darley.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import ::tcltest::*
+}
+
+set dir [pwd]
+if {[catch {
+    puts stdout "Zipping tests" ; update
+    cd [file dirname [file dirname [file normalize [info script]]]]
+    foreach f [concat [glob -dir [pwd] -join -tails tests *.test] \
+      [glob -dir [pwd] -join -tails tests *.tcl]] {
+	if {[file tail $f] != "vfsZip.test"} {
+	    lappend filelist $f
+	}
+    }
+    catch {file delete [file join tests tests.zip]}
+    eval [list exec zip -q -9 [file join tests tests.zip]] $filelist
+    puts stdout "Done zipping"
+    cd [file dirname [info script]]
+    
+    package require vfs
+    set mount [vfs::zip::Mount tests.zip tests.zip]
+    cd tests.zip
+    cd tests
+    source all.tcl
+    vfs::zip::Unmount $mount tests.zip
+} err]} {
+    puts "vfsZip.test: running tests from a zip vfs failed"
+    global errorInfo
+    puts $errorInfo
+} else {
+    puts "vfsZip.test: running tests from a zip vfs succeeded"
+}
+
+puts "vfsZip.test: complete"
+cd $dir
+
+