summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog16
-rw-r--r--doc/Object.34
-rw-r--r--doc/ObjectType.38
-rw-r--r--generic/tcl.decls8
-rw-r--r--generic/tcl.h7
-rw-r--r--generic/tclCompCmds.c6
-rw-r--r--generic/tclDecls.h15
-rw-r--r--generic/tclOOMethod.c4
-rw-r--r--generic/tclObj.c50
-rw-r--r--generic/tclTestObj.c4
10 files changed, 70 insertions, 52 deletions
diff --git a/ChangeLog b/ChangeLog
index 2d093b6..43c21e4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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: