Remnants from TIP 567's implementation. The feature was done ages ago.

1 files changed, 37 insertions, 5 deletions

diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 034c877..a88a27e 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -2455,9 +2455,13 @@ ClassMixinSet(
     Tcl_Obj *const *objv)
 {
     Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    int mixinc, i;
+    int mixinc, i, isNew;
     Tcl_Obj **mixinv;
-    Class **mixins;
+    Class **mixins;;		/* The references to the classes to actually
+				 * install. */
+    Tcl_HashTable uniqueCheck;	/* Note that this hash table is just used as a
+				 * set of class references; it has no payload
+				 * values and keys are always pointers. */
 
     if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
 	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
@@ -2479,6 +2483,7 @@ ClassMixinSet(
     }
 
     mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc);
+    Tcl_InitHashTable(&uniqueCheck, TCL_ONE_WORD_KEYS);
 
     for (i = 0; i < mixinc; i++) {
 	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
@@ -2487,6 +2492,13 @@ ClassMixinSet(
 	    i--;
 	    goto freeAndError;
 	}
+	(void) Tcl_CreateHashEntry(&uniqueCheck, (void *) mixins[i], &isNew);
+	if (!isNew) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "class should only be a direct mixin once", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL);
+	    goto freeAndError;
+	}
 	if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "may not mix a class into itself", -1));
@@ -2496,10 +2508,12 @@ ClassMixinSet(
     }
 
     TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins);
+    Tcl_DeleteHashTable(&uniqueCheck);
     TclStackFree(interp, mixins);
     return TCL_OK;
 
   freeAndError:
+    Tcl_DeleteHashTable(&uniqueCheck);
     TclStackFree(interp, mixins);
     return TCL_ERROR;
 }
@@ -2906,10 +2920,15 @@ ObjMixinSet(
     Tcl_Obj *const *objv)
 {
     Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    int mixinc;
+    int mixinc, i, isNew;
     Tcl_Obj **mixinv;
     Class **mixins;
     int i;
+    Class **mixins;		/* The references to the classes to actually
+				 * install. */
+    Tcl_HashTable uniqueCheck;	/* Note that this hash table is just used as a
+				 * set of class references; it has no payload
+				 * values and keys are always pointers. */
 
     if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
 	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
@@ -2925,19 +2944,32 @@ ObjMixinSet(
     }
 
     mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc);
+    Tcl_InitHashTable(&uniqueCheck, TCL_ONE_WORD_KEYS);
 
     for (i = 0; i < mixinc; i++) {
 	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
 		"may only mix in classes");
 	if (mixins[i] == NULL) {
-	    TclStackFree(interp, mixins);
-	    return TCL_ERROR;
+	    goto freeAndError;
+	}
+	(void) Tcl_CreateHashEntry(&uniqueCheck, (void *) mixins[i], &isNew);
+	if (!isNew) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "class should only be a direct mixin once", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL);
+	    goto freeAndError;
 	}
     }
 
     TclOOObjectSetMixins(oPtr, mixinc, mixins);
     TclStackFree(interp, mixins);
+    Tcl_DeleteHashTable(&uniqueCheck);
     return TCL_OK;
+
+  freeAndError:
+    TclStackFree(interp, mixins);
+    Tcl_DeleteHashTable(&uniqueCheck);
+    return TCL_ERROR;
 }
 
 /*