diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclInterp.c | 1 | ||||
| -rw-r--r-- | generic/tclTest.c | 53 | ||||
| -rw-r--r-- | generic/zipfs.c | 17 |
3 files changed, 53 insertions, 18 deletions
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) { |