diff options
| -rw-r--r-- | doc/zipfs.n | 46 | ||||
| -rw-r--r-- | generic/tclInterp.c | 1 | ||||
| -rw-r--r-- | generic/tclTest.c | 53 | ||||
| -rw-r--r-- | generic/zipfs.c | 17 | ||||
| -rw-r--r-- | tests/nre.test | 4 |
5 files changed, 80 insertions, 41 deletions
diff --git a/doc/zipfs.n b/doc/zipfs.n index d16c047..838a898 100644 --- a/doc/zipfs.n +++ b/doc/zipfs.n @@ -15,15 +15,15 @@ zipfs \- Mount and work with ZIP files within Tcl .nf \fBpackage require zipfs \fR?\fB1.0\fR? .sp -\fB::zipfs::exists\fR \fIfilename\fR -\fB::zipfs::find\fR \fIdir\fR -\fB::zipfs::info\fR \fIfilename\fR -\fB::zipfs::list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR -\fB::zipfs::mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR -\fB::zipfs::mkkey\fR \fIpassword\fR -\fB::zipfs::mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR -\fB::zipfs::mount\fR \fI?zipfile?\fR \fI?mountpoint?\fR \fI?password?\fR -\fB::zipfs::unmount\fR \fIzipfile\fR +\fBzipfs exists\fR \fIfilename\fR +\fBzipfs find\fR \fIdir\fR +\fBzipfs info\fR \fIfilename\fR +\fBzipfs list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR +\fBzipfs mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR +\fBzipfs mkkey\fR \fIpassword\fR +\fBzipfs mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR +\fBzipfs mount\fR \fI?zipfile?\fR \fI?mountpoint?\fR \fI?password?\fR +\fBzipfs unmount\fR \fIzipfile\fR .fi .BE .SH DESCRIPTION @@ -31,18 +31,18 @@ zipfs \- Mount and work with ZIP files within Tcl The \fBzipfs\fR package provides tcl with the ability to mount the contents of a zip file as a virtual file system. .TP -\fB::zipfs::exists\fR \fIfilename\fR +\fBzipfs exists\fR \fIfilename\fR . Return 1 if the given filename exists in the mounted zipfs and 0 if it does not. .TP -\fB::zipfs::find\fR \fIdir\fR +\fBzipfs find\fR \fIdir\fR . Recursively lists files including and below the directory \fIdir\fR. The result list consists of relative path names starting from the -given directory. This command is also used by the \fB::zipfs::mkzip\fR -and \fB::zipfs::mkimg\fR commands. +given directory. This command is also used by the \fBzipfs mkzip\fR +and \fBzipfs mkimg\fR commands. .TP -\fB::zipfs::info\fR \fIfile\fR +\fBzipfs info\fR \fIfile\fR . Return information about the given file in the mounted zipfs. The information consists of (1) the name of the ZIP archive file that contains the file, @@ -54,15 +54,15 @@ Note: querying the mount point gives the start of zip data offset in (4), which can be used to truncate the zip info off an executable. .RE .TP -\fB::zipfs::list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR +\fBzipfs list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR . Return a list of all files in the mounted zipfs. The order of the names in the list is arbitrary. .TP -\fB::zipfs::mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR +\fBzipfs mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR . Creates an image (potentially a new executable file) similar to -\fB::zipfs::mkzip\fR. If the \fIinfile\fR parameter is specified, +\fBzipfs mkzip\fR. If the \fIinfile\fR parameter is specified, this file is prepended in front of the ZIP archive, otherwise the file returned by \fBTcl_NameOfExecutable(3)\fR (i.e. the executable file of the running process) is used. If the \fIpassword\fR parameter is not empty, @@ -75,12 +75,12 @@ Caution: highly experimental, not usable on Android, only partially tested on Linux and Windows. .RE .TP -\fB::zipfs::mkkey\fR \fIpassword\fR +\fBzipfs mkkey\fR \fIpassword\fR . For the clear text \fIpassword\fR argument an obfuscated string version -is returned with the same format used in the \fB::zipfs::mkimg\fR command. +is returned with the same format used in the \fBzipfs mkimg\fR command. .TP -\fB::zipfs::mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR +\fBzipfs mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR . Creates a ZIP archive file named \fIoutfile\fR from the contents of the input directory \fIindir\fR (contained regular files only) with optional ZIP @@ -94,9 +94,9 @@ Caution: the choice of the \fIindir\fR parameter archive's content. .RE .TP -\fB::zipfs::mount ?\fIzipfile\fR? ?\fImountpoint\fR? ?\fIpassword\fR? +\fBzipfs mount ?\fIzipfile\fR? ?\fImountpoint\fR? ?\fIpassword\fR? . -The \fB::zipfs::mount\fR command mounts a ZIP archive file as a VFS. +The \fBzipfs mount\fR command mounts a ZIP archive file as a VFS. After this command executes, files contained in \fIzipfile\fR will appear to Tcl to be regular files at the mount point. .RS @@ -106,7 +106,7 @@ With no \fIzipfile\fR, return all zipfile/mount pairs. If \fImountpoint\fR is specified as an empty string, mount on file path. .RE .TP -\fB::zipfs::unmount \fIzipfile\fR +\fBzipfs unmount \fIzipfile\fR . Unmounts a previously mounted ZIP archive file \fIzipfile\fR. .SH "SEE ALSO" diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 0da5d47..5c94461 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -1882,7 +1882,6 @@ AliasObjCmd( cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *)); } - prefv = &aliasPtr->objPtr; memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *))); memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *))); diff --git a/generic/tclTest.c b/generic/tclTest.c index 5468c56..2ea3016 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -412,6 +412,12 @@ static int TestNumUtfCharsCmd(ClientData clientData, static int TestHashSystemHashCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); + +static int NREUnwind_callback(ClientData data[], Tcl_Interp *interp, + int result); +static int TestNREUnwind(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int TestNRELevels(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -697,6 +703,8 @@ Tcltest_Init( NULL); #endif /* TCL_NO_DEPRECATED */ + Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind, + NULL, NULL); Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels, NULL, NULL); Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd, @@ -6846,6 +6854,51 @@ TestgetintCmd( } static int +NREUnwind_callback( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + int none; + + if (data[0] == INT2PTR(-1)) { + TclNRAddCallback(interp, NREUnwind_callback, &none, INT2PTR(-1), + INT2PTR(-1), NULL); + } else if (data[1] == INT2PTR(-1)) { + TclNRAddCallback(interp, NREUnwind_callback, data[0], &none, + INT2PTR(-1), NULL); + } else if (data[2] == INT2PTR(-1)) { + TclNRAddCallback(interp, NREUnwind_callback, data[0], data[1], + &none, NULL); + } else { + Tcl_Obj *idata[3]; + idata[0] = Tcl_NewIntObj((int) (data[1] - data[0])); + idata[1] = Tcl_NewIntObj((int) (data[2] - data[0])); + idata[2] = Tcl_NewIntObj((int) ((void *) &none - data[0])); + Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata)); + } + return TCL_OK; +} + +static int +TestNREUnwind( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + /* + * Insure that callbacks effectively run at the proper level during the + * unwinding of the NRE stack. + */ + + TclNRAddCallback(interp, NREUnwind_callback, INT2PTR(-1), INT2PTR(-1), + INT2PTR(-1), NULL); + return TCL_OK; +} + + +static int TestNRELevels( ClientData clientData, Tcl_Interp *interp, diff --git a/generic/zipfs.c b/generic/zipfs.c index 8db1ac1..c5cb65b 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -4020,28 +4020,11 @@ Zipfs_doInit(Tcl_Interp *interp, int safe) Unlock(); Tcl_PkgProvide(interp, "zipfs", "1.0"); if (!safe) { - Tcl_CreateObjCommand(interp, "::zipfs::mount", ZipFSMountObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "::zipfs::unmount", - ZipFSUnmountObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "::zipfs::mkkey", ZipFSMkKeyObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "::zipfs::mkimg", ZipFSMkImgObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "::zipfs::mkzip", ZipFSMkZipObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "::zipfs::lmkimg", - ZipFSLMkImgObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "::zipfs::lmkzip", - ZipFSLMkZipObjCmd, 0, 0); Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL); - } - Tcl_CreateObjCommand(interp, "::zipfs::exists", ZipFSExistsObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "::zipfs::info", ZipFSInfoObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "::zipfs::list", ZipFSListObjCmd, 0, 0); - if (!safe) { Tcl_LinkVar(interp, "::zipfs::wrmax", (char *) &ZipFS.wrmax, TCL_LINK_INT); } - TclMakeEnsemble(interp, "zipfs", safe ? initSafeMap : initMap); - return TCL_OK; #else if (interp != NULL) { diff --git a/tests/nre.test b/tests/nre.test index e512eac..9df5eb1 100644 --- a/tests/nre.test +++ b/tests/nre.test @@ -64,6 +64,10 @@ if {[testConstraint testnrelevels]} { namespace import testnre::* } +test nre-0.1 {levels while unwinding} { + testnreunwind +} {0 0 0} + test nre-1.1 {self-recursive procs} -setup { proc a i [makebody {a $i}] } -body { |