summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog24
-rw-r--r--generic/tclBinary.c16
-rw-r--r--generic/tclCompile.c7
-rw-r--r--generic/tclDictObj.c10
-rw-r--r--generic/tclIndexObj.c7
-rw-r--r--generic/tclInt.h18
-rw-r--r--generic/tclListObj.c13
-rw-r--r--generic/tclNamesp.c13
-rw-r--r--generic/tclObj.c84
-rw-r--r--generic/tclPathObj.c18
-rw-r--r--generic/tclRegexp.c13
-rw-r--r--generic/tclResult.c7
-rw-r--r--generic/tclStringObj.c18
-rw-r--r--generic/tclUtil.c9
-rw-r--r--generic/tclVar.c18
15 files changed, 102 insertions, 173 deletions
diff --git a/ChangeLog b/ChangeLog
index 0daa6ae..1bb2811 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,27 @@
+2004-09-29 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclVar.c (TclObjLookupVar, TclObjLookupVar):
+ (TclObjUnsetVar2, SetArraySearchObj):
+ * generic/tclUtil.c (SetEndOffsetFromAny):
+ * generic/tclStringObj.c (Tcl_SetStringObj):
+ (Tcl_SetUnicodeObj, SetStringFromAny):
+ * generic/tclResult.c (ResetObjResult):
+ * generic/tclRegexp.c (Tcl_GetRegExpFromObj):
+ * generic/tclPathObj.c (TclFSMakePathRelative, SetFsPathFromAny):
+ (TclFSMakePathFromNormalized, Tcl_FSNewNativePath):
+ * generic/tclObj.c (TclFreeObj, Tcl_SetBooleanObj, SetBooleanFromAny):
+ (Tcl_SetDoubleObj, SetDoubleFromAny, Tcl_SetIntObj):
+ (SetIntOrWideFromAny, Tcl_SetLongObj, SetWideIntFromAny):
+ (Tcl_SetWideIntObj, TclSetCmdNameObj, SetCmdNameFromAny):
+ * generic/tclNamesp.c (SetNsNameFromAny, MakeCachedEnsembleCommand):
+ * generic/tclListObj.c (Tcl_SetListObj, SetListFromAny):
+ * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct):
+ * generic/tclDictObj.c (SetDictFromAny):
+ * generic/tclCompile.c (TclInitByteCodeObj):
+ * generic/tclBinary.c (Tcl_SetByteArrayObj, SetByteArrayFromAny):
+ * generic/tclInt.h (TclFreeIntRep): Factorize out deletion of object
+ internal representation to a shared macro, so simplifying much code.
+
2004-09-27 Miguel Sofer <msofer@users.sf.net>
* generic/tclBasic.c (TclObjInvoke): fix for bogus gcc warning
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 44fb2f0..28f83ad 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBinary.c,v 1.18 2004/05/13 10:12:55 dkf Exp $
+ * RCS: @(#) $Id: tclBinary.c,v 1.19 2004/09/29 22:17:33 dkf Exp $
*/
#include "tclInt.h"
@@ -268,16 +268,12 @@ Tcl_SetByteArrayObj(objPtr, bytes, length)
int length; /* Length of the array of bytes, which must
* be >= 0. */
{
- Tcl_ObjType *typePtr;
ByteArray *byteArrayPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("Tcl_SetByteArrayObj called with shared object");
}
- typePtr = objPtr->typePtr;
- if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
- (*typePtr->freeIntRepProc)(objPtr);
- }
+ TclFreeIntRep(objPtr);
Tcl_InvalidateStringRep(objPtr);
byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
@@ -397,15 +393,13 @@ SetByteArrayFromAny(interp, objPtr)
Tcl_Interp *interp; /* Not used. */
Tcl_Obj *objPtr; /* The object to convert to type ByteArray. */
{
- Tcl_ObjType *typePtr;
int length;
char *src, *srcEnd;
unsigned char *dst;
ByteArray *byteArrayPtr;
Tcl_UniChar ch;
- typePtr = objPtr->typePtr;
- if (typePtr != &tclByteArrayType) {
+ if (objPtr->typePtr != &tclByteArrayType) {
src = Tcl_GetStringFromObj(objPtr, &length);
srcEnd = src + length;
@@ -418,9 +412,7 @@ SetByteArrayFromAny(interp, objPtr)
byteArrayPtr->used = dst - byteArrayPtr->bytes;
byteArrayPtr->allocated = length;
- if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
- (*typePtr->freeIntRepProc)(objPtr);
- }
+ TclFreeIntRep(objPtr);
objPtr->typePtr = &tclByteArrayType;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 7b79e66..a262f34 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.c,v 1.75 2004/09/26 16:36:04 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.76 2004/09/29 22:17:31 dkf Exp $
*/
#include "tclInt.h"
@@ -1732,10 +1732,7 @@ TclInitByteCodeObj(objPtr, envPtr)
* compiled ByteCode.
*/
- if ((objPtr->typePtr != NULL) &&
- (objPtr->typePtr->freeIntRepProc != NULL)) {
- (*objPtr->typePtr->freeIntRepProc)(objPtr);
- }
+ TclFreeIntRep(objPtr);
objPtr->internalRep.otherValuePtr = (VOID *) codePtr;
objPtr->typePtr = &tclByteCodeType;
}
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 4b5f4d4..327fb92 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclDictObj.c,v 1.17 2004/07/11 23:01:28 dkf Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.18 2004/09/29 22:17:31 dkf Exp $
*/
#include "tclInt.h"
@@ -361,7 +361,6 @@ SetDictFromAny(interp, objPtr)
Tcl_Interp *interp;
Tcl_Obj *objPtr;
{
- Tcl_ObjType *oldTypePtr = objPtr->typePtr;
char *string, *s;
CONST char *elemStart, *nextElem;
int lenRemain, length, elemSize, hasBrace, result, isNew;
@@ -378,7 +377,7 @@ SetDictFromAny(interp, objPtr)
* special-case the conversion from lists to dictionaries.
*/
- if (oldTypePtr == &tclListType) {
+ if (objPtr->typePtr == &tclListType) {
int objc, i;
Tcl_Obj **objv;
@@ -523,10 +522,7 @@ SetDictFromAny(interp, objPtr)
* Tcl_GetStringFromObj, to use that old internalRep.
*/
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
-
+ TclFreeIntRep(objPtr);
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index ce1a07e..f752a91 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIndexObj.c,v 1.18 2004/04/06 22:25:53 dgp Exp $
+ * RCS: @(#) $Id: tclIndexObj.c,v 1.19 2004/09/29 22:17:31 dkf Exp $
*/
#include "tclInt.h"
@@ -249,10 +249,7 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
if (objPtr->typePtr == &tclIndexType) {
indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
} else {
- if ((objPtr->typePtr != NULL)
- && (objPtr->typePtr->freeIntRepProc != NULL)) {
- objPtr->typePtr->freeIntRepProc(objPtr);
- }
+ TclFreeIntRep(objPtr);
indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
objPtr->internalRep.otherValuePtr = (VOID *) indexRep;
objPtr->typePtr = &tclIndexType;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4c8c940..249c96e 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.175 2004/09/27 14:31:18 kennykb Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.176 2004/09/29 22:17:31 dkf Exp $
*/
#ifndef _TCLINT
@@ -2477,6 +2477,22 @@ EXTERN void TclDbInitNewObj _ANSI_ARGS_((Tcl_Obj *objPtr));
/*
*----------------------------------------------------------------
+ * Macro used by the Tcl core to clean out an object's internal
+ * representation. Does not actually reset the rep's bytes.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * EXTERN void TclFreeIntRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+ *----------------------------------------------------------------
+ */
+
+#define TclFreeIntRep(objPtr) \
+ if ((objPtr)->typePtr != NULL && \
+ (objPtr)->typePtr->freeIntRepProc != NULL) { \
+ (objPtr)->typePtr->freeIntRepProc(objPtr); \
+ }
+
+/*
+ *----------------------------------------------------------------
* Macro used by the Tcl core to get a Tcl_WideInt value out of
* a Tcl_Obj of the "wideInt" type. Different implementation on
* different platforms depending whether TCL_WIDE_INT_IS_LONG.
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index c990045..ef88192 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclListObj.c,v 1.18 2003/12/24 04:18:20 davygrvy Exp $
+ * RCS: @(#) $Id: tclListObj.c,v 1.19 2004/09/29 22:17:30 dkf Exp $
*/
#include "tclInt.h"
@@ -351,7 +351,6 @@ Tcl_SetListObj(objPtr, objc, objv)
{
register Tcl_Obj **elemPtrs;
register List *listRepPtr;
- Tcl_ObjType *oldTypePtr = objPtr->typePtr;
int i;
if (Tcl_IsShared(objPtr)) {
@@ -362,9 +361,7 @@ Tcl_SetListObj(objPtr, objc, objv)
* Free any old string rep and any internal rep for the old type.
*/
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
+ TclFreeIntRep(objPtr);
objPtr->typePtr = NULL;
Tcl_InvalidateStringRep(objPtr);
@@ -1559,7 +1556,6 @@ SetListFromAny(interp, objPtr)
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr; /* The object to convert. */
{
- Tcl_ObjType *oldTypePtr = objPtr->typePtr;
char *string, *s;
CONST char *elemStart, *nextElem;
int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
@@ -1652,10 +1648,7 @@ SetListFromAny(interp, objPtr)
* Tcl_GetStringFromObj, to use that old internalRep.
*/
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
-
+ TclFreeIntRep(objPtr);
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclListType;
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index abd179c..9238001 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -21,7 +21,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.55 2004/09/24 01:14:43 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.56 2004/09/29 22:17:30 dkf Exp $
*/
#include "tclInt.h"
@@ -4051,7 +4051,6 @@ SetNsNameFromAny(interp, objPtr)
* reporting if not NULL. */
register Tcl_Obj *objPtr; /* The object to convert. */
{
- register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
char *name;
CONST char *dummy;
Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
@@ -4101,10 +4100,7 @@ SetNsNameFromAny(interp, objPtr)
* (in particular, Tcl_GetStringFromObj) to use that old internalRep.
*/
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
-
+ TclFreeIntRep(objPtr);
objPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
objPtr->typePtr = &tclNsNameType;
return TCL_OK;
@@ -5149,10 +5145,7 @@ MakeCachedEnsembleCommand(objPtr, ensemblePtr, subcommandName, prefixObjPtr)
* Kill the old internal rep, and replace it with a brand new
* one of our own.
*/
- if ((objPtr->typePtr != NULL)
- && (objPtr->typePtr->freeIntRepProc != NULL)) {
- objPtr->typePtr->freeIntRepProc(objPtr);
- }
+ TclFreeIntRep(objPtr);
ensembleCmd = (EnsembleCmdRep *) ckalloc(sizeof(EnsembleCmdRep));
objPtr->internalRep.otherValuePtr = (VOID *) ensembleCmd;
objPtr->typePtr = &tclEnsembleCmdType;
diff --git a/generic/tclObj.c b/generic/tclObj.c
index c043562..107fb59 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -11,7 +11,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.68 2004/09/27 21:57:10 dkf Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.69 2004/09/29 22:17:30 dkf Exp $
*/
#include "tclInt.h"
@@ -518,6 +518,10 @@ Tcl_ConvertToType(interp, objPtr, typePtr)
* representation.
*/
+ if (typePtr->setFromAnyProc == NULL) {
+ Tcl_Panic("may not convert object to type %s", typePtr->name);
+ }
+
return typePtr->setFromAnyProc(interp, objPtr);
}
@@ -797,11 +801,7 @@ TclFreeObj(objPtr)
Tcl_Obj *objToFree;
TclPopObjToDelete(context,objToFree);
-
- if ((objToFree->typePtr != NULL)
- && (objToFree->typePtr->freeIntRepProc != NULL)) {
- objToFree->typePtr->freeIntRepProc(objToFree);
- }
+ TclFreeIntRep(objToFree);
Tcl_MutexLock(&tclObjMutex);
ckfree((char *) objToFree);
@@ -1130,16 +1130,11 @@ Tcl_SetBooleanObj(objPtr, boolValue)
register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
register int boolValue; /* Boolean used to set object's value. */
{
- register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("Tcl_SetBooleanObj called with shared object");
}
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
-
+ TclFreeIntRep(objPtr);
objPtr->internalRep.longValue = (boolValue? 1 : 0);
objPtr->typePtr = &tclBooleanType;
Tcl_InvalidateStringRep(objPtr);
@@ -1211,7 +1206,6 @@ SetBooleanFromAny(interp, objPtr)
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr; /* The object to convert. */
{
- Tcl_ObjType *oldTypePtr = objPtr->typePtr;
char *string, *end;
register char c;
char lowerCase[8];
@@ -1412,10 +1406,7 @@ SetBooleanFromAny(interp, objPtr)
*/
goodBoolean:
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
-
+ TclFreeIntRep(objPtr);
objPtr->internalRep.longValue = newBool;
objPtr->typePtr = &tclBooleanType;
return TCL_OK;
@@ -1594,16 +1585,11 @@ Tcl_SetDoubleObj(objPtr, dblValue)
register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
register double dblValue; /* Double used to set the object's value. */
{
- register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("Tcl_SetDoubleObj called with shared object");
}
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
-
+ TclFreeIntRep(objPtr);
objPtr->internalRep.doubleValue = dblValue;
objPtr->typePtr = &tclDoubleType;
Tcl_InvalidateStringRep(objPtr);
@@ -1678,7 +1664,6 @@ SetDoubleFromAny(interp, objPtr)
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr; /* The object to convert. */
{
- Tcl_ObjType *oldTypePtr = objPtr->typePtr;
char *string, *end;
double newDouble;
int length;
@@ -1734,10 +1719,7 @@ SetDoubleFromAny(interp, objPtr)
* internalRep.
*/
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
-
+ TclFreeIntRep(objPtr);
objPtr->internalRep.doubleValue = newDouble;
objPtr->typePtr = &tclDoubleType;
return TCL_OK;
@@ -1860,16 +1842,11 @@ Tcl_SetIntObj(objPtr, intValue)
register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
register int intValue; /* Integer used to set object's value. */
{
- register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("Tcl_SetIntObj called with shared object");
}
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
-
+ TclFreeIntRep(objPtr);
objPtr->internalRep.longValue = (long) intValue;
objPtr->typePtr = &tclIntType;
Tcl_InvalidateStringRep(objPtr);
@@ -2029,7 +2006,6 @@ SetIntOrWideFromAny(interp, objPtr)
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr; /* The object to convert. */
{
- Tcl_ObjType *oldTypePtr = objPtr->typePtr;
char *string, *end;
int length;
register char *p;
@@ -2118,10 +2094,7 @@ SetIntOrWideFromAny(interp, objPtr)
* internalRep.
*/
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
-
+ TclFreeIntRep(objPtr);
if (isWide) {
objPtr->internalRep.wideValue =
(isNegative ? -(Tcl_WideInt)newLong : (Tcl_WideInt)newLong);
@@ -2319,16 +2292,11 @@ Tcl_SetLongObj(objPtr, longValue)
register long longValue; /* Long integer used to initialize the
* object's value. */
{
- register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("Tcl_SetLongObj called with shared object");
}
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
-
+ TclFreeIntRep(objPtr);
objPtr->internalRep.longValue = longValue;
objPtr->typePtr = &tclIntType;
Tcl_InvalidateStringRep(objPtr);
@@ -2427,7 +2395,6 @@ SetWideIntFromAny(interp, objPtr)
register Tcl_Obj *objPtr; /* The object to convert. */
{
#ifndef TCL_WIDE_INT_IS_LONG
- Tcl_ObjType *oldTypePtr = objPtr->typePtr;
char *string, *end;
int length;
register char *p;
@@ -2503,10 +2470,7 @@ SetWideIntFromAny(interp, objPtr)
* internalRep.
*/
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
-
+ TclFreeIntRep(objPtr);
objPtr->internalRep.wideValue = newWide;
#else
if (TCL_ERROR == SetIntFromAny(interp, objPtr)) {
@@ -2709,16 +2673,11 @@ Tcl_SetWideIntObj(objPtr, wideValue)
register Tcl_WideInt wideValue; /* Wide integer used to initialize
* the object's value. */
{
- register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("Tcl_SetWideIntObj called with shared object");
}
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
-
+ TclFreeIntRep(objPtr);
objPtr->internalRep.wideValue = wideValue;
objPtr->typePtr = &tclWideIntType;
Tcl_InvalidateStringRep(objPtr);
@@ -3308,10 +3267,9 @@ TclSetCmdNameObj(interp, objPtr, cmdPtr)
{
Interp *iPtr = (Interp *) interp;
register ResolvedCmdName *resPtr;
- Tcl_ObjType *oldTypePtr = objPtr->typePtr;
register Namespace *currNsPtr;
- if (oldTypePtr == &tclCmdNameType) {
+ if (objPtr->typePtr == &tclCmdNameType) {
return;
}
@@ -3334,9 +3292,7 @@ TclSetCmdNameObj(interp, objPtr, cmdPtr)
resPtr->cmdEpoch = cmdPtr->cmdEpoch;
resPtr->refCount = 1;
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
+ TclFreeIntRep(objPtr);
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclCmdNameType;
@@ -3511,11 +3467,7 @@ SetCmdNameFromAny(interp, objPtr)
* structure was found, leave NULL as the cached value.
*/
- if ((objPtr->typePtr != NULL)
- && (objPtr->typePtr->freeIntRepProc != NULL)) {
- objPtr->typePtr->freeIntRepProc(objPtr);
- }
-
+ TclFreeIntRep)(objPtr);
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclCmdNameType;
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 9ce22e5..b210a50 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclPathObj.c,v 1.34 2004/09/27 15:00:40 vincentdarley Exp $
+ * RCS: @(#) $Id: tclPathObj.c,v 1.35 2004/09/29 22:17:30 dkf Exp $
*/
#include "tclInt.h"
@@ -1204,9 +1204,7 @@ TclFSMakePathRelative(interp, pathPtr, cwdPtr)
}
pathPtr->typePtr->updateStringProc(pathPtr);
}
- if ((pathPtr->typePtr->freeIntRepProc) != NULL) {
- (*pathPtr->typePtr->freeIntRepProc)(pathPtr);
- }
+ TclFreeIntRep(pathPtr);
}
fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
@@ -1308,9 +1306,7 @@ TclFSMakePathFromNormalized(interp, pathPtr, nativeRep)
}
pathPtr->typePtr->updateStringProc(pathPtr);
}
- if ((pathPtr->typePtr->freeIntRepProc) != NULL) {
- (*pathPtr->typePtr->freeIntRepProc)(pathPtr);
- }
+ TclFreeIntRep(pathPtr);
}
fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
@@ -1384,9 +1380,7 @@ Tcl_FSNewNativePath(fromFilesystem, clientData)
}
pathPtr->typePtr->updateStringProc(pathPtr);
}
- if ((pathPtr->typePtr->freeIntRepProc) != NULL) {
- (*pathPtr->typePtr->freeIntRepProc)(pathPtr);
- }
+ TclFreeIntRep(pathPtr);
}
fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
@@ -2252,9 +2246,7 @@ SetFsPathFromAny(interp, pathPtr)
/*
* Free old representation before installing our new one.
*/
- if (pathPtr->typePtr != NULL && pathPtr->typePtr->freeIntRepProc != NULL) {
- (pathPtr->typePtr->freeIntRepProc)(pathPtr);
- }
+ TclFreeIntRep(pathPtr);
PATHOBJ(pathPtr) = (VOID *) fsPathPtr;
PATHFLAGS(pathPtr) = 0;
pathPtr->typePtr = &tclFsPathType;
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index 3d67fcb..f764bec 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclRegexp.c,v 1.15 2004/04/06 22:25:54 dgp Exp $
+ * RCS: @(#) $Id: tclRegexp.c,v 1.16 2004/09/29 22:17:30 dkf Exp $
*/
#include "tclInt.h"
@@ -565,10 +565,13 @@ Tcl_GetRegExpFromObj(interp, objPtr, flags)
TclRegexp *regexpPtr;
char *pattern;
- typePtr = objPtr->typePtr;
+ /*
+ * This is OK because we only actually interpret this value
+ * properly as a TclRegexp* when the type is tclRegexpType.
+ */
regexpPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;
- if ((typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
+ if ((objPtr->typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
pattern = Tcl_GetStringFromObj(objPtr, &length);
regexpPtr = CompileRegexp(interp, pattern, length, flags);
@@ -588,9 +591,7 @@ Tcl_GetRegExpFromObj(interp, objPtr, flags)
* Free the old representation and set our type.
*/
- if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
- (*typePtr->freeIntRepProc)(objPtr);
- }
+ TclFreeIntRep(objPtr);
objPtr->internalRep.otherValuePtr = (VOID *) regexpPtr;
objPtr->typePtr = &tclRegexpType;
}
diff --git a/generic/tclResult.c b/generic/tclResult.c
index c41b41b..7c15182 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.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: tclResult.c,v 1.9 2004/09/17 22:59:15 dgp Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.10 2004/09/29 22:17:30 dkf Exp $
*/
#include "tclInt.h"
@@ -841,10 +841,7 @@ ResetObjResult(iPtr)
}
objResultPtr->bytes = tclEmptyStringRep;
objResultPtr->length = 0;
- if ((objResultPtr->typePtr != NULL)
- && (objResultPtr->typePtr->freeIntRepProc != NULL)) {
- objResultPtr->typePtr->freeIntRepProc(objResultPtr);
- }
+ TclFreeIntRep(objResultPtr);
objResultPtr->typePtr = (Tcl_ObjType *) NULL;
}
}
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 106e3c4..6ed3570 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -33,7 +33,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStringObj.c,v 1.34 2003/12/24 04:18:20 davygrvy Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.35 2004/09/29 22:17:29 dkf Exp $ */
#include "tclInt.h"
@@ -699,8 +699,6 @@ Tcl_SetStringObj(objPtr, bytes, length)
* negative, use bytes up to the first
* NULL byte.*/
{
- register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-
/*
* Free any old string rep, then set the string rep to a copy of
* the length bytes starting at "bytes".
@@ -714,9 +712,7 @@ Tcl_SetStringObj(objPtr, bytes, length)
* Set the type to NULL and free any internal rep for the old type.
*/
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
+ TclFreeIntRep(objPtr);
objPtr->typePtr = NULL;
Tcl_InvalidateStringRep(objPtr);
@@ -950,7 +946,6 @@ Tcl_SetUnicodeObj(objPtr, unicode, numChars)
int numChars; /* Number of characters in the unicode
* string. */
{
- Tcl_ObjType *typePtr;
String *stringPtr;
size_t uallocated;
@@ -966,10 +961,7 @@ Tcl_SetUnicodeObj(objPtr, unicode, numChars)
* Free the internal rep if one exists, and invalidate the string rep.
*/
- typePtr = objPtr->typePtr;
- if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
- (*typePtr->freeIntRepProc)(objPtr);
- }
+ TclFreeIntRep(objPtr);
objPtr->typePtr = &tclStringType;
/*
@@ -1813,9 +1805,7 @@ SetStringFromAny(interp, objPtr)
if (objPtr->bytes == NULL) {
objPtr->typePtr->updateStringProc(objPtr);
}
- if ((objPtr->typePtr->freeIntRepProc) != NULL) {
- (*objPtr->typePtr->freeIntRepProc)(objPtr);
- }
+ TclFreeIntRep(objPtr);
}
objPtr->typePtr = &tclStringType;
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 41a4f0c..819f3b5 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUtil.c,v 1.45 2004/06/18 20:38:01 dgp Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.46 2004/09/29 22:17:29 dkf Exp $
*/
#include "tclInt.h"
@@ -2410,8 +2410,6 @@ SetEndOffsetFromAny(interp, objPtr)
Tcl_Obj* objPtr; /* Pointer to the object to parse */
{
int offset; /* Offset in the "end-offset" expression */
- Tcl_ObjType* oldTypePtr = objPtr->typePtr;
- /* Old internal rep type of the object */
register char* bytes; /* String rep of the object */
int length; /* Length of the object's string rep */
@@ -2468,10 +2466,7 @@ SetEndOffsetFromAny(interp, objPtr)
* the new one.
*/
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
-
+ TclFreeIntRep(objPtr);
objPtr->internalRep.longValue = offset;
objPtr->typePtr = &tclEndOffsetType;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index a0a6f42..ed6ec8d 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclVar.c,v 1.91 2004/08/31 16:25:50 dgp Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.92 2004/09/29 22:17:28 dkf Exp $
*/
#ifdef STDC_HEADERS
@@ -498,9 +498,7 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
*/
objPtr = part1Ptr;
- if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
- typePtr->freeIntRepProc(objPtr);
- }
+ TclFreeIntRep(objPtr);
objPtr->typePtr = &tclParsedVarNameType;
/*
@@ -529,10 +527,8 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
* it to one of the cached types if possible.
*/
- if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
- typePtr->freeIntRepProc(part1Ptr);
- part1Ptr->typePtr = NULL;
- }
+ TclFreeIntRep(part1Ptr);
+ part1Ptr->typePtr = NULL;
varPtr = TclLookupSimpleVar(interp, part1, flags,
createPart1, &errMsg, &index);
@@ -2299,7 +2295,7 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags)
*/
if (part1Ptr->typePtr == &tclNsVarNameType) {
- part1Ptr->typePtr->freeIntRepProc(part1Ptr);
+ TclFreeIntRep(part1Ptr);
part1Ptr->typePtr = NULL;
}
#endif
@@ -4019,9 +4015,7 @@ SetArraySearchObj(interp, objPtr)
end++;
offset = end - string;
- if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
- objPtr->typePtr->freeIntRepProc(objPtr);
- }
+ TclFreeIntRep(objPtr);
objPtr->typePtr = &tclArraySearchType;
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *)(((char *)NULL)+id);
objPtr->internalRep.twoPtrValue.ptr2 = (VOID *)(((char *)NULL)+offset);
generated by cgit v0.12 at 2024-11-05 08:48:18 (GMT)