diff options
| -rw-r--r-- | ChangeLog | 16 | ||||
| -rw-r--r-- | doc/Object.3 | 4 | ||||
| -rw-r--r-- | doc/ObjectType.3 | 8 | ||||
| -rw-r--r-- | generic/tcl.decls | 8 | ||||
| -rw-r--r-- | generic/tcl.h | 7 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 6 | ||||
| -rw-r--r-- | generic/tclDecls.h | 15 | ||||
| -rw-r--r-- | generic/tclOOMethod.c | 4 | ||||
| -rw-r--r-- | generic/tclObj.c | 50 | ||||
| -rw-r--r-- | generic/tclTestObj.c | 4 |
10 files changed, 70 insertions, 52 deletions
@@ -1,3 +1,19 @@ +2007-07-27 Jan Nijtmans <nijtmans@users.sf.net> + + * doc/Object.3 CONSTified 3 functions using + * doc/ObjectType.3 Tcl_ObjType which all are supposed + * generic/tcl.decls to be a constant, but this was not + * generic/tcl.h reflected in the API: + * generic/tclDecls.h Tcl_ConvertToType + * generic/tclObj.c Tcl_GetObjType + * generic/tclCompCmds.c Tcl_RegisterObjType + * generic/tclOOMethod.c Introduced a CONST86_RETURN, so extensions which + * generic/tclTestobj.c use Tcl_ObjType directly can be modified to compile + against both Tcl 8.5 and Tcl 8.6 + tclDecls.h is re-generated with "make genstubs" + This change complies with TIP #24 + ***POTENTIAL INCOMPATIBILITY*** + 2008-07-25 Andreas Kupries <andreask@activestate.com> * test/info.test: More work on singleTestInterp usability. This diff --git a/doc/Object.3 b/doc/Object.3 index 6951f10..3b6abc8 100644 --- a/doc/Object.3 +++ b/doc/Object.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: Object.3,v 1.20 2008/06/29 22:28:24 dkf Exp $ +'\" RCS: @(#) $Id: Object.3,v 1.21 2008/07/27 22:18:21 nijtmans Exp $ '\" .so man.macros .TH Tcl_Obj 3 8.5 Tcl "Tcl Library Procedures" @@ -114,7 +114,7 @@ typedef struct Tcl_Obj { int \fIrefCount\fR; char *\fIbytes\fR; int \fIlength\fR; - Tcl_ObjType *\fItypePtr\fR; + const Tcl_ObjType *\fItypePtr\fR; union { long \fIlongValue\fR; double \fIdoubleValue\fR; diff --git a/doc/ObjectType.3 b/doc/ObjectType.3 index 902c8da..30158ce 100644 --- a/doc/ObjectType.3 +++ b/doc/ObjectType.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: ObjectType.3,v 1.19 2008/06/30 15:58:06 dgp Exp $ +'\" RCS: @(#) $Id: ObjectType.3,v 1.20 2008/07/27 22:18:21 nijtmans Exp $ '\" .so man.macros .TH Tcl_ObjType 3 8.0 Tcl "Tcl Library Procedures" @@ -17,7 +17,7 @@ Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType \ .sp \fBTcl_RegisterObjType\fR(\fItypePtr\fR) .sp -Tcl_ObjType * +const Tcl_ObjType * \fBTcl_GetObjType\fR(\fItypeName\fR) .sp int @@ -27,7 +27,7 @@ int \fBTcl_ConvertToType\fR(\fIinterp, objPtr, typePtr\fR) .SH ARGUMENTS .AS "const char" *typeName -.AP Tcl_ObjType *typePtr in +.AP "const Tcl_ObjType" *typePtr in Points to the structure containing information about the Tcl object type. This storage must live forever, typically by being statically allocated. @@ -107,7 +107,7 @@ The \fBTcl_ObjType\fR structure is defined as follows: .PP .CS typedef struct Tcl_ObjType { - char *\fIname\fR; + const char *\fIname\fR; Tcl_FreeInternalRepProc *\fIfreeIntRepProc\fR; Tcl_DupInternalRepProc *\fIdupIntRepProc\fR; Tcl_UpdateStringProc *\fIupdateStringProc\fR; diff --git a/generic/tcl.decls b/generic/tcl.decls index 1b6326d..8fc52ac 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.decls,v 1.139 2008/07/24 22:57:57 nijtmans Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.140 2008/07/27 22:18:21 nijtmans Exp $ library tcl @@ -94,7 +94,7 @@ declare 17 generic { } declare 18 generic { int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr, - Tcl_ObjType *typePtr) + CONST86 Tcl_ObjType *typePtr) } declare 19 generic { void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, CONST char *file, int line) @@ -167,7 +167,7 @@ declare 39 generic { int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr) } declare 40 generic { - Tcl_ObjType * Tcl_GetObjType(CONST char *typeName) + CONST86_RETURN Tcl_ObjType * Tcl_GetObjType(CONST char *typeName) } declare 41 generic { char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr) @@ -752,7 +752,7 @@ declare 210 generic { void Tcl_RegisterChannel(Tcl_Interp *interp, Tcl_Channel chan) } declare 211 generic { - void Tcl_RegisterObjType(Tcl_ObjType *typePtr) + void Tcl_RegisterObjType(CONST86 Tcl_ObjType *typePtr) } declare 212 generic { Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, CONST char *pattern) diff --git a/generic/tcl.h b/generic/tcl.h index 6b539ea..c98cef2 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.262 2008/07/24 21:54:38 nijtmans Exp $ + * RCS: @(#) $Id: tcl.h,v 1.263 2008/07/27 22:18:23 nijtmans Exp $ */ #ifndef _TCL @@ -262,6 +262,7 @@ extern "C" { #endif #define CONST86 CONST84 +#define CONST86_RETURN CONST84_RETURN /* * Make sure EXTERN isn't defined elsewhere @@ -721,7 +722,7 @@ typedef void (Tcl_MainLoopProc) _ANSI_ARGS_((void)); */ typedef struct Tcl_ObjType { - char *name; /* Name of the type, e.g. "int". */ + CONST86 char *name; /* Name of the type, e.g. "int". */ Tcl_FreeInternalRepProc *freeIntRepProc; /* Called to free any storage for the type's * internal rep. NULL if the internal rep does @@ -759,7 +760,7 @@ typedef struct Tcl_Obj { * array as a readonly value. */ int length; /* The number of bytes at *bytes, not * including the terminating null. */ - Tcl_ObjType *typePtr; /* Denotes the object's type. Always + CONST86 Tcl_ObjType *typePtr; /* Denotes the object's type. Always * corresponds to the type of the object's * internal rep. NULL indicates the object has * no internal rep (has no type). */ diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index ac0b2c2..dae4417 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmds.c,v 1.145 2008/06/08 03:21:32 msofer Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.146 2008/07/27 22:18:22 nijtmans Exp $ */ #include "tclInt.h" @@ -425,7 +425,7 @@ TclCompileCatchCmd( if (resultIndex < 0) { return TCL_ERROR; } - + /* DKF */ if (parsePtr->numWords == 4) { optsNameTokenPtr = TokenAfter(resultNameTokenPtr); @@ -5840,7 +5840,7 @@ TclCompileUpvarCmd( tokenPtr = TokenAfter(parsePtr->tokenPtr); if(TclWordKnownAtCompileTime(tokenPtr, objPtr)) { CallFrame *framePtr; - Tcl_ObjType *newTypePtr, *typePtr = objPtr->typePtr; + const Tcl_ObjType *newTypePtr, *typePtr = objPtr->typePtr; /* * Attempt to convert to a level reference. Note that TclObjGetFrame diff --git a/generic/tclDecls.h b/generic/tclDecls.h index bb44d58..880e40c 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDecls.h,v 1.141 2008/07/24 22:57:57 nijtmans Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.142 2008/07/27 22:18:23 nijtmans Exp $ */ #ifndef _TCLDECLS @@ -160,7 +160,8 @@ EXTERN Tcl_Obj * Tcl_ConcatObj (int objc, Tcl_Obj *CONST objv[]); #define Tcl_ConvertToType_TCL_DECLARED /* 18 */ EXTERN int Tcl_ConvertToType (Tcl_Interp * interp, - Tcl_Obj * objPtr, Tcl_ObjType * typePtr); + Tcl_Obj * objPtr, + CONST86 Tcl_ObjType * typePtr); #endif #ifndef Tcl_DbDecrRefCount_TCL_DECLARED #define Tcl_DbDecrRefCount_TCL_DECLARED @@ -289,7 +290,7 @@ EXTERN int Tcl_GetLongFromObj (Tcl_Interp * interp, #ifndef Tcl_GetObjType_TCL_DECLARED #define Tcl_GetObjType_TCL_DECLARED /* 40 */ -EXTERN Tcl_ObjType * Tcl_GetObjType (CONST char * typeName); +EXTERN CONST86_RETURN Tcl_ObjType * Tcl_GetObjType (CONST char * typeName); #endif #ifndef Tcl_GetStringFromObj_TCL_DECLARED #define Tcl_GetStringFromObj_TCL_DECLARED @@ -1336,7 +1337,7 @@ EXTERN void Tcl_RegisterChannel (Tcl_Interp * interp, #ifndef Tcl_RegisterObjType_TCL_DECLARED #define Tcl_RegisterObjType_TCL_DECLARED /* 211 */ -EXTERN void Tcl_RegisterObjType (Tcl_ObjType * typePtr); +EXTERN void Tcl_RegisterObjType (CONST86 Tcl_ObjType * typePtr); #endif #ifndef Tcl_RegExpCompile_TCL_DECLARED #define Tcl_RegExpCompile_TCL_DECLARED @@ -3609,7 +3610,7 @@ typedef struct TclStubs { void (*tcl_AppendStringsToObj) (Tcl_Obj * objPtr, ...); /* 15 */ void (*tcl_AppendToObj) (Tcl_Obj* objPtr, CONST char* bytes, int length); /* 16 */ Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *CONST objv[]); /* 17 */ - int (*tcl_ConvertToType) (Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_ObjType * typePtr); /* 18 */ + int (*tcl_ConvertToType) (Tcl_Interp * interp, Tcl_Obj * objPtr, CONST86 Tcl_ObjType * typePtr); /* 18 */ void (*tcl_DbDecrRefCount) (Tcl_Obj * objPtr, CONST char * file, int line); /* 19 */ void (*tcl_DbIncrRefCount) (Tcl_Obj * objPtr, CONST char * file, int line); /* 20 */ int (*tcl_DbIsShared) (Tcl_Obj * objPtr, CONST char * file, int line); /* 21 */ @@ -3631,7 +3632,7 @@ typedef struct TclStubs { int (*tcl_GetInt) (Tcl_Interp * interp, CONST char * src, int * intPtr); /* 37 */ int (*tcl_GetIntFromObj) (Tcl_Interp * interp, Tcl_Obj * objPtr, int * intPtr); /* 38 */ int (*tcl_GetLongFromObj) (Tcl_Interp * interp, Tcl_Obj * objPtr, long * longPtr); /* 39 */ - Tcl_ObjType * (*tcl_GetObjType) (CONST char * typeName); /* 40 */ + CONST86_RETURN Tcl_ObjType * (*tcl_GetObjType) (CONST char * typeName); /* 40 */ char * (*tcl_GetStringFromObj) (Tcl_Obj * objPtr, int * lengthPtr); /* 41 */ void (*tcl_InvalidateStringRep) (Tcl_Obj * objPtr); /* 42 */ int (*tcl_ListObjAppendList) (Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * elemListPtr); /* 43 */ @@ -3834,7 +3835,7 @@ typedef struct TclStubs { int (*tcl_RecordAndEval) (Tcl_Interp * interp, CONST char * cmd, int flags); /* 208 */ int (*tcl_RecordAndEvalObj) (Tcl_Interp * interp, Tcl_Obj * cmdPtr, int flags); /* 209 */ void (*tcl_RegisterChannel) (Tcl_Interp * interp, Tcl_Channel chan); /* 210 */ - void (*tcl_RegisterObjType) (Tcl_ObjType * typePtr); /* 211 */ + void (*tcl_RegisterObjType) (CONST86 Tcl_ObjType * typePtr); /* 211 */ Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp * interp, CONST char * pattern); /* 212 */ int (*tcl_RegExpExec) (Tcl_Interp * interp, Tcl_RegExp regexp, CONST char * text, CONST char * start); /* 213 */ int (*tcl_RegExpMatch) (Tcl_Interp * interp, CONST char * text, CONST char * pattern); /* 214 */ diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 3afe314..8dfb834 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOOMethod.c,v 1.8 2008/07/18 23:29:44 msofer Exp $ + * RCS: @(#) $Id: tclOOMethod.c,v 1.9 2008/07/27 22:18:23 nijtmans Exp $ */ #ifdef HAVE_CONFIG_H @@ -736,7 +736,7 @@ PushMethodCallFrame( register int result; const char *namePtr; CallFrame **framePtrPtr = &fdPtr->framePtr; - static Tcl_ObjType *byteCodeTypePtr = NULL; /* HACK! */ + static const Tcl_ObjType *byteCodeTypePtr = NULL; /* HACK! */ /* * Compute basic information on the basis of the type of method it is. diff --git a/generic/tclObj.c b/generic/tclObj.c index 12c31f9..f445f08 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclObj.c,v 1.141 2008/04/27 22:21:31 dkf Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.142 2008/07/27 22:18:21 nijtmans Exp $ */ #include "tclInt.h" @@ -440,7 +440,7 @@ TclFinalizeObjects(void) void Tcl_RegisterObjType( - Tcl_ObjType *typePtr) /* Information about object type; storage must + const Tcl_ObjType *typePtr) /* Information about object type; storage must * be statically allocated (must live * forever). */ { @@ -527,17 +527,17 @@ Tcl_AppendAllObjTypes( *---------------------------------------------------------------------- */ -Tcl_ObjType * +const Tcl_ObjType * Tcl_GetObjType( const char *typeName) /* Name of Tcl object type to look up. */ { register Tcl_HashEntry *hPtr; - Tcl_ObjType *typePtr = NULL; + const Tcl_ObjType *typePtr = NULL; Tcl_MutexLock(&tableMutex); hPtr = Tcl_FindHashEntry(&typeTable, typeName); if (hPtr != NULL) { - typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr); + typePtr = (const Tcl_ObjType *) Tcl_GetHashValue(hPtr); } Tcl_MutexUnlock(&tableMutex); return typePtr; @@ -567,7 +567,7 @@ int Tcl_ConvertToType( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object to convert. */ - Tcl_ObjType *typePtr) /* The target type. */ + const Tcl_ObjType *typePtr) /* The target type. */ { if (objPtr->typePtr == typePtr) { return TCL_OK; @@ -833,7 +833,7 @@ void TclFreeObj( register Tcl_Obj *objPtr) /* The object to be freed. */ { - register Tcl_ObjType *typePtr = objPtr->typePtr; + register const Tcl_ObjType *typePtr = objPtr->typePtr; /* * This macro declares a variable, so must come here... @@ -845,10 +845,10 @@ TclFreeObj( Tcl_Panic("Reference count for %lx was negative", objPtr); } - /* Invalidate the string rep first so we can use the bytes value + /* Invalidate the string rep first so we can use the bytes value * for our pointer chain, and signal an obj deletion (as opposed - * to shimmering) with 'length == -1' */ - + * to shimmering) with 'length == -1' */ + TclInvalidateStringRep(objPtr); objPtr->length = -1; @@ -888,13 +888,13 @@ void TclFreeObj( register Tcl_Obj *objPtr) /* The object to be freed. */ { - /* Invalidate the string rep first so we can use the bytes value + /* Invalidate the string rep first so we can use the bytes value * for our pointer chain, and signal an obj deletion (as opposed - * to shimmering) with 'length == -1' */ + * to shimmering) with 'length == -1' */ TclInvalidateStringRep(objPtr); objPtr->length = -1; - + if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) { /* * objPtr can be freed safely, as it will not attempt to free any @@ -1008,7 +1008,7 @@ Tcl_Obj * Tcl_DuplicateObj( register Tcl_Obj *objPtr) /* The object to duplicate. */ { - register Tcl_ObjType *typePtr = objPtr->typePtr; + register const Tcl_ObjType *typePtr = objPtr->typePtr; register Tcl_Obj *dupPtr; TclNewObj(dupPtr); @@ -3517,7 +3517,7 @@ Tcl_GetCommandFromObj( * is not deleted. * * If any check fails, then force another conversion to the command type, - * to discard the old rep and create a new one. + * to discard the old rep and create a new one. */ resPtr = objPtr->internalRep.twoPtrValue.ptr1; @@ -3526,15 +3526,15 @@ Tcl_GetCommandFromObj( || (cmdPtr = resPtr->cmdPtr, cmdPtr->cmdEpoch != resPtr->cmdEpoch) || (interp != cmdPtr->nsPtr->interp) || (cmdPtr->flags & CMD_IS_DELETED) - || ((resPtr->refNsPtr != NULL) && + || ((resPtr->refNsPtr != NULL) && (((refNsPtr = (Namespace *) TclGetCurrentNamespace(interp)) != resPtr->refNsPtr) || (resPtr->refNsId != refNsPtr->nsId) || (resPtr->refNsCmdEpoch != refNsPtr->cmdRefEpoch))) ) { - + result = tclCmdNameType.setFromAnyProc(interp, objPtr); - + resPtr = objPtr->internalRep.twoPtrValue.ptr1; if ((result == TCL_OK) && resPtr) { cmdPtr = resPtr->cmdPtr; @@ -3542,7 +3542,7 @@ Tcl_GetCommandFromObj( cmdPtr = NULL; } } - + return (Tcl_Command) cmdPtr; } @@ -3594,7 +3594,7 @@ TclSetCmdNameObj( if ((*name++ == ':') && (*name == ':')) { /* * The name is fully qualified: set the referring namespace to - * NULL. + * NULL. */ resPtr->refNsPtr = NULL; @@ -3604,7 +3604,7 @@ TclSetCmdNameObj( */ currNsPtr = iPtr->varFramePtr->nsPtr; - + resPtr->refNsPtr = currNsPtr; resPtr->refNsId = currNsPtr->nsId; resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch; @@ -3759,7 +3759,7 @@ SetCmdNameFromAny( /* * Reuse the old ResolvedCmdName struct instead of freeing it */ - + Command *oldCmdPtr = resPtr->cmdPtr; if (--oldCmdPtr->refCount == 0) { @@ -3777,8 +3777,8 @@ SetCmdNameFromAny( resPtr->cmdEpoch = cmdPtr->cmdEpoch; if ((*name++ == ':') && (*name == ':')) { /* - * The name is fully qualified: set the referring namespace to - * NULL. + * The name is fully qualified: set the referring namespace to + * NULL. */ resPtr->refNsPtr = NULL; @@ -3788,7 +3788,7 @@ SetCmdNameFromAny( */ currNsPtr = iPtr->varFramePtr->nsPtr; - + resPtr->refNsPtr = currNsPtr; resPtr->refNsId = currNsPtr->nsId; resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch; diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index b39b81d..c0d4f17 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTestObj.c,v 1.23 2008/07/19 22:50:43 nijtmans Exp $ + * RCS: @(#) $Id: tclTestObj.c,v 1.24 2008/07/27 22:18:23 nijtmans Exp $ */ #include "tclInt.h" @@ -801,7 +801,7 @@ TestobjCmd( { int varIndex, destIndex, i; char *index, *subCmd, *string; - Tcl_ObjType *targetType; + const Tcl_ObjType *targetType; if (objc < 2) { wrongNumArgs: |