diff options
| -rw-r--r-- | doc/zipfs.n | 7 | ||||
| -rw-r--r-- | generic/tclBasic.c | 1 | ||||
| -rw-r--r-- | generic/tclInterp.c | 2 | ||||
| -rw-r--r-- | generic/tclZipfs.c | 19 | ||||
| -rw-r--r-- | library/tcltest/tcltest.tcl | 4 | ||||
| -rw-r--r-- | tests/interp.test | 2 | ||||
| -rw-r--r-- | tests/macOSXFCmd.test | 2 | ||||
| -rw-r--r-- | tests/tcltest.test | 2 | ||||
| -rw-r--r-- | tests/winPipe.test | 1 | ||||
| -rw-r--r-- | tests/zipfs.test | 4 |
10 files changed, 21 insertions, 23 deletions
diff --git a/doc/zipfs.n b/doc/zipfs.n index 9ed136d..c27b5d5 100644 --- a/doc/zipfs.n +++ b/doc/zipfs.n @@ -30,9 +30,8 @@ zipfs \- Mount and work with ZIP files within Tcl \fBzipfs root\fR \fBzipfs unmount\fR \fImountpoint\fR .fi -'\" The following subcommands are *UNDOCUMENTED* (the list here is not documentation) +'\" The following subcommand is *UNDOCUMENTED* '\" \fBzipfs mount_data\fR ?\fImountpoint\fR? ?\fIdata\fR? -'\" \fBzipfs tcl_library\fR .BE .SH DESCRIPTION .PP @@ -245,10 +244,8 @@ close $f # Launch the executable, printing its output to stdout exec $img >@stdout -# prints: \fI Hi. This is //zipfs:/app/main.tcl\fR +# prints: \fIHi. This is //zipfs:/app/main.tcl\fR .CE -'\" WANTED: How to use the passwords -'\" WANTED: How to package an application .SH "SEE ALSO" tclsh(1), file(n), zipfs(3), zlib(n) .SH "KEYWORDS" diff --git a/generic/tclBasic.c b/generic/tclBasic.c index fbff5a0..4832081 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -363,7 +363,6 @@ static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = { {"zipfs", "mkzip"}, {"zipfs", "mount"}, {"zipfs", "mount_data"}, - {"zipfs", "tcl_library"}, {"zipfs", "unmount"}, {NULL, NULL} }; diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 0021add..1bcabe2 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -409,7 +409,7 @@ Tcl_Init( " } else {\n" " lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n" " }\n" -" lappend scripts {zipfs tcl_library}\n" +" lappend scripts {::tcl::zipfs::tcl_library_init}\n" " lappend scripts {\n" "set parentDir [file dirname [file dirname [info nameofexecutable]]]\n" "set grandParentDir [file dirname $parentDir]\n" diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 4cdace1..ccfce5e 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -3257,8 +3257,10 @@ TclZipfs_TclLibrary(void) * * ZipFSTclLibraryObjCmd -- * - * This procedure is invoked to process the [zipfs tcl_library] command. - * It returns the root that Tcl's library files are mounted under. + * This procedure is invoked to process the + * [::tcl::zipfs::tcl_library_init] command, usually called during the + * execution of Tcl's interpreter startup. It returns the root that Tcl's + * library files are mounted under. * * Results: * A standard Tcl result. @@ -3277,12 +3279,14 @@ ZipFSTclLibraryObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_Obj *pResult = TclZipfs_TclLibrary(); + if (!Tcl_IsSafe(interp)) { + Tcl_Obj *pResult = TclZipfs_TclLibrary(); - if (!pResult) { - pResult = Tcl_NewObj(); + if (!pResult) { + pResult = Tcl_NewObj(); + } + Tcl_SetObjResult(interp, pResult); } - Tcl_SetObjResult(interp, pResult); return TCL_OK; } @@ -4719,7 +4723,6 @@ TclZipfs_Init( {"list", ZipFSListObjCmd, NULL, NULL, NULL, 0}, {"canonical", ZipFSCanonicalObjCmd, NULL, NULL, NULL, 0}, {"root", ZipFSRootObjCmd, NULL, NULL, NULL, 0}, - {"tcl_library", ZipFSTclLibraryObjCmd, NULL, NULL, NULL, 1}, {NULL, NULL, NULL, NULL, NULL, 0} }; static const char findproc[] = @@ -4769,6 +4772,8 @@ TclZipfs_Init( Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj); Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1), Tcl_NewStringObj("::tcl::zipfs::find", -1)); + Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init", + ZipFSTclLibraryObjCmd, NULL, NULL); Tcl_PkgProvide(interp, "zipfs", "2.0"); } return TCL_OK; diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index eb42ff1..f1b6082 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -1254,10 +1254,6 @@ proc tcltest::DefineConstraintInitializers {} { ConstraintInitializer interactive \ {expr {[info exists ::tcl_interactive] && $::tcl_interactive}} - # Skip slow tests (to enable slow tests add parameter `-constraints slowTest`) - - ConstraintInitializer slowTest {format 0} - # Some tests can only be run if the installation came from a CD # image instead of a web image. Some tests must be skipped if you # are running as root on Unix. Other tests can only be run if you diff --git a/tests/interp.test b/tests/interp.test index e9f95d7..29e3b2d 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -20,7 +20,7 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testinterpdelete [llength [info commands testinterpdelete]] -set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:tcl_library tcl:zipfs:unmount unload} +set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload} foreach i [interp slaves] { interp delete $i diff --git a/tests/macOSXFCmd.test b/tests/macOSXFCmd.test index 132b2fe..f1758f5 100644 --- a/tests/macOSXFCmd.test +++ b/tests/macOSXFCmd.test @@ -99,7 +99,7 @@ test macOSXFCmd-2.6 {MacOSXSetFileAttribute - hidden} {macosxFileAttr notRoot} { [catch {file attributes foo.test -hidden} msg] $msg \ [file delete -force -- foo.test] } {0 {} 0 1 {}} -test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot} { +test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot nonPortable} { catch {file delete -force -- foo.test} close [open foo.test w] catch { diff --git a/tests/tcltest.test b/tests/tcltest.test index 2eb4a70..b8e9138 100644 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -312,7 +312,7 @@ test tcltest-5.5 {InitConstraints: list of built-in constraints} \ -result [lsort { 95 98 asyncPipeClose eformat emptyTest exec hasIsoLocale interactive knownBug mac macCrash macOnly macOrPc macOrUnix macOrWin nonBlockFiles - nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp slowTest socket + nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp socket stdio tempNotMac tempNotPc tempNotUnix tempNotWin unix unixCrash unixExecs unixOnly unixOrPc unixOrWin userInteraction win winCrash winOnly }] diff --git a/tests/winPipe.test b/tests/winPipe.test index b0e1aba..361858a 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -30,6 +30,7 @@ testConstraint cat32 [file exists $cat32] testConstraint AllocConsole [catch {puts console1 ""}] testConstraint RealConsole [expr {![testConstraint AllocConsole]}] testConstraint testexcept [llength [info commands testexcept]] +testConstraint slowTest 0 set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n diff --git a/tests/zipfs.test b/tests/zipfs.test index abf9d3f..5715ce8 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -247,7 +247,7 @@ test zipfs-3.1 {zipfs in child interpreters} -constraints zipfs -setup { } } -returnCodes error -cleanup { interp delete $interp -} -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, tcl_library, or unmount} +} -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, or unmount} test zipfs-3.2 {zipfs in child interpreters} -constraints zipfs -setup { set interp [interp create] } -body { @@ -265,7 +265,7 @@ test zipfs-3.3 {zipfs in child interpreters} -constraints zipfs -setup { } } -returnCodes error -cleanup { interp delete $safe -} -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, tcl_library, or unmount} +} -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, or unmount} test zipfs-3.4 {zipfs in child interpreters} -constraints zipfs -setup { set safe [interp create -safe] } -body { |