From de2192ab2097c8b53fd997775bbd1b74b4e8b8f0 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 12 Oct 2018 18:44:25 +0000 Subject: Turn [zipfs tcl_library] into more internal [tcl::zipfs::tcl_library_init]. It wasn't documented and isn't very useful outside of Tcl's startup code. --- generic/tclBasic.c | 1 - generic/tclInterp.c | 2 +- generic/tclZipfs.c | 19 ++++++++++++------- tests/interp.test | 2 +- tests/zipfs.test | 4 ++-- 5 files changed, 16 insertions(+), 12 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 321b124..179306d 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -382,7 +382,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 90f02f9..1e75298 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 bd2ae13..428be15 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/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/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 { -- cgit v0.12