Implement TIP 445

1 files changed, 32 insertions, 28 deletions

diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index 813dbd3..71f6581 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -13,6 +13,7 @@
 
 #include "tclInt.h"
 #include "tclRegexp.h"
+#include <assert.h>
 
 /*
  *----------------------------------------------------------------------
@@ -107,6 +108,23 @@ const Tcl_ObjType tclRegexpType = {
     NULL,				/* updateStringProc */
     SetRegexpFromAny			/* setFromAnyProc */
 };
+
+#define RegexpSetIntRep(objPtr, rePtr)					\
+    do {								\
+	Tcl_ObjIntRep ir;						\
+	(rePtr)->refCount++;						\
+	ir.twoPtrValue.ptr1 = (rePtr);					\
+	ir.twoPtrValue.ptr2 = NULL;					\
+	Tcl_StoreIntRep((objPtr), &tclRegexpType, &ir);			\
+    } while (0)
+
+#define RegexpGetIntRep(objPtr, rePtr)					\
+    do {								\
+	const Tcl_ObjIntRep *irPtr;					\
+	irPtr = Tcl_FetchIntRep((objPtr), &tclRegexpType);		\
+	(rePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
+    } while (0)
+
 
 /*
  *----------------------------------------------------------------------
@@ -579,14 +597,9 @@ Tcl_GetRegExpFromObj(
     TclRegexp *regexpPtr;
     const char *pattern;
 
-    /*
-     * This is OK because we only actually interpret this value properly as a
-     * TclRegexp* when the type is tclRegexpType.
-     */
-
-    regexpPtr = objPtr->internalRep.twoPtrValue.ptr1;
+    RegexpGetIntRep(objPtr, regexpPtr);
 
-    if ((objPtr->typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
+    if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) {
 	pattern = TclGetStringFromObj(objPtr, &length);
 
 	regexpPtr = CompileRegexp(interp, pattern, length, flags);
@@ -594,21 +607,7 @@ Tcl_GetRegExpFromObj(
 	    return NULL;
 	}
 
-	/*
-	 * Add a reference to the regexp so it will persist even if it is
-	 * pushed out of the current thread's regexp cache. This reference
-	 * will be removed when the object's internal rep is freed.
-	 */
-
-	regexpPtr->refCount++;
-
-	/*
-	 * Free the old representation and set our type.
-	 */
-
-	TclFreeIntRep(objPtr);
-	objPtr->internalRep.twoPtrValue.ptr1 = regexpPtr;
-	objPtr->typePtr = &tclRegexpType;
+	RegexpSetIntRep(objPtr, regexpPtr);
     }
     return (Tcl_RegExp) regexpPtr;
 }
@@ -755,7 +754,11 @@ static void
 FreeRegexpInternalRep(
     Tcl_Obj *objPtr)		/* Regexp object with internal rep to free. */
 {
-    TclRegexp *regexpRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
+    TclRegexp *regexpRepPtr;
+
+    RegexpGetIntRep(objPtr, regexpRepPtr);
+
+    assert(regexpRepPtr != NULL);
 
     /*
      * If this is the last reference to the regexp, free it.
@@ -764,7 +767,6 @@ FreeRegexpInternalRep(
     if (regexpRepPtr->refCount-- <= 1) {
 	FreeRegexp(regexpRepPtr);
     }
-    objPtr->typePtr = NULL;
 }
 
 /*
@@ -789,11 +791,13 @@ DupRegexpInternalRep(
     Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
     Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
 {
-    TclRegexp *regexpPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+    TclRegexp *regexpPtr;
+
+    RegexpGetIntRep(srcPtr, regexpPtr);
+
+    assert(regexpPtr != NULL);
 
-    regexpPtr->refCount++;
-    copyPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1;
-    copyPtr->typePtr = &tclRegexpType;
+    RegexpSetIntRep(copyPtr, regexpPtr);
 }
 
 /*