Tcl Source Code

Check-in [821793c082]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Audit and correct Object reference counting issues.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | memleak
Files: files | file ages | folders
SHA3-256: 821793c0827a21695445fb43f007549ae3ae946fe0a6b5d7ca03f37328125dff
User & Date: pooryorick 2018-03-13 20:41:23.751
Context
2018-03-14
20:43
Further work to improve Object reference accounting in order to plug leaks. check-in: f8a55e34de user: pooryorick tags: memleak
04:26
Backout recent patch working on Object and Namespace refcounts. It creates new leaks and memory corr... check-in: 2fe4eced63 user: dgp tags: core-8-6-branch
2018-03-13
20:46
Audit and correct Object reference counting issues. check-in: ae1f9d5726 user: pooryorick tags: core-8-6-branch
20:41
Audit and correct Object reference counting issues. check-in: 821793c082 user: pooryorick tags: memleak
2018-03-11
21:14
Prevent leaks of the Object structs of oo::object and oo::class. check-in: 722088eb1f user: dgp tags: memleak
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/tclOO.c.
393
394
395
396
397
398
399
400
401
402
403
404
405
406



407
408
409
410
411
412
413
414
415




416




417


418

419
420
421


422
423
424
425
426
427
428
    /* Stand up a phony class for bootstrapping. */
    fPtr->objectCls = &fakeCls;
    /* referenced in AllocClass to increment the refCount. */
    fakeCls.thisPtr = &fakeObject;

    fPtr->objectCls = AllocClass(interp,
	    AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
    fPtr->classCls = AllocClass(interp,
	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));

    /* Rewire bootstrapped objects. */
    fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
    fPtr->classCls->thisPtr->selfCls = fPtr->classCls;




    AddRef(fPtr->objectCls->thisPtr);
    AddRef(fPtr->classCls->thisPtr);
    AddRef(fPtr->classCls->thisPtr->selfCls->thisPtr);
    AddRef(fPtr->objectCls->thisPtr->selfCls->thisPtr);

    /* special initialization for the primordial objects */
    fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
    fPtr->objectCls->flags |= ROOT_OBJECT;





    /* This is why it is unnecessary in this routine to make up for the




     * incremented reference count of fPtr->objectCls that was sallwed by


     * fakeObject. */

    fPtr->objectCls->superclasses.num = 0;
    ckfree(fPtr->objectCls->superclasses.list);
    fPtr->objectCls->superclasses.list = NULL;



    fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
    fPtr->classCls->flags |= ROOT_CLASS;

    /* Standard initialization for new Objects */
    TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
    TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);







<
<
|
<
|
<

>
>
>
|
|
<
|





>
>
>
>
|
>
>
>
>
|
>
>
|
>
|
|
|
>
>







393
394
395
396
397
398
399


400

401

402
403
404
405
406
407

408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
    /* Stand up a phony class for bootstrapping. */
    fPtr->objectCls = &fakeCls;
    /* referenced in AllocClass to increment the refCount. */
    fakeCls.thisPtr = &fakeObject;

    fPtr->objectCls = AllocClass(interp,
	    AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));


    /* Corresponding TclOODecrRefCount in KillFoudation */

    AddRef(fPtr->objectCls->thisPtr);


    /* This is why it is unnecessary in this routine to replace the
     * incremented reference count of fPtr->objectCls that was swallowed by
     * fakeObject. */
    fPtr->objectCls->superclasses.num = 0;
    ckfree(fPtr->objectCls->superclasses.list);

    fPtr->objectCls->superclasses.list = NULL;

    /* special initialization for the primordial objects */
    fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
    fPtr->objectCls->flags |= ROOT_OBJECT;

    fPtr->classCls = AllocClass(interp,
	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
    /* Corresponding TclOODecrRefCount in KillFoudation */
    AddRef(fPtr->classCls->thisPtr);

    /*
     * Increment reference counts for each reference because these
     * relationships can be dynamically changed.
     *
     * Corresponding TclOODecrRefCount for all incremented refcounts is in
     * KillFoundation.
     */

    /* Rewire bootstrapped objects. */
    fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
    AddRef(fPtr->objectCls->thisPtr->selfCls->thisPtr);

    fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
    AddRef(fPtr->classCls->thisPtr->selfCls->thisPtr);

    fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
    fPtr->classCls->flags |= ROOT_CLASS;

    /* Standard initialization for new Objects */
    TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
    TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568









569
570
571
572
573
574
575
    ClientData clientData,	/* Pointer to the OO system foundation
				 * structure. */
    Tcl_Interp *interp)		/* The interpreter containing the OO system
				 * foundation. */
{
    Foundation *fPtr = GetFoundation(interp);

    /*
     * Crude mechanism to avoid leaking the Object struct of the
     * foundation components oo::object and oo::class
     *
     * Should probably be replaced with something more elegantly designed.
     */
    while (TclOODecrRefCount(fPtr->objectCls->thisPtr) == 0) {};
    while (TclOODecrRefCount(fPtr->classCls->thisPtr) == 0) {};

    TclDecrRefCount(fPtr->unknownMethodNameObj);
    TclDecrRefCount(fPtr->constructorName);
    TclDecrRefCount(fPtr->destructorName);
    TclDecrRefCount(fPtr->clonedName);
    TclDecrRefCount(fPtr->defineName);









    ckfree(fPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * AllocObject --







<
<
<
<
<
<
<
<
<





>
>
>
>
>
>
>
>
>







559
560
561
562
563
564
565









566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
    ClientData clientData,	/* Pointer to the OO system foundation
				 * structure. */
    Tcl_Interp *interp)		/* The interpreter containing the OO system
				 * foundation. */
{
    Foundation *fPtr = GetFoundation(interp);










    TclDecrRefCount(fPtr->unknownMethodNameObj);
    TclDecrRefCount(fPtr->constructorName);
    TclDecrRefCount(fPtr->destructorName);
    TclDecrRefCount(fPtr->clonedName);
    TclDecrRefCount(fPtr->defineName);
    if (fPtr->objectCls->thisPtr->selfCls != NULL) {
	TclOODecrRefCount(fPtr->objectCls->thisPtr->selfCls->thisPtr);
    }
    if (fPtr->classCls->thisPtr->selfCls != NULL) {
	TclOODecrRefCount(fPtr->classCls->thisPtr->selfCls->thisPtr);
    }
    TclOODecrRefCount(fPtr->objectCls->thisPtr);
    TclOODecrRefCount(fPtr->classCls->thisPtr);

    ckfree(fPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * AllocObject --
644
645
646
647
648
649
650


651
652
653
654
655
656
657
	 * Could not make that namespace, so we make another. But first we
	 * have to get rid of the error message from Tcl_CreateNamespace,
	 * since that's something that should not be exposed to the user.
	 */

	Tcl_ResetResult(interp);
    }



    /*
     * Make the namespace know about the helper commands. This grants access
     * to the [self] and [next] commands.
     */

  configNamespace:







>
>







655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
	 * Could not make that namespace, so we make another. But first we
	 * have to get rid of the error message from Tcl_CreateNamespace,
	 * since that's something that should not be exposed to the user.
	 */

	Tcl_ResetResult(interp);
    }

    ((Namespace *)oPtr->namespacePtr)->refCount++;

    /*
     * Make the namespace know about the helper commands. This grants access
     * to the [self] and [next] commands.
     */

  configNamespace:
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844


845
846
847
848
849
850
851
852




853
854
855
856
857
858
859


860
861
862
863





864
865
866
867
868
869
870
871
872

873
874
875
876
877
878





879
880
881











882
883
884
885
886
887
888
    TclOODecrRefCount(oPtr);
    return;
}

/*
 * ----------------------------------------------------------------------
 *
 * ReleaseClassContents --
 *
 *	Tear down the special class data structure, including deleting all
 *	dependent classes and objects.
 *
 * ----------------------------------------------------------------------
 */

static void
DeleteDescendants(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    Class *clsPtr = oPtr->classPtr, *subclassPtr, *mixinSubclassPtr;
    Object *instancePtr;
    int i;

    /*
     * Squelch classes that this class has been mixed into.
     */

    FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {


	/* This condition also covers the case where mixinSubclassPtr ==
	 * clsPtr
	 */
	if (!Deleted(mixinSubclassPtr->thisPtr)) {
	    Tcl_DeleteCommandFromToken(interp,
		    mixinSubclassPtr->thisPtr->command);
	}
	i -= TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);




	TclOODecrRefCount(mixinSubclassPtr->thisPtr);
    }
    /*
     * Squelch subclasses of this class.
     */

    FOREACH(subclassPtr, clsPtr->subclasses) {


	if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) {
	    Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
	}
	i -= TclOORemoveFromSubclasses(subclassPtr, clsPtr);





	TclOODecrRefCount(subclassPtr->thisPtr);
    }

    /*
     * Squelch instances of this class (includes objects we're mixed into).
     */

    if (!IsRootClass(oPtr)) {
	FOREACH(instancePtr, clsPtr->instances) {

	    /* This condition also covers the case where instancePtr == oPtr */
	    if (!Deleted(instancePtr) && !IsRoot(instancePtr)) {
		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
	    }
	    i -= TclOORemoveFromInstances(instancePtr, clsPtr);
	}





    }
}
	












static void
ReleaseClassContents(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    FOREACH_HASH_DECLS;







|

|
<











<





|
>
>
|
|
|
|
|
|
|
|
>
>
>
>
|





|
>
>
|
|
|
|
>
>
>
>
>
|






|
|
>




|

>
>
>
>
>



>
>
>
>
>
>
>
>
>
>
>







829
830
831
832
833
834
835
836
837
838

839
840
841
842
843
844
845
846
847
848
849

850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
    TclOODecrRefCount(oPtr);
    return;
}

/*
 * ----------------------------------------------------------------------
 *
 * DeleteDescendants --
 *
 *	Delete all descendants of a particular class.

 *
 * ----------------------------------------------------------------------
 */

static void
DeleteDescendants(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    Class *clsPtr = oPtr->classPtr, *subclassPtr, *mixinSubclassPtr;
    Object *instancePtr;


    /*
     * Squelch classes that this class has been mixed into.
     */

    if (clsPtr->mixinSubs.num > 0) {
	while (clsPtr->mixinSubs.num > 0) {
	    mixinSubclassPtr = clsPtr->mixinSubs.list[clsPtr->mixinSubs.num-1];
	    /* This condition also covers the case where mixinSubclassPtr ==
	     * clsPtr
	     */
	    if (!Deleted(mixinSubclassPtr->thisPtr)) {
		Tcl_DeleteCommandFromToken(interp,
			mixinSubclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);
	}
    }
    if (clsPtr->mixinSubs.size > 0) {
	ckfree(clsPtr->mixinSubs.list);
	clsPtr->mixinSubs.size = 0;
    }
    /*
     * Squelch subclasses of this class.
     */

    if (clsPtr->subclasses.num > 0) {
	while (clsPtr->subclasses.num > 0) {
	    subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num-1];
	    if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) {
		Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromSubclasses(subclassPtr, clsPtr);
	}
    }
    if (clsPtr->subclasses.size > 0) {
	ckfree(clsPtr->subclasses.list);
	clsPtr->subclasses.list = NULL;
	clsPtr->subclasses.size = 0;
    }

    /*
     * Squelch instances of this class (includes objects we're mixed into).
     */

    if (clsPtr->instances.num > 0) {
	while (clsPtr->instances.num > 0) {
	    instancePtr = clsPtr->instances.list[clsPtr->instances.num-1];
	    /* This condition also covers the case where instancePtr == oPtr */
	    if (!Deleted(instancePtr) && !IsRoot(instancePtr)) {
		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
	    }
	    TclOORemoveFromInstances(instancePtr, clsPtr);
	}
    }
    if (clsPtr->instances.size > 0) {
	ckfree(clsPtr->instances.list);
	clsPtr->instances.list = NULL;
	clsPtr->instances.size = 0;
    }
}
	

/*
 * ----------------------------------------------------------------------
 *
 * ReleaseClassContents --
 *
 *	Tear down the special class data structure, including deleting all
 *	dependent classes and objects.
 *
 * ----------------------------------------------------------------------
 */

static void
ReleaseClassContents(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    FOREACH_HASH_DECLS;
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980

981
982
983




984
985





986
987
988
989
990
991
992
	    TclDecrRefCount(filterObj);
	}
	ckfree(clsPtr->filters.list);
	clsPtr->filters.list = NULL;
	clsPtr->filters.num = 0;
    }

    /*
     * Squelch our instances.
     */

    if (clsPtr->instances.num) {
	Object *oPtr;

	FOREACH(oPtr, clsPtr->instances) {
	    TclOODecrRefCount(oPtr);
	}
	ckfree(clsPtr->instances.list);
	clsPtr->instances.list = NULL;
	clsPtr->instances.num = 0;
    }

    /*
     * Squelch our metadata.
     */

    if (clsPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(clsPtr->metadataPtr);
	ckfree(clsPtr->metadataPtr);
	clsPtr->metadataPtr = NULL;
    }


    FOREACH(tmpClsPtr, clsPtr->mixins) {
	TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr);
    }




    FOREACH(tmpClsPtr, clsPtr->superclasses) {
	TclOORemoveFromSubclasses(clsPtr, tmpClsPtr);





    }

    FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
	TclOODelMethodRef(mPtr);
    }
    Tcl_DeleteHashTable(&clsPtr->classMethods);
    TclOODelMethodRef(clsPtr->constructorPtr);







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
















>
|
|
|
>
>
>
>
|
|
>
>
>
>
>







984
985
986
987
988
989
990















991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
	    TclDecrRefCount(filterObj);
	}
	ckfree(clsPtr->filters.list);
	clsPtr->filters.list = NULL;
	clsPtr->filters.num = 0;
    }
















    /*
     * Squelch our metadata.
     */

    if (clsPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(clsPtr->metadataPtr);
	ckfree(clsPtr->metadataPtr);
	clsPtr->metadataPtr = NULL;
    }

    if (clsPtr->mixins.num) {
	FOREACH(tmpClsPtr, clsPtr->mixins) {
	    TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr);
	}
	ckfree(clsPtr->mixins.list);
    }

    if (clsPtr->superclasses.num > 0) {
	FOREACH(tmpClsPtr, clsPtr->superclasses) {
	    TclOORemoveFromSubclasses(clsPtr, tmpClsPtr);
	    TclOODecrRefCount(tmpClsPtr->thisPtr);
	}
	ckfree(clsPtr->superclasses.list);
	clsPtr->superclasses.num = 0;
	clsPtr->superclasses.list = NULL;
    }

    FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
	TclOODelMethodRef(mPtr);
    }
    Tcl_DeleteHashTable(&clsPtr->classMethods);
    TclOODelMethodRef(clsPtr->constructorPtr);
1106
1107
1108
1109
1110
1111
1112

1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
     * Splice the object out of its context. After this, we must *not* call
     * methods on the object.
     */

    /* To do: Should this be protected with a * !IsRoot() condition?  */ 
    TclOORemoveFromInstances(oPtr, oPtr->selfCls);


    FOREACH(mixinPtr, oPtr->mixins) {
	i -= TclOORemoveFromInstances(oPtr, mixinPtr);
    }
    if (i) {
	ckfree(oPtr->mixins.list);
    }

    FOREACH(filterObj, oPtr->filters) {
	TclDecrRefCount(filterObj);
    }
    if (i) {







>
|
|
|
<







1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152

1153
1154
1155
1156
1157
1158
1159
     * Splice the object out of its context. After this, we must *not* call
     * methods on the object.
     */

    /* To do: Should this be protected with a * !IsRoot() condition?  */ 
    TclOORemoveFromInstances(oPtr, oPtr->selfCls);

    if (oPtr->mixins.num > 0) {
	FOREACH(mixinPtr, oPtr->mixins) {
	    TclOORemoveFromInstances(oPtr, mixinPtr);
	}

	ckfree(oPtr->mixins.list);
    }

    FOREACH(filterObj, oPtr->filters) {
	TclDecrRefCount(filterObj);
    }
    if (i) {
1181
1182
1183
1184
1185
1186
1187

1188

1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
	ReleaseClassContents(interp, oPtr);
    }

    /*
     * Delete the object structure itself.
     */


    oPtr->namespacePtr = NULL;

    oPtr->selfCls = NULL;
    TclOODecrRefCount(oPtr);
    return;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODecrRef --
 *
 *	Decrement the refcount of an object and deallocate storage then object
 *	is no longer referenced.  Returns 1 if storage was deallocated, and 0
 *	otherwise.
 *
 * ----------------------------------------------------------------------
 */
int TclOODecrRefCount(Object *oPtr) {
    if (oPtr->refCount-- <= 1) {
	Class *clsPtr = oPtr->classPtr;
	if (oPtr->classPtr != NULL) {
	    ckfree(clsPtr->superclasses.list);
	    ckfree(clsPtr->subclasses.list);
	    ckfree(clsPtr->instances.list);
	    ckfree(clsPtr->mixinSubs.list);
	    ckfree(clsPtr->mixins.list);
	    ckfree(oPtr->classPtr);
	}
	ckfree(oPtr);
	return 1;
    }
    return 0;
}







>

>


















<

<
<
<
<
<







1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244

1245





1246
1247
1248
1249
1250
1251
1252
	ReleaseClassContents(interp, oPtr);
    }

    /*
     * Delete the object structure itself.
     */

    TclNsDecrRefCount((Namespace *)oPtr->namespacePtr);
    oPtr->namespacePtr = NULL;
    TclOODecrRefCount(oPtr->selfCls->thisPtr);
    oPtr->selfCls = NULL;
    TclOODecrRefCount(oPtr);
    return;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODecrRef --
 *
 *	Decrement the refcount of an object and deallocate storage then object
 *	is no longer referenced.  Returns 1 if storage was deallocated, and 0
 *	otherwise.
 *
 * ----------------------------------------------------------------------
 */
int TclOODecrRefCount(Object *oPtr) {
    if (oPtr->refCount-- <= 1) {

	if (oPtr->classPtr != NULL) {





	    ckfree(oPtr->classPtr);
	}
	ckfree(oPtr);
	return 1;
    }
    return 0;
}
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
TclOORemoveFromInstances(
    Object *oPtr,		/* The instance to remove. */
    Class *clsPtr)		/* The class (possibly) containing the
				 * reference to the instance. */
{
    int i, res = 0;
    Object *instPtr;
    if (Deleted(clsPtr->thisPtr)) {
	return res;
    }

    FOREACH(instPtr, clsPtr->instances) {
	if (oPtr == instPtr) {
	    RemoveItem(Object, clsPtr->instances, i);
	    TclOODecrRefCount(oPtr);
	    res++;
	    break;







<
<
<







1278
1279
1280
1281
1282
1283
1284



1285
1286
1287
1288
1289
1290
1291
TclOORemoveFromInstances(
    Object *oPtr,		/* The instance to remove. */
    Class *clsPtr)		/* The class (possibly) containing the
				 * reference to the instance. */
{
    int i, res = 0;
    Object *instPtr;




    FOREACH(instPtr, clsPtr->instances) {
	if (oPtr == instPtr) {
	    RemoveItem(Object, clsPtr->instances, i);
	    TclOODecrRefCount(oPtr);
	    res++;
	    break;
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
TclOORemoveFromSubclasses(
    Class *subPtr,		/* The subclass to remove. */
    Class *superPtr)		/* The superclass to possibly remove the
				 * subclass reference from. */
{
    int i, res = 0;
    Class *subclsPtr;
    if (Deleted(superPtr->thisPtr)) {
	return res;
    }

    FOREACH(subclsPtr, superPtr->subclasses) {
	if (subPtr == subclsPtr) {
	    RemoveItem(Class, superPtr->subclasses, i);
	    TclOODecrRefCount(subPtr->thisPtr);
	    res++;
	}







<
<
<







1340
1341
1342
1343
1344
1345
1346



1347
1348
1349
1350
1351
1352
1353
TclOORemoveFromSubclasses(
    Class *subPtr,		/* The subclass to remove. */
    Class *superPtr)		/* The superclass to possibly remove the
				 * subclass reference from. */
{
    int i, res = 0;
    Class *subclsPtr;




    FOREACH(subclsPtr, superPtr->subclasses) {
	if (subPtr == subclsPtr) {
	    RemoveItem(Class, superPtr->subclasses, i);
	    TclOODecrRefCount(subPtr->thisPtr);
	    res++;
	}
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
    Class *subPtr,		/* The subclass to remove. */
    Class *superPtr)		/* The superclass to possibly remove the
				 * subclass reference from. */
{
    int i, res = 0;
    Class *subclsPtr;

    if (Deleted(superPtr->thisPtr)) {
	return res;
    }

    FOREACH(subclsPtr, superPtr->mixinSubs) {
	if (subPtr == subclsPtr) {
	    RemoveItem(Class, superPtr->mixinSubs, i);
	    TclOODecrRefCount(subPtr->thisPtr);
	    res++;
	    break;
	}







<
<
<
<







1404
1405
1406
1407
1408
1409
1410




1411
1412
1413
1414
1415
1416
1417
    Class *subPtr,		/* The subclass to remove. */
    Class *superPtr)		/* The superclass to possibly remove the
				 * subclass reference from. */
{
    int i, res = 0;
    Class *subclsPtr;





    FOREACH(subclsPtr, superPtr->mixinSubs) {
	if (subPtr == subclsPtr) {
	    RemoveItem(Class, superPtr->mixinSubs, i);
	    TclOODecrRefCount(subPtr->thisPtr);
	    res++;
	    break;
	}
1674
1675
1676
1677
1678
1679
1680

1681
1682
1683
1684
1685
1686
1687

    /*
     * Create the object.
     */

    oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr);
    oPtr->selfCls = classPtr;

    TclOOAddToInstances(oPtr, classPtr);
    /*
     * Check to see if we're really creating a class. If so, allocate the
     * class structure as well.
     */

    if (TclOOIsReachable(fPtr->classCls, classPtr)) {







>







1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710

    /*
     * Create the object.
     */

    oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr);
    oPtr->selfCls = classPtr;
    AddRef(classPtr->thisPtr);
    TclOOAddToInstances(oPtr, classPtr);
    /*
     * Check to see if we're really creating a class. If so, allocate the
     * class structure as well.
     */

    if (TclOOIsReachable(fPtr->classCls, classPtr)) {
1910
1911
1912
1913
1914
1915
1916





1917
1918
1919
1920
1921
1922
1923
		    ckalloc(sizeof(Class *) * clsPtr->superclasses.num);
	}
	memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
		sizeof(Class *) * clsPtr->superclasses.num);
	cls2Ptr->superclasses.num = clsPtr->superclasses.num;
	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOOAddToSubclasses(cls2Ptr, superPtr);





	}

	/*
	 * Duplicate the source class's filters.
	 */

	DUPLICATE(cls2Ptr->filters, clsPtr->filters, Tcl_Obj *);







>
>
>
>
>







1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
		    ckalloc(sizeof(Class *) * clsPtr->superclasses.num);
	}
	memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
		sizeof(Class *) * clsPtr->superclasses.num);
	cls2Ptr->superclasses.num = clsPtr->superclasses.num;
	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOOAddToSubclasses(cls2Ptr, superPtr);

	    /* For the new item in cls2Ptr->superclasses that memcpy just
	     * created
	     */
	    AddRef(superPtr->thisPtr);
	}

	/*
	 * Duplicate the source class's filters.
	 */

	DUPLICATE(cls2Ptr->filters, clsPtr->filters, Tcl_Obj *);
Changes to generic/tclOODefineCmds.c.
1121
1122
1123
1124
1125
1126
1127

1128
1129
1130
1131
1132
1133

1134
1135
1136
1137
1138
1139
1140


    /*
     * Set the object's class.
     */

    if (oPtr->selfCls != clsPtr) {

	TclOORemoveFromInstances(oPtr, oPtr->selfCls);

	/* Reference count already incremented 3 lines up. */
	oPtr->selfCls = clsPtr;

	TclOOAddToInstances(oPtr, oPtr->selfCls);

	if (oPtr->classPtr != NULL) {
	    BumpGlobalEpoch(interp, oPtr->classPtr);
	} else {
	    oPtr->epoch++;
	}
    }
    return TCL_OK;







>

|
<

|

>







1121
1122
1123
1124
1125
1126
1127
1128
1129
1130

1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141


    /*
     * Set the object's class.
     */

    if (oPtr->selfCls != clsPtr) {

	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
	TclOODecrRefCount(oPtr->selfCls->thisPtr);

	oPtr->selfCls = clsPtr;
	AddRef(oPtr->selfCls->thisPtr);
	TclOOAddToInstances(oPtr, oPtr->selfCls);

	if (oPtr->classPtr != NULL) {
	    BumpGlobalEpoch(interp, oPtr->classPtr);
	} else {
	    oPtr->epoch++;
	}
    }
    return TCL_OK;
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
	superclasses = ckrealloc(superclasses, sizeof(Class *));
	if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
	    superclasses[0] = oPtr->fPtr->classCls;
	} else {
	    superclasses[0] = oPtr->fPtr->objectCls;
	}
	superc = 1;
	/* Corresponding TclOODecrRefCount is near the end of this function */
	AddRef(superclasses[0]->thisPtr);
    } else {
	for (i=0 ; i<superc ; i++) {
	    superclasses[i] = GetClassInOuterContext(interp, superv[i],
		    "only a class can be a superclass");
	    if (superclasses[i] == NULL) {
		i--;







<







2148
2149
2150
2151
2152
2153
2154

2155
2156
2157
2158
2159
2160
2161
	superclasses = ckrealloc(superclasses, sizeof(Class *));
	if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
	    superclasses[0] = oPtr->fPtr->classCls;
	} else {
	    superclasses[0] = oPtr->fPtr->objectCls;
	}
	superc = 1;

	AddRef(superclasses[0]->thisPtr);
    } else {
	for (i=0 ; i<superc ; i++) {
	    superclasses[i] = GetClassInOuterContext(interp, superv[i],
		    "only a class can be a superclass");
	    if (superclasses[i] == NULL) {
		i--;
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
	}
	ckfree((char *) oPtr->classPtr->superclasses.list);
    }
    oPtr->classPtr->superclasses.list = superclasses;
    oPtr->classPtr->superclasses.num = superc;
    FOREACH(superPtr, oPtr->classPtr->superclasses) {
	TclOOAddToSubclasses(oPtr->classPtr, superPtr);
	/* To account for the AddRef() earlier in this function */ 
	TclOODecrRefCount(superPtr->thisPtr);
    }
    BumpGlobalEpoch(interp, oPtr->classPtr);

    return TCL_OK;
}

/*







<
<







2200
2201
2202
2203
2204
2205
2206


2207
2208
2209
2210
2211
2212
2213
	}
	ckfree((char *) oPtr->classPtr->superclasses.list);
    }
    oPtr->classPtr->superclasses.list = superclasses;
    oPtr->classPtr->superclasses.num = superc;
    FOREACH(superPtr, oPtr->classPtr->superclasses) {
	TclOOAddToSubclasses(oPtr->classPtr, superPtr);


    }
    BumpGlobalEpoch(interp, oPtr->classPtr);

    return TCL_OK;
}

/*
Changes to tests/oo.test.
53
54
55
56
57
58
59






60
61
62
63
64
65
66
67
test oo-0.4 {basic test of OO's ability to clean up its initial state} -body {
    leaktest {
	oo::class create foo
	foo new
	foo destroy
    }
} -constraints memory -result 0






test oo-0.5 {testing literal leak on interp delete} memory {
    leaktest {
	interp create foo
	foo eval {oo::object new}
	interp delete foo
    }
} 0
test oo-0.6 {cleaning the core class pair; way #1} -setup {







>
>
>
>
>
>
|







53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
test oo-0.4 {basic test of OO's ability to clean up its initial state} -body {
    leaktest {
	oo::class create foo
	foo new
	foo destroy
    }
} -constraints memory -result 0
test oo-0.5.1 {testing object foundation cleanup} memory {
    leaktest {
	interp create foo
	interp delete foo
    }
} 0
test oo-0.5.2 {testing literal leak on interp delete} memory {
    leaktest {
	interp create foo
	foo eval {oo::object new}
	interp delete foo
    }
} 0
test oo-0.6 {cleaning the core class pair; way #1} -setup {