diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2016-01-23 20:28:19 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2016-01-23 20:28:19 (GMT) |
commit | 1acb0742e2003b2986c75a8f0967b7a7fdd5d661 (patch) | |
tree | 17e6862de7202f1e8aa203b4d9ce71e48c3abd01 /generic | |
parent | d8bdd23bc64b9a515924bf2f8c38345a1ee46c0a (diff) | |
parent | 095b587df14e39ec71e1f4a638516f371c8ce861 (diff) | |
download | tcl-1acb0742e2003b2986c75a8f0967b7a7fdd5d661.zip tcl-1acb0742e2003b2986c75a8f0967b7a7fdd5d661.tar.gz tcl-1acb0742e2003b2986c75a8f0967b7a7fdd5d661.tar.bz2 |
merge
Diffstat (limited to 'generic')
-rw-r--r-- | generic/regcustom.h | 8 | ||||
-rw-r--r-- | generic/regex.h | 60 | ||||
-rw-r--r-- | generic/tclInt.h | 1 | ||||
-rw-r--r-- | generic/tclInterp.c | 1 | ||||
-rw-r--r-- | generic/tclOO.c | 58 | ||||
-rw-r--r-- | generic/tclTest.c | 67 | ||||
-rw-r--r-- | generic/tclTestProcBodyObj.c | 2 | ||||
-rw-r--r-- | generic/tclThreadTest.c | 6 | ||||
-rw-r--r-- | generic/tclTrace.c | 3 | ||||
-rw-r--r-- | generic/tclZlib.c | 4 |
10 files changed, 125 insertions, 85 deletions
diff --git a/generic/regcustom.h b/generic/regcustom.h index 1c970ea..681b97d 100644 --- a/generic/regcustom.h +++ b/generic/regcustom.h @@ -60,12 +60,6 @@ #ifdef __REG_REGOFF_T #undef __REG_REGOFF_T #endif -#ifdef __REG_VOID_T -#undef __REG_VOID_T -#endif -#ifdef __REG_CONST -#undef __REG_CONST -#endif #ifdef __REG_NOFRONT #undef __REG_NOFRONT #endif @@ -75,8 +69,6 @@ /* Interface types */ #define __REG_WIDE_T Tcl_UniChar #define __REG_REGOFF_T long /* Not really right, but good enough... */ -#define __REG_VOID_T void -#define __REG_CONST const /* Names and declarations */ #define __REG_WIDE_COMPILE TclReComp #define __REG_WIDE_EXEC TclReExec diff --git a/generic/regex.h b/generic/regex.h index 53450e5..8845f72 100644 --- a/generic/regex.h +++ b/generic/regex.h @@ -92,12 +92,6 @@ extern "C" { #ifdef __REG_REGOFF_T #undef __REG_REGOFF_T #endif -#ifdef __REG_VOID_T -#undef __REG_VOID_T -#endif -#ifdef __REG_CONST -#undef __REG_CONST -#endif #ifdef __REG_NOFRONT #undef __REG_NOFRONT #endif @@ -107,8 +101,6 @@ extern "C" { /* interface types */ #define __REG_WIDE_T Tcl_UniChar #define __REG_REGOFF_T long /* not really right, but good enough... */ -#define __REG_VOID_T void -#define __REG_CONST const /* names and declarations */ #define __REG_WIDE_COMPILE TclReComp #define __REG_WIDE_EXEC TclReExec @@ -134,26 +126,6 @@ typedef long regoff_t; #endif /* - * For benefit of old compilers, we offer <sys/types.h> the option of - * overriding the `void' type used to declare nonexistent return types. - */ -#ifdef __REG_VOID_T -typedef __REG_VOID_T re_void; -#else -typedef void re_void; -#endif - -/* - * Also for benefit of old compilers, <sys/types.h> can supply a macro which - * expands to a substitute for `const'. - */ -#ifndef __REG_CONST -#define __REG_CONST const -#endif - - - -/* * other interface types */ @@ -197,13 +169,13 @@ typedef struct { /* * compilation ^ #ifndef __REG_NOCHAR - ^ int re_comp(regex_t *, __REG_CONST char *, size_t, int); + ^ int re_comp(regex_t *, const char *, size_t, int); ^ #endif ^ #ifndef __REG_NOFRONT - ^ int regcomp(regex_t *, __REG_CONST char *, int); + ^ int regcomp(regex_t *, const char *, int); ^ #endif ^ #ifdef __REG_WIDE_T - ^ int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int); + ^ int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int); ^ #endif */ #define REG_BASIC 000000 /* BREs (convenience) */ @@ -228,14 +200,14 @@ typedef struct { /* * execution ^ #ifndef __REG_NOCHAR - ^ int re_exec(regex_t *, __REG_CONST char *, size_t, + ^ int re_exec(regex_t *, const char *, size_t, ^ rm_detail_t *, size_t, regmatch_t [], int); ^ #endif ^ #ifndef __REG_NOFRONT - ^ int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int); + ^ int regexec(regex_t *, const char *, size_t, regmatch_t [], int); ^ #endif ^ #ifdef __REG_WIDE_T - ^ int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, + ^ int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, ^ rm_detail_t *, size_t, regmatch_t [], int); ^ #endif */ @@ -248,7 +220,7 @@ typedef struct { /* * misc generics (may be more functions here eventually) - ^ re_void regfree(regex_t *); + ^ void regfree(regex_t *); */ /* @@ -260,7 +232,7 @@ typedef struct { * of character is used for error reports is independent of what kind is used * in matching. * - ^ extern size_t regerror(int, __REG_CONST regex_t *, char *, size_t); + ^ extern size_t regerror(int, const regex_t *, char *, size_t); */ #define REG_OKAY 0 /* no errors detected */ #define REG_NOMATCH 1 /* failed to match */ @@ -293,25 +265,25 @@ typedef struct { /* automatically gathered by fwd; do not hand-edit */ /* === regproto.h === */ #ifndef __REG_NOCHAR -int re_comp(regex_t *, __REG_CONST char *, size_t, int); +int re_comp(regex_t *, const char *, size_t, int); #endif #ifndef __REG_NOFRONT -int regcomp(regex_t *, __REG_CONST char *, int); +int regcomp(regex_t *, const char *, int); #endif #ifdef __REG_WIDE_T -MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int); +MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int); #endif #ifndef __REG_NOCHAR -int re_exec(regex_t *, __REG_CONST char *, size_t, rm_detail_t *, size_t, regmatch_t [], int); +int re_exec(regex_t *, const char *, size_t, rm_detail_t *, size_t, regmatch_t [], int); #endif #ifndef __REG_NOFRONT -int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int); +int regexec(regex_t *, const char *, size_t, regmatch_t [], int); #endif #ifdef __REG_WIDE_T -MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int); +MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int); #endif -MODULE_SCOPE re_void regfree(regex_t *); -MODULE_SCOPE size_t regerror(int, __REG_CONST regex_t *, char *, size_t); +MODULE_SCOPE void regfree(regex_t *); +MODULE_SCOPE size_t regerror(int, const regex_t *, char *, size_t); /* automatically gathered by fwd; do not hand-edit */ /* =====^!^===== end forwards =====^!^===== */ diff --git a/generic/tclInt.h b/generic/tclInt.h index 68957e0..ca12549 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2839,7 +2839,6 @@ MODULE_SCOPE void TclFinalizeThreadStorage(void); MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); #endif -MODULE_SCOPE Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr); MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); MODULE_SCOPE void * TclpThreadCreateKey(void); MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 96efa8c..f285d99 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -1877,7 +1877,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/tclOO.c b/generic/tclOO.c index 90de84b..d08273b 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -58,6 +58,8 @@ static const struct { static Class * AllocClass(Tcl_Interp *interp, Object *useThisObj); static Object * AllocObject(Tcl_Interp *interp, const char *nameStr, const char *nsNameStr); +static void ClearMixins(Class *clsPtr); +static void ClearSuperclasses(Class *clsPtr); static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr, Method *mPtr, Tcl_Obj *namePtr, Method **newMPtrPtr); @@ -905,6 +907,34 @@ ObjectRenamedTrace( */ static void +ClearMixins( + Class *clsPtr) +{ + int i; + Class *mixinPtr; + + FOREACH(mixinPtr, clsPtr->mixins) { + TclOORemoveFromMixinSubs(clsPtr, mixinPtr); + } + ckfree(clsPtr->mixins.list); + clsPtr->mixins.num = 0; +} + +static void +ClearSuperclasses( + Class *clsPtr) +{ + int i; + Class *superPtr; + + FOREACH(superPtr, clsPtr->superclasses) { + TclOORemoveFromSubclasses(clsPtr, superPtr); + } + ckfree(clsPtr->superclasses.list); + clsPtr->superclasses.num = 0; +} + +static void ReleaseClassContents( Tcl_Interp *interp, /* The interpreter containing the class. */ Object *oPtr) /* The object representing the class. */ @@ -979,6 +1009,9 @@ ReleaseClassContents( Tcl_DeleteCommandFromToken(interp, mixinSubclassPtr->thisPtr->command); } + if (mixinSubclassPtr->mixins.num) { + ClearMixins(mixinSubclassPtr); + } DelRef(mixinSubclassPtr->thisPtr); DelRef(mixinSubclassPtr); } @@ -999,6 +1032,9 @@ ReleaseClassContents( if (!Deleted(subclassPtr->thisPtr)) { Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command); } + if (subclassPtr->superclasses.num) { + ClearSuperclasses(subclassPtr); + } DelRef(subclassPtr->thisPtr); DelRef(subclassPtr); } @@ -1195,7 +1231,6 @@ ObjectNamespaceDeleted( } if (clsPtr != NULL) { - Class *superPtr; Tcl_ObjectMetadataType *metadataTypePtr; ClientData value; @@ -1215,23 +1250,12 @@ ObjectNamespaceDeleted( ckfree(clsPtr->filters.list); clsPtr->filters.num = 0; } - FOREACH(mixinPtr, clsPtr->mixins) { - if (!Deleted(mixinPtr->thisPtr)) { - TclOORemoveFromMixinSubs(clsPtr, mixinPtr); - } - } - if (i) { - ckfree(clsPtr->mixins.list); - clsPtr->mixins.num = 0; - } - FOREACH(superPtr, clsPtr->superclasses) { - if (!Deleted(superPtr->thisPtr)) { - TclOORemoveFromSubclasses(clsPtr, superPtr); - } + + if (clsPtr->mixins.num) { + ClearMixins(clsPtr); } - if (i) { - ckfree(clsPtr->superclasses.list); - clsPtr->superclasses.num = 0; + if (clsPtr->superclasses.num) { + ClearSuperclasses(clsPtr); } if (clsPtr->subclasses.list) { ckfree(clsPtr->subclasses.list); diff --git a/generic/tclTest.c b/generic/tclTest.c index 8125289..aa75738 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -393,6 +393,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[]); @@ -674,6 +680,8 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, (ClientData) 0, NULL); #endif + Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind, + NULL, NULL); Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels, NULL, NULL); Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd, @@ -935,7 +943,7 @@ AsyncHandlerProc( listArgv[3] = NULL; cmd = Tcl_Merge(3, listArgv); if (interp != NULL) { - code = Tcl_Eval(interp, cmd); + code = Tcl_EvalEx(interp, cmd, -1, 0); } else { /* * this should not happen, but by definition of how async handlers are @@ -1218,7 +1226,7 @@ TestcmdtraceCmd( if (strcmp(argv[1], "tracetest") == 0) { Tcl_DStringInit(&buffer); cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); @@ -1234,13 +1242,13 @@ TestcmdtraceCmd( */ cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceDeleteProc, NULL); - Tcl_Eval(interp, argv[2]); + Tcl_EvalEx(interp, argv[2], -1, 0); } else if (strcmp(argv[1], "leveltest") == 0) { Interp *iPtr = (Interp *) interp; Tcl_DStringInit(&buffer); cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, CmdTraceProc, &buffer); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); @@ -1964,7 +1972,7 @@ EncodingToUtfProc( TclEncoding *encodingPtr; encodingPtr = (TclEncoding *) clientData; - Tcl_GlobalEval(encodingPtr->interp, encodingPtr->toUtfCmd); + Tcl_EvalEx(encodingPtr->interp,encodingPtr->toUtfCmd,-1,TCL_EVAL_GLOBAL); len = strlen(Tcl_GetStringResult(encodingPtr->interp)); if (len > dstLen) { @@ -1996,7 +2004,7 @@ EncodingFromUtfProc( TclEncoding *encodingPtr; encodingPtr = (TclEncoding *) clientData; - Tcl_GlobalEval(encodingPtr->interp, encodingPtr->fromUtfCmd); + Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd,-1,TCL_EVAL_GLOBAL); len = strlen(Tcl_GetStringResult(encodingPtr->interp)); if (len > dstLen) { @@ -4346,7 +4354,7 @@ TestfeventCmd( return TCL_ERROR; } if (interp2 != NULL) { - code = Tcl_GlobalEval(interp2, argv[2]); + code = Tcl_EvalEx(interp2, argv[2], -1, TCL_EVAL_GLOBAL); Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2)); return code; } else { @@ -6550,6 +6558,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/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index 0d3617e..4d32c5a 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -143,7 +143,7 @@ RegisterCommand( if (cmdTablePtr->exportIt) { sprintf(buf, "namespace eval %s { namespace export %s }", namespace, cmdTablePtr->cmdName); - if (Tcl_Eval(interp, buf) != TCL_OK) { + if (Tcl_EvalEx(interp, buf, -1, 0) != TCL_OK) { return TCL_ERROR; } } diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 02ee038..75f8a15 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -613,7 +613,7 @@ NewTestThread( */ Tcl_Preserve(tsdPtr->interp); - result = Tcl_Eval(tsdPtr->interp, threadEvalScript); + result = Tcl_EvalEx(tsdPtr->interp, threadEvalScript, -1, 0); if (result != TCL_OK) { ThreadErrorProc(tsdPtr->interp); } @@ -834,7 +834,7 @@ ThreadSend( if (threadId == Tcl_GetCurrentThread()) { Tcl_MutexUnlock(&threadMutex); - return Tcl_GlobalEval(interp, script); + return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL); } /* @@ -1029,7 +1029,7 @@ ThreadEventProc( Tcl_Preserve(interp); Tcl_ResetResult(interp); Tcl_CreateThreadExitHandler(ThreadFreeProc, threadEventPtr->script); - code = Tcl_GlobalEval(interp, threadEventPtr->script); + code = Tcl_EvalEx(interp, threadEventPtr->script,-1,TCL_EVAL_GLOBAL); Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script); if (code != TCL_OK) { errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY); diff --git a/generic/tclTrace.c b/generic/tclTrace.c index fe52d59..4e74c54 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1889,7 +1889,8 @@ TraceExecutionProc( * interpreter. */ - traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd)); + traceCode = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), + Tcl_DStringLength(&cmd), 0); tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS; /* diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 44dd9e0..ba3e9cb 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -762,7 +762,7 @@ Tcl_ZlibStreamInit( */ if (interp != NULL) { - if (Tcl_Eval(interp, "::incr ::tcl::zlib::cmdcounter") != TCL_OK) { + if (Tcl_EvalEx(interp, "::incr ::tcl::zlib::cmdcounter", -1, 0) != TCL_OK) { goto error; } Tcl_DStringInit(&cmdname); @@ -3816,7 +3816,7 @@ TclZlibInit( * commands. */ - Tcl_Eval(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}"); + Tcl_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}", -1, 0); /* * Create the public scripted interface to this file's functionality. |