} else {
set dll vfs13
}
+if {![info exists dir]} {
+ set dir [file dirname [info script]]
+}
set dll [file join $dir $dll[info sharedlibextension]]
-proc loadvfs {dll} {
+proc loadvfs {dir dll} {
global auto_path
+ if {[lsearch -exact $auto_path $dir] == -1} {
+ lappend auto_path $dir
+ }
if {![file exists $dll]} { return }
set dir [file dirname $dll]
if {[lsearch -exact $auto_path $dir] == -1} {
load $dll
}
-package ifneeded vfs 1.3.0 [list loadvfs $dll]
+package ifneeded vfs 1.3.0 [list loadvfs $dir $dll]
package ifneeded starkit 1.3 [list source [file join $dir starkit.tcl]]
package ifneeded vfslib 1.3.1 [list source [file join $dir vfslib.tcl]]
-# all.tcl --\r#\r# This file contains a top-level script to run all of the Tcl\r# tests. Execute it by invoking "source all.test" when running tcltest\r# in this directory.\r#\r# Copyright (c) 1998-2000 by Scriptics Corporation.\r# All rights reserved.\r# \r# RCS: @(#) $Id$\r\rset tcltestVersion [package require tcltest]\rnamespace import -force tcltest::*\r\r#tcltest::testsDirectory [file dir [info script]]\r#tcltest::runAllTests\r\rset ::tcltest::testSingleFile false\rset ::tcltest::testsDirectory [file dir [info script]]\r\r# We need to ensure that the testsDirectory is absolute\r::tcltest::normalizePath ::tcltest::testsDirectory\r\rputs stdout "Tests running in interp: [info nameofexecutable]"\rputs stdout "Tests running in working dir: $::tcltest::testsDirectory"\rif {[llength $::tcltest::skip] > 0} {\r puts stdout "Skipping tests that match: $::tcltest::skip"\r}\rif {[llength $::tcltest::match] > 0} {\r puts stdout "Only running tests that match: $::tcltest::match"\r}\r\rif {[llength $::tcltest::skipFiles] > 0} {\r puts stdout "Skipping test files that match: $::tcltest::skipFiles"\r}\rif {[llength $::tcltest::matchFiles] > 0} {\r puts stdout "Only sourcing test files that match: $::tcltest::matchFiles"\r}\r\rtcltest::testConstraint fsIsWritable [expr {1 - [catch {file mkdir isreadonly ; file delete isreadonly}]}]\r\rset timeCmd {clock format [clock seconds]}\rputs stdout "Tests began at [eval $timeCmd]"\r\r# source each of the specified tests\rforeach file [lsort [::tcltest::getMatchingFiles]] {\r set tail [file tail $file]\r puts stdout $tail\r if {[catch {source $file} msg]} {\r puts stdout $msg\r }\r}\r\r# cleanup\rputs stdout "\nTests ended at [eval $timeCmd]"\r::tcltest::cleanupTests 1\rreturn\r\r
\ No newline at end of file
+# all.tcl --
+#
+# This file contains a top-level script to run all of the Tcl
+# tests. Execute it by invoking "source all.test" when running tcltest
+# in this directory.
+#
+# Copyright (c) 1998-2000 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+set tcltestVersion [package require tcltest]
+namespace import -force tcltest::*
+
+#tcltest::testsDirectory [file dir [info script]]
+#tcltest::runAllTests
+
+set ::tcltest::testSingleFile false
+set ::tcltest::testsDirectory [file dir [info script]]
+
+proc vfsCreateInterp {name} {
+ # Have to make sure we load the same dll else we'll have multiple
+ # copies!
+ if {[catch {
+ interp create $name
+ $name eval [list package ifneeded vfs 1.3 [package ifneeded vfs 1.3]]
+ $name eval [list set ::auto_path $::auto_path]
+ $name eval {package require vfs}
+ } err]} {
+ puts "$err ; $::errorInfo"
+ }
+}
+
+# Set up auto_path and package indices for loading. Must make sure we
+# can load the same dll into the main interpreter and sub interps.
+proc setupForVfs {lib} {
+ namespace eval vfs {}
+ global auto_path dir vfs::dll
+ set dir [file norm $lib]
+ set auto_path [linsert $auto_path 0 $dir]
+ uplevel \#0 [list source [file join $dir pkgIndex.tcl]]
+ set orig [package ifneeded vfs 1.3]
+ set vfs::dll [lindex $orig 2]
+ if {![file exists $vfs::dll]} {
+ set vfs::dll [file join [pwd] [file tail $vfs::dll]]
+ package ifneeded vfs 1.3 [list [lindex $orig 0] [lindex $orig 1] $vfs::dll]
+ }
+}
+
+# We need to ensure that the testsDirectory is absolute
+::tcltest::normalizePath ::tcltest::testsDirectory
+
+if {[lindex [file system $::tcltest::testsDirectory] 0] == "native"} {
+ setupForVfs [file join [file dir $::tcltest::testsDirectory] library]
+}
+
+package require vfs
+
+puts stdout "Tests running in interp: [info nameofexecutable]"
+puts stdout "Tests running in working dir: $::tcltest::testsDirectory"
+if {[llength $::tcltest::skip] > 0} {
+ puts stdout "Skipping tests that match: $::tcltest::skip"
+}
+if {[llength $::tcltest::match] > 0} {
+ puts stdout "Only running tests that match: $::tcltest::match"
+}
+
+if {[llength $::tcltest::skipFiles] > 0} {
+ puts stdout "Skipping test files that match: $::tcltest::skipFiles"
+}
+if {[llength $::tcltest::matchFiles] > 0} {
+ puts stdout "Only sourcing test files that match: $::tcltest::matchFiles"
+}
+
+tcltest::testConstraint fsIsWritable [expr {1 - [catch {file mkdir isreadonly ; file delete isreadonly}]}]
+
+set timeCmd {clock format [clock seconds]}
+puts stdout "Tests began at [eval $timeCmd]"
+
+# source each of the specified tests
+foreach file [lsort [::tcltest::getMatchingFiles]] {
+ set tail [file tail $file]
+ puts stdout $tail
+ if {[catch {source $file} msg]} {
+ puts stdout $msg
+ }
+}
+
+# cleanup
+puts stdout "\nTests ended at [eval $timeCmd]"
+::tcltest::cleanupTests 1
+return
+
test vfs-2.1 {mount unmount in sub interp} {
catch {interp delete a}
catch {unset res}
- set res {}
set remove [vfs::filesystem info]
vfs::filesystem mount foo bar
- interp create a
+ vfsCreateInterp a
a eval {package require vfs}
a eval {vfs::filesystem mount foo2 bar2}
+ set res {}
eval lappend res [vfs::filesystem info]
a eval {vfs::filesystem unmount foo2}
interp delete a
catch {unset res}
set remove [vfs::filesystem info]
vfs::filesystem mount foo bar
- interp create a
+ vfsCreateInterp a
a eval {package require vfs}
a eval {vfs::filesystem mount foo2 bar2}
set res {}
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.0 {package require vfs} {
+ if {![catch {package require vfs} res]} {
+ set res "ok"
+ }
+ set res
+} {ok}
+
# 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
if {[catch {makeAndMountZipArchive} unmount]} {
- set res "Couldn't make zip archive to test with: $unmount"
+ set res "Couldn't make and mount zip archive to test with: $unmount"
+ puts $::errorInfo
puts stderr $::auto_path
} else {
- cd tests
- source all.tcl
- cd ..
- cd ..
- puts [pwd]
- eval $unmount
- set res "ok"
+ puts stdout "=== Running tests in zip archive ==="
+ if {![catch {
+ cd tests
+ source all.tcl
+ cd ..
+ cd ..
+ puts [pwd]
+ eval $unmount
+ } res]} {
+ set res "ok"
+ }
+ puts stdout "=== End of embedded zip tests ==="
}
cd $testdir
set res
puts stderr $testdir
package require vfs
if {[catch {makeAndMountMk4Archive} unmount]} {
- set res "Couldn't make mk4 archive to test with: $unmount"
+ set res "Couldn't make and mount mk4 archive to test with: $unmount"
puts stderr $::auto_path
} else {
+ puts stdout "=== Running tests in mk4 archive ==="
cd tests
source all.tcl
cd ..
puts [pwd]
eval $unmount
set res "ok"
+ puts stdout "=== End of embedded mk4 tests ==="
}
cd $testdir
set res
projects / tclvfs / commitdiff