better tests

diff --git a/ChangeLog b/ChangeLog
index b28f225ba5192cc63d1a3935d388e2bdf20ca9d2..990b0579c02e54f591c15cecce698275db78e0a5 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2002-05-03  Vince Darley <vincentdarley@sourceforge.net>
+       * tests/*: more test improvements, and new file vfsArchive.test
+       which will test the running of the tests inside an archive. 
+       This requires recursive invocation of the 'tcltest' package,
+       which may well cause some problems if it isn't designed to
+       handle that (i.e. executing one test actually causes the
+       execution of a lot of other tests).
+       * library/pkgIndex.tcl: update to try to avoid the 'no such
+       command vfs::*::Mount' error messages which you can get, if
+       the relevant .tcl files are not on your auto_path.
+
 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'

diff --git a/library/pkgIndex.tcl b/library/pkgIndex.tcl
index 0aefcc6d44da95fc203f11d0a4366d1a8d10c88f..2e4ae13f68c395511070b7f8f11799c0ebc03e31 100644 (file)
--- a/library/pkgIndex.tcl
+++ b/library/pkgIndex.tcl
@@ -20,10 +20,6 @@ if {[info tclversion] == 8.4} {
     }
 }
 
-if {[lsearch -exact $auto_path $dir] == -1} {
-    lappend auto_path $dir
-}
-
 if {[info exists tcl_platform(debug)]} {
     set file [file join $dir vfs10d[info sharedlibextension]]
 } else {
@@ -37,7 +33,16 @@ if {![file exists $file]} {
     return
 }
 
-package ifneeded vfs 1.0 [list load $file]
+proc loadvfs {file} {
+    global auto_path
+    set dir [file dirname $file]
+    if {[lsearch -exact $auto_path $dir] == -1} {
+       lappend auto_path $dir
+    }
+    load $file
+}
+
+package ifneeded vfs 1.0 [list loadvfs $file]
 unset file
 
 package ifneeded mk4vfs 1.0 [list source [file join $dir mk4vfs.tcl]]

diff --git a/tests/vfsArchive.test b/tests/vfsArchive.test
new file mode 100644 (file)
index 0000000..f2697e5
--- /dev/null
+++ b/tests/vfsArchive.test
@@ -0,0 +1,60 @@
+# Commands covered: running our tests from inside a '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::*
+}
+
+tcltest::testConstraint nativefs \
+  [string equal [lindex [file system [info script]] 0] "native"]
+
+proc makeAndMountZipArchive {} {
+    puts stdout "Zipping tests" ; update
+    cd [file dirname [file dirname [file normalize [info script]]]]
+    set filelist [concat [glob -dir [pwd] -join -tails tests *.test] \
+      [glob -dir [pwd] -join -tails tests *.tcl]]
+    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
+    return [list vfs::zip::Unmount $mount tests.zip]
+}
+
+# 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} {
+    set testdir [pwd]
+    puts stderr $testdir
+    package require vfs
+    if {[catch {makeAndMountZipArchive} unmount]} {
+       set res "Couldn't make zip 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}
+
+
+

diff --git a/tests/vfsZip.test b/tests/vfsZip.test
index 738637ced92656e8aeb298c3ac9fdc2a334be56a..ff3ed8f8a64e2668a136f65cf358032b96d0770e 100644 (file)
--- a/tests/vfsZip.test
+++ b/tests/vfsZip.test
@@ -15,36 +15,4 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
     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
-