Tcl Source Code

Check-in [29b72b7167]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Rebase the memleak work.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | memleak-87
Files: files | file ages | folders
SHA3-256: 29b72b7167fbca62a464fcf90980dc01308954b364cd1881533cb285d9a300af
User & Date: dgp 2018-03-14 22:39:38
Context
2018-03-14
23:43
Merge in 8.7 changes not already here. check-in: fccf41ff4a user: dgp tags: memleak-87
22:52
cherry pick over ranges of 8.7 only changes. check-in: 38ef030047 user: dgp tags: mistake
22:39
Rebase the memleak work. check-in: 29b72b7167 user: dgp tags: memleak-87
20:59
A few test hygiene fixes. check-in: 62043ae854 user: dgp tags: memleak
2018-03-11
12:22
merge 8.6 check-in: f27bd866ac user: dgp tags: core-8-branch
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to generic/tclOO.c.

   507    507   InitClassSystemRoots(
   508    508       Tcl_Interp *interp,
   509    509       Foundation *fPtr)
   510    510   {
   511    511       Class fakeCls;
   512    512       Object fakeObject;
   513    513   
   514         -    /*
   515         -     * Stand up a phony class for bootstrapping.
   516         -     */
   517         -
          514  +    /* Stand up a phony class for bootstrapping. */
   518    515       fPtr->objectCls = &fakeCls;
   519         -
   520         -    /*
   521         -     * Referenced in AllocClass to increment the refCount.
   522         -     */
   523         -
          516  +    /* referenced in AllocClass to increment the refCount. */
   524    517       fakeCls.thisPtr = &fakeObject;
   525    518   
   526    519       fPtr->objectCls = AllocClass(interp,
   527    520   	    AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
   528         -    fPtr->classCls = AllocClass(interp,
   529         -	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
   530         -
   531         -    /*
   532         -     * Rewire bootstrapped objects.
   533         -     */
   534         -
   535         -    fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
   536         -    fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
   537         -
          521  +    /* Corresponding TclOODecrRefCount in KillFoudation */
   538    522       AddRef(fPtr->objectCls->thisPtr);
   539         -    AddRef(fPtr->classCls->thisPtr);
   540         -    AddRef(fPtr->classCls->thisPtr->selfCls->thisPtr);
   541         -    AddRef(fPtr->objectCls->thisPtr->selfCls->thisPtr);
   542    523   
   543         -    /*
   544         -     * Special initialization for the primordial objects.
   545         -     */
          524  +    /* This is why it is unnecessary in this routine to replace the
          525  +     * incremented reference count of fPtr->objectCls that was swallowed by
          526  +     * fakeObject. */
          527  +    fPtr->objectCls->superclasses.num = 0;
          528  +    ckfree(fPtr->objectCls->superclasses.list);
          529  +    fPtr->objectCls->superclasses.list = NULL;
   546    530   
          531  +    /* special initialization for the primordial objects */
   547    532       fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
   548    533       fPtr->objectCls->flags |= ROOT_OBJECT;
   549    534   
          535  +    fPtr->classCls = AllocClass(interp,
          536  +	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
          537  +    /* Corresponding TclOODecrRefCount in KillFoudation */
          538  +    AddRef(fPtr->classCls->thisPtr);
          539  +
   550    540       /*
   551         -     * This is why it is unnecessary in this routine to make up for the
   552         -     * incremented reference count of fPtr->objectCls that was sallwed by
   553         -     * fakeObject.
          541  +     * Increment reference counts for each reference because these
          542  +     * relationships can be dynamically changed.
          543  +     *
          544  +     * Corresponding TclOODecrRefCount for all incremented refcounts is in
          545  +     * KillFoundation.
   554    546        */
   555    547   
   556         -    fPtr->objectCls->superclasses.num = 0;
   557         -    ckfree(fPtr->objectCls->superclasses.list);
   558         -    fPtr->objectCls->superclasses.list = NULL;
          548  +    /* Rewire bootstrapped objects. */
          549  +    fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
          550  +    AddRef(fPtr->classCls->thisPtr);
          551  +    TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
          552  +
          553  +    fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
          554  +    AddRef(fPtr->classCls->thisPtr);
          555  +    TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
   559    556   
   560    557       fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
   561    558       fPtr->classCls->flags |= ROOT_CLASS;
   562    559   
   563         -    /*
   564         -     * Standard initialization for new Objects.
   565         -     */
   566         -
   567         -    TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
   568         -    TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
          560  +    /* Standard initialization for new Objects */
   569    561       TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);
   570    562   
   571    563       /*
   572    564        * THIS IS THE ONLY FUNCTION THAT DOES NON-STANDARD CLASS SPLICING.
   573    565        * Everything else is careful to prohibit looping.
   574    566        */
   575    567   }
................................................................................
   633    625       Foundation *fPtr = GetFoundation(interp);
   634    626   
   635    627       TclDecrRefCount(fPtr->unknownMethodNameObj);
   636    628       TclDecrRefCount(fPtr->constructorName);
   637    629       TclDecrRefCount(fPtr->destructorName);
   638    630       TclDecrRefCount(fPtr->clonedName);
   639    631       TclDecrRefCount(fPtr->defineName);
          632  +    TclOODecrRefCount(fPtr->objectCls->thisPtr);
          633  +    TclOODecrRefCount(fPtr->classCls->thisPtr);
          634  +
   640    635       ckfree(fPtr);
   641    636   }
   642    637   
   643    638   /*
   644    639    * ----------------------------------------------------------------------
   645    640    *
   646    641    * AllocObject --
................................................................................
   716    711   	 * have to get rid of the error message from Tcl_CreateNamespace,
   717    712   	 * since that's something that should not be exposed to the user.
   718    713   	 */
   719    714   
   720    715   	Tcl_ResetResult(interp);
   721    716       }
   722    717   
          718  +
          719  +  configNamespace:
          720  +
          721  +    ((Namespace *)oPtr->namespacePtr)->refCount++;
          722  +
   723    723       /*
   724    724        * Make the namespace know about the helper commands. This grants access
   725    725        * to the [self] and [next] commands.
   726    726        */
   727    727   
   728         -  configNamespace:
   729    728       if (fPtr->helpersNs != NULL) {
   730    729   	TclSetNsPath((Namespace *) oPtr->namespacePtr, 1, &fPtr->helpersNs);
   731    730       }
   732    731       TclOOSetupVariableResolver(oPtr->namespacePtr);
   733    732   
   734    733       /*
   735    734        * Suppress use of compiled versions of the commands in this object's
................................................................................
   888    887       TclOODecrRefCount(oPtr);
   889    888       return;
   890    889   }
   891    890   
   892    891   /*
   893    892    * ----------------------------------------------------------------------
   894    893    *
   895         - * DeleteDescendants, ReleaseClassContents --
          894  + * DeleteDescendants --
   896    895    *
   897         - *	Tear down the special class data structure, including deleting all
   898         - *	dependent classes and objects.
          896  + *	Delete all descendants of a particular class.
   899    897    *
   900    898    * ----------------------------------------------------------------------
   901    899    */
   902    900   
   903    901   static void
   904    902   DeleteDescendants(
   905    903       Tcl_Interp *interp,		/* The interpreter containing the class. */
   906    904       Object *oPtr)		/* The object representing the class. */
   907    905   {
   908    906       Class *clsPtr = oPtr->classPtr, *subclassPtr, *mixinSubclassPtr;
   909    907       Object *instancePtr;
   910         -    int i;
   911    908   
   912    909       /*
   913    910        * Squelch classes that this class has been mixed into.
   914    911        */
   915    912   
   916         -    FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
   917         -	/*
   918         -	 * This condition also covers the case where mixinSubclassPtr ==
   919         -	 * clsPtr
   920         -	 */
   921         -
   922         -	if (!Deleted(mixinSubclassPtr->thisPtr)) {
   923         -	    Tcl_DeleteCommandFromToken(interp,
   924         -		    mixinSubclassPtr->thisPtr->command);
          913  +    if (clsPtr->mixinSubs.num > 0) {
          914  +	while (clsPtr->mixinSubs.num > 0) {
          915  +	    mixinSubclassPtr = clsPtr->mixinSubs.list[clsPtr->mixinSubs.num-1];
          916  +	    /* This condition also covers the case where mixinSubclassPtr ==
          917  +	     * clsPtr
          918  +	     */
          919  +	    if (!Deleted(mixinSubclassPtr->thisPtr)) {
          920  +		Tcl_DeleteCommandFromToken(interp,
          921  +			mixinSubclassPtr->thisPtr->command);
          922  +	    }
          923  +	    TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);
   925    924   	}
   926         -	i -= TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);
   927         -	TclOODecrRefCount(mixinSubclassPtr->thisPtr);
          925  +    }
          926  +    if (clsPtr->mixinSubs.size > 0) {
          927  +	ckfree(clsPtr->mixinSubs.list);
          928  +	clsPtr->mixinSubs.size = 0;
   928    929       }
   929    930   
   930    931       /*
   931    932        * Squelch subclasses of this class.
   932    933        */
   933    934   
   934         -    FOREACH(subclassPtr, clsPtr->subclasses) {
   935         -	if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) {
   936         -	    Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
          935  +    if (clsPtr->subclasses.num > 0) {
          936  +	while (clsPtr->subclasses.num > 0) {
          937  +	    subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num-1];
          938  +	    if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) {
          939  +		Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
          940  +	    }
          941  +	    TclOORemoveFromSubclasses(subclassPtr, clsPtr);
   937    942   	}
   938         -	i -= TclOORemoveFromSubclasses(subclassPtr, clsPtr);
   939         -	TclOODecrRefCount(subclassPtr->thisPtr);
          943  +    }
          944  +    if (clsPtr->subclasses.size > 0) {
          945  +	ckfree(clsPtr->subclasses.list);
          946  +	clsPtr->subclasses.list = NULL;
          947  +	clsPtr->subclasses.size = 0;
   940    948       }
   941    949   
   942    950       /*
   943    951        * Squelch instances of this class (includes objects we're mixed into).
   944    952        */
   945    953   
   946         -    if (!IsRootClass(oPtr)) {
   947         -	FOREACH(instancePtr, clsPtr->instances) {
          954  +    if (clsPtr->instances.num > 0) {
          955  +	while (clsPtr->instances.num > 0) {
          956  +	    instancePtr = clsPtr->instances.list[clsPtr->instances.num-1];
   948    957   	    /*
   949    958   	     * This condition also covers the case where instancePtr == oPtr
   950    959   	     */
   951    960   
   952    961   	    if (!Deleted(instancePtr) && !IsRoot(instancePtr)) {
   953    962   		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
   954    963   	    }
   955         -	    i -= TclOORemoveFromInstances(instancePtr, clsPtr);
          964  +	    TclOORemoveFromInstances(instancePtr, clsPtr);
   956    965   	}
   957    966       }
          967  +    if (clsPtr->instances.size > 0) {
          968  +	ckfree(clsPtr->instances.list);
          969  +	clsPtr->instances.list = NULL;
          970  +	clsPtr->instances.size = 0;
          971  +    }
   958    972   }
          973  +
          974  +/*
          975  + * ----------------------------------------------------------------------
          976  + *
          977  + * ReleaseClassContents --
          978  + *
          979  + *	Tear down the special class data structure, including deleting all
          980  + *	dependent classes and objects.
          981  + *
          982  + * ----------------------------------------------------------------------
          983  + */
   959    984   
   960    985   static void
   961    986   ReleaseClassContents(
   962    987       Tcl_Interp *interp,		/* The interpreter containing the class. */
   963    988       Object *oPtr)		/* The object representing the class. */
   964    989   {
   965    990       FOREACH_HASH_DECLS;
................................................................................
  1016   1041       if (clsPtr->filters.num) {
  1017   1042   	Tcl_Obj *filterObj;
  1018   1043   
  1019   1044   	FOREACH(filterObj, clsPtr->filters) {
  1020   1045   	    TclDecrRefCount(filterObj);
  1021   1046   	}
  1022   1047   	ckfree(clsPtr->filters.list);
         1048  +	clsPtr->filters.list = NULL;
  1023   1049   	clsPtr->filters.num = 0;
  1024   1050       }
  1025   1051   
  1026   1052       /*
  1027   1053        * Squelch our metadata.
  1028   1054        */
  1029   1055   
................................................................................
  1035   1061   	    metadataTypePtr->deleteProc(value);
  1036   1062   	}
  1037   1063   	Tcl_DeleteHashTable(clsPtr->metadataPtr);
  1038   1064   	ckfree(clsPtr->metadataPtr);
  1039   1065   	clsPtr->metadataPtr = NULL;
  1040   1066       }
  1041   1067   
  1042         -    FOREACH(tmpClsPtr, clsPtr->mixins) {
  1043         -	TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr);
         1068  +    if (clsPtr->mixins.num) {
         1069  +	FOREACH(tmpClsPtr, clsPtr->mixins) {
         1070  +	    TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr);
         1071  +	    TclOODecrRefCount(tmpClsPtr->thisPtr);
         1072  +	}
         1073  +	ckfree(clsPtr->mixins.list);
         1074  +	clsPtr->mixins.list = NULL;
         1075  +	clsPtr->mixins.num = 0;
  1044   1076       }
  1045         -    FOREACH(tmpClsPtr, clsPtr->superclasses) {
  1046         -	TclOORemoveFromSubclasses(clsPtr, tmpClsPtr);
         1077  +
         1078  +    if (clsPtr->superclasses.num > 0) {
         1079  +	FOREACH(tmpClsPtr, clsPtr->superclasses) {
         1080  +	    TclOORemoveFromSubclasses(clsPtr, tmpClsPtr);
         1081  +	    TclOODecrRefCount(tmpClsPtr->thisPtr);
         1082  +	}
         1083  +	ckfree(clsPtr->superclasses.list);
         1084  +	clsPtr->superclasses.num = 0;
         1085  +	clsPtr->superclasses.list = NULL;
  1047   1086       }
  1048   1087   
  1049   1088       FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
  1050   1089   	TclOODelMethodRef(mPtr);
  1051   1090       }
  1052   1091       Tcl_DeleteHashTable(&clsPtr->classMethods);
  1053   1092       TclOODelMethodRef(clsPtr->constructorPtr);
................................................................................
  1175   1214   
  1176   1215       /*
  1177   1216        * TODO: Should this be protected with a * !IsRoot() condition?
  1178   1217        */
  1179   1218   
  1180   1219       TclOORemoveFromInstances(oPtr, oPtr->selfCls);
  1181   1220   
  1182         -    FOREACH(mixinPtr, oPtr->mixins) {
  1183         -	i -= TclOORemoveFromInstances(oPtr, mixinPtr);
  1184         -    }
  1185         -    if (i) {
         1221  +    if (oPtr->mixins.num > 0) {
         1222  +	FOREACH(mixinPtr, oPtr->mixins) {
         1223  +	    TclOORemoveFromInstances(oPtr, mixinPtr);
         1224  +	    TclOODecrRefCount(mixinPtr->thisPtr);
         1225  +	}
  1186   1226   	ckfree(oPtr->mixins.list);
  1187   1227       }
  1188   1228   
  1189   1229       FOREACH(filterObj, oPtr->filters) {
  1190   1230   	TclDecrRefCount(filterObj);
  1191   1231       }
  1192   1232       if (i) {
................................................................................
  1247   1287   	ReleaseClassContents(interp, oPtr);
  1248   1288       }
  1249   1289   
  1250   1290       /*
  1251   1291        * Delete the object structure itself.
  1252   1292        */
  1253   1293   
         1294  +    TclNsDecrRefCount((Namespace *)oPtr->namespacePtr);
  1254   1295       oPtr->namespacePtr = NULL;
         1296  +    TclOODecrRefCount(oPtr->selfCls->thisPtr);
  1255   1297       oPtr->selfCls = NULL;
  1256   1298       TclOODecrRefCount(oPtr);
  1257   1299       return;
  1258   1300   }
  1259   1301   
  1260   1302   /*
  1261   1303    * ----------------------------------------------------------------------
................................................................................
  1270   1312    */
  1271   1313   
  1272   1314   int
  1273   1315   TclOODecrRefCount(
  1274   1316       Object *oPtr)
  1275   1317   {
  1276   1318       if (oPtr->refCount-- <= 1) {
  1277         -	Class *clsPtr = oPtr->classPtr;
  1278   1319   
  1279   1320   	if (oPtr->classPtr != NULL) {
  1280         -	    ckfree(clsPtr->superclasses.list);
  1281         -	    ckfree(clsPtr->subclasses.list);
  1282         -	    ckfree(clsPtr->instances.list);
  1283         -	    ckfree(clsPtr->mixinSubs.list);
  1284         -	    ckfree(clsPtr->mixins.list);
  1285   1321   	    ckfree(oPtr->classPtr);
  1286   1322   	}
  1287   1323   	ckfree(oPtr);
  1288   1324   	return 1;
  1289   1325       }
  1290   1326       return 0;
  1291   1327   }
................................................................................
  1306   1342       Object *oPtr,		/* The instance to remove. */
  1307   1343       Class *clsPtr)		/* The class (possibly) containing the
  1308   1344   				 * reference to the instance. */
  1309   1345   {
  1310   1346       int i, res = 0;
  1311   1347       Object *instPtr;
  1312   1348   
  1313         -    if (Deleted(clsPtr->thisPtr)) {
  1314         -	return res;
  1315         -    }
  1316         -
  1317   1349       FOREACH(instPtr, clsPtr->instances) {
  1318   1350   	if (oPtr == instPtr) {
  1319   1351   	    RemoveItem(Object, clsPtr->instances, i);
  1320   1352   	    TclOODecrRefCount(oPtr);
  1321   1353   	    res++;
  1322   1354   	    break;
  1323   1355   	}
................................................................................
  1372   1404       Class *subPtr,		/* The subclass to remove. */
  1373   1405       Class *superPtr)		/* The superclass to possibly remove the
  1374   1406   				 * subclass reference from. */
  1375   1407   {
  1376   1408       int i, res = 0;
  1377   1409       Class *subclsPtr;
  1378   1410   
  1379         -    if (Deleted(superPtr->thisPtr)) {
  1380         -	return res;
  1381         -    }
  1382         -
  1383   1411       FOREACH(subclsPtr, superPtr->subclasses) {
  1384   1412   	if (subPtr == subclsPtr) {
  1385   1413   	    RemoveItem(Class, superPtr->subclasses, i);
  1386   1414   	    TclOODecrRefCount(subPtr->thisPtr);
  1387   1415   	    res++;
  1388   1416   	}
  1389   1417       }
................................................................................
  1440   1468       Class *subPtr,		/* The subclass to remove. */
  1441   1469       Class *superPtr)		/* The superclass to possibly remove the
  1442   1470   				 * subclass reference from. */
  1443   1471   {
  1444   1472       int i, res = 0;
  1445   1473       Class *subclsPtr;
  1446   1474   
  1447         -    if (Deleted(superPtr->thisPtr)) {
  1448         -	return res;
  1449         -    }
  1450         -
  1451   1475       FOREACH(subclsPtr, superPtr->mixinSubs) {
  1452   1476   	if (subPtr == subclsPtr) {
  1453   1477   	    RemoveItem(Class, superPtr->mixinSubs, i);
  1454   1478   	    TclOODecrRefCount(subPtr->thisPtr);
  1455   1479   	    res++;
  1456   1480   	    break;
  1457   1481   	}
................................................................................
  1751   1775   
  1752   1776       /*
  1753   1777        * Create the object.
  1754   1778        */
  1755   1779   
  1756   1780       oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr);
  1757   1781       oPtr->selfCls = classPtr;
         1782  +    AddRef(classPtr->thisPtr);
  1758   1783       TclOOAddToInstances(oPtr, classPtr);
  1759   1784   
  1760   1785       /*
  1761   1786        * Check to see if we're really creating a class. If so, allocate the
  1762   1787        * class structure as well.
  1763   1788        */
  1764   1789   
................................................................................
  1896   1921   	}
  1897   1922       }
  1898   1923   
  1899   1924       /*
  1900   1925        * Copy the object's mixin references to the new object.
  1901   1926        */
  1902   1927   
  1903         -    FOREACH(mixinPtr, o2Ptr->mixins) {
  1904         -	if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
  1905         -	    TclOORemoveFromInstances(o2Ptr, mixinPtr);
         1928  +    if (o2Ptr->mixins.num != 0) {
         1929  +	FOREACH(mixinPtr, o2Ptr->mixins) {
         1930  +	    if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
         1931  +		TclOORemoveFromInstances(o2Ptr, mixinPtr);
         1932  +	    }
         1933  +	    TclOODecrRefCount(mixinPtr->thisPtr);
  1906   1934   	}
         1935  +	ckfree(o2Ptr->mixins.list);
  1907   1936       }
  1908   1937       DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
  1909   1938       FOREACH(mixinPtr, o2Ptr->mixins) {
  1910   1939   	if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
  1911   1940   	    TclOOAddToInstances(o2Ptr, mixinPtr);
  1912   1941   	}
         1942  +	/* For the reference just created in DUPLICATE */
         1943  +	AddRef(mixinPtr->thisPtr);
  1913   1944       }
  1914   1945   
  1915   1946       /*
  1916   1947        * Copy the object's filter list to the new object.
  1917   1948        */
  1918   1949   
  1919   1950       DUPLICATE(o2Ptr->filters, oPtr->filters, Tcl_Obj *);
................................................................................
  1983   2014   	/*
  1984   2015   	 * Ensure that the new class's superclass structure is the same as the
  1985   2016   	 * old class's.
  1986   2017   	 */
  1987   2018   
  1988   2019   	FOREACH(superPtr, cls2Ptr->superclasses) {
  1989   2020   	    TclOORemoveFromSubclasses(cls2Ptr, superPtr);
         2021  +	    TclOODecrRefCount(superPtr->thisPtr);
  1990   2022   	}
  1991   2023   	if (cls2Ptr->superclasses.num) {
  1992   2024   	    cls2Ptr->superclasses.list = ckrealloc(cls2Ptr->superclasses.list,
  1993   2025   		    sizeof(Class *) * clsPtr->superclasses.num);
  1994   2026   	} else {
  1995   2027   	    cls2Ptr->superclasses.list =
  1996   2028   		    ckalloc(sizeof(Class *) * clsPtr->superclasses.num);
  1997   2029   	}
  1998   2030   	memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
  1999   2031   		sizeof(Class *) * clsPtr->superclasses.num);
  2000   2032   	cls2Ptr->superclasses.num = clsPtr->superclasses.num;
  2001   2033   	FOREACH(superPtr, cls2Ptr->superclasses) {
  2002   2034   	    TclOOAddToSubclasses(cls2Ptr, superPtr);
         2035  +
         2036  +	    /* For the new item in cls2Ptr->superclasses that memcpy just
         2037  +	     * created
         2038  +	     */
         2039  +	    AddRef(superPtr->thisPtr);
  2003   2040   	}
  2004   2041   
  2005   2042   	/*
  2006   2043   	 * Duplicate the source class's filters.
  2007   2044   	 */
  2008   2045   
  2009   2046   	DUPLICATE(cls2Ptr->filters, clsPtr->filters, Tcl_Obj *);
................................................................................
  2021   2058   	}
  2022   2059   
  2023   2060   	/*
  2024   2061   	 * Duplicate the source class's mixins (which cannot be circular
  2025   2062   	 * references to the duplicate).
  2026   2063   	 */
  2027   2064   
  2028         -	FOREACH(mixinPtr, cls2Ptr->mixins) {
  2029         -	    TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr);
  2030         -	}
  2031   2065   	if (cls2Ptr->mixins.num != 0) {
         2066  +	    FOREACH(mixinPtr, cls2Ptr->mixins) {
         2067  +		TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr);
         2068  +		TclOODecrRefCount(mixinPtr->thisPtr);
         2069  +	    }
  2032   2070   	    ckfree(clsPtr->mixins.list);
  2033   2071   	}
  2034   2072   	DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *);
  2035   2073   	FOREACH(mixinPtr, cls2Ptr->mixins) {
  2036   2074   	    TclOOAddToMixinSubs(cls2Ptr, mixinPtr);
         2075  +	    /* For the copy just created in DUPLICATE */
         2076  +	    AddRef(mixinPtr->thisPtr);
  2037   2077   	}
  2038   2078   
  2039   2079   	/*
  2040   2080   	 * Duplicate the source class's methods, constructor and destructor.
  2041   2081   	 */
  2042   2082   
  2043   2083   	FOREACH_HASH(keyPtr, mPtr, &clsPtr->classMethods) {

Changes to generic/tclOODefineCmds.c.

   328    328       Class *mixinPtr;
   329    329       int i;
   330    330   
   331    331       if (numMixins == 0) {
   332    332   	if (oPtr->mixins.num != 0) {
   333    333   	    FOREACH(mixinPtr, oPtr->mixins) {
   334    334   		TclOORemoveFromInstances(oPtr, mixinPtr);
          335  +		TclOODecrRefCount(mixinPtr->thisPtr);
   335    336   	    }
   336    337   	    ckfree(oPtr->mixins.list);
   337    338   	    oPtr->mixins.num = 0;
   338    339   	}
   339    340   	RecomputeClassCacheFlag(oPtr);
   340    341       } else {
   341    342   	if (oPtr->mixins.num != 0) {
   342    343   	    FOREACH(mixinPtr, oPtr->mixins) {
   343    344   		if (mixinPtr && mixinPtr != oPtr->selfCls) {
   344    345   		    TclOORemoveFromInstances(oPtr, mixinPtr);
   345    346   		}
          347  +		TclOODecrRefCount(mixinPtr->thisPtr);
   346    348   	    }
   347    349   	    oPtr->mixins.list = ckrealloc(oPtr->mixins.list,
   348    350   		    sizeof(Class *) * numMixins);
   349    351   	} else {
   350    352   	    oPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
   351    353   	    oPtr->flags &= ~USE_CLASS_CACHE;
   352    354   	}
   353    355   	oPtr->mixins.num = numMixins;
   354    356   	memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
   355    357   	FOREACH(mixinPtr, oPtr->mixins) {
   356    358   	    if (mixinPtr != oPtr->selfCls) {
   357    359   		TclOOAddToInstances(oPtr, mixinPtr);
   358         -
   359         -		/*
   360         -		 * Corresponding TclOODecrRefCount() is in the caller of this
   361         -		 * function. 
   362         -		 */
   363         -
   364         -		TclOODecrRefCount(mixinPtr->thisPtr);
          360  +		/* For the new copy created by memcpy */
          361  +		AddRef(mixinPtr->thisPtr);
   365    362   	    }
   366    363   	}
   367    364       }
   368    365       oPtr->epoch++;
   369    366   }
   370    367   
   371    368   /*
................................................................................
   388    385       Class *mixinPtr;
   389    386       int i;
   390    387   
   391    388       if (numMixins == 0) {
   392    389   	if (classPtr->mixins.num != 0) {
   393    390   	    FOREACH(mixinPtr, classPtr->mixins) {
   394    391   		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
          392  +		TclOODecrRefCount(mixinPtr->thisPtr);
   395    393   	    }
   396    394   	    ckfree(classPtr->mixins.list);
   397    395   	    classPtr->mixins.num = 0;
   398    396   	}
   399    397       } else {
   400    398   	if (classPtr->mixins.num != 0) {
   401    399   	    FOREACH(mixinPtr, classPtr->mixins) {
   402    400   		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
          401  +		TclOODecrRefCount(mixinPtr->thisPtr);
   403    402   	    }
   404    403   	    classPtr->mixins.list = ckrealloc(classPtr->mixins.list,
   405    404   		    sizeof(Class *) * numMixins);
   406    405   	} else {
   407    406   	    classPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
   408    407   	}
   409    408   	classPtr->mixins.num = numMixins;
   410    409   	memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
   411    410   	FOREACH(mixinPtr, classPtr->mixins) {
   412    411   	    TclOOAddToMixinSubs(classPtr, mixinPtr);
   413         -
   414         -	    /*
   415         -	     * Corresponding TclOODecrRefCount() is in the caller of this
   416         -	     * function.
   417         -	     */
   418         -
   419         -	    TclOODecrRefCount(mixinPtr->thisPtr);
          412  +	    /* For the new copy created by memcpy */
          413  +	    AddRef(mixinPtr->thisPtr);
   420    414   	}
   421    415       }
   422    416       BumpGlobalEpoch(interp, classPtr);
   423    417   }
   424    418   
   425    419   /*
   426    420    * ----------------------------------------------------------------------
................................................................................
  1182   1176   
  1183   1177       /*
  1184   1178        * Set the object's class.
  1185   1179        */
  1186   1180   
  1187   1181       if (oPtr->selfCls != clsPtr) {
  1188   1182   	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
  1189         -
  1190         -	/*
  1191         -	 * Reference count already incremented a few lines up.
  1192         -	 */
  1193         -
         1183  +	TclOODecrRefCount(oPtr->selfCls->thisPtr);
  1194   1184   	oPtr->selfCls = clsPtr;
  1195         -
         1185  +	AddRef(oPtr->selfCls->thisPtr);
  1196   1186   	TclOOAddToInstances(oPtr, oPtr->selfCls);
         1187  +
  1197   1188   	if (oPtr->classPtr != NULL) {
  1198   1189   	    BumpGlobalEpoch(interp, oPtr->classPtr);
  1199   1190   	} else {
  1200   1191   	    oPtr->epoch++;
  1201   1192   	}
  1202   1193       }
  1203   1194       return TCL_OK;
................................................................................
  1652   1643   	if (!isInstanceMixin && TclOOIsReachable(oPtr->classPtr, clsPtr)) {
  1653   1644   	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
  1654   1645   		    "may not mix a class into itself", -1));
  1655   1646   	    Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
  1656   1647   	    goto freeAndError;
  1657   1648   	}
  1658   1649   	mixins[i-1] = clsPtr;
  1659         -
  1660         -	/*
  1661         -	 * Corresponding TclOODecrRefCount() is in TclOOObjectSetMixins,
  1662         -	 * TclOOClassSetMixinsk, or just below if this function fails.
  1663         -	 */
  1664         -
  1665         -	AddRef(mixins[i-1]->thisPtr);
  1666   1650       }
  1667   1651   
  1668   1652       if (isInstanceMixin) {
  1669   1653   	TclOOObjectSetMixins(oPtr, objc-1, mixins);
  1670   1654       } else {
  1671   1655   	TclOOClassSetMixins(interp, oPtr->classPtr, objc-1, mixins);
  1672   1656       }
  1673   1657   
  1674   1658       TclStackFree(interp, mixins);
  1675   1659       return TCL_OK;
  1676   1660   
  1677   1661     freeAndError:
  1678         -    while (--i > 0) {
  1679         -	TclOODecrRefCount(mixins[i]->thisPtr);
  1680         -    }
  1681   1662       TclStackFree(interp, mixins);
  1682   1663       return TCL_ERROR;
  1683   1664   }
  1684   1665   
  1685   1666   /*
  1686   1667    * ----------------------------------------------------------------------
  1687   1668    *
................................................................................
  2104   2085   	}
  2105   2086   	if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
  2106   2087   	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
  2107   2088   		    "may not mix a class into itself", -1));
  2108   2089   	    Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
  2109   2090   	    goto freeAndError;
  2110   2091   	}
  2111         -
  2112         -	/*
  2113         -	 * Corresponding TclOODecrRefCount() is in TclOOClassSetMixins, or
  2114         -	 * just below if this function fails.
  2115         -	 */
  2116         -
  2117         -	AddRef(mixins[i]->thisPtr);
  2118   2092       }
  2119   2093   
  2120   2094       TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins);
  2121   2095       TclStackFree(interp, mixins);
  2122   2096       return TCL_OK;
  2123   2097   
  2124   2098     freeAndError:
  2125         -    while (i-- > 0) {
  2126         -	TclOODecrRefCount(mixins[i]->thisPtr);
  2127         -    }
  2128   2099       TclStackFree(interp, mixins);
  2129   2100       return TCL_ERROR;
  2130   2101   }
  2131   2102   
  2132   2103   /*
  2133   2104    * ----------------------------------------------------------------------
  2134   2105    *
................................................................................
  2230   2201   	superclasses = ckrealloc(superclasses, sizeof(Class *));
  2231   2202   	if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
  2232   2203   	    superclasses[0] = oPtr->fPtr->classCls;
  2233   2204   	} else {
  2234   2205   	    superclasses[0] = oPtr->fPtr->objectCls;
  2235   2206   	}
  2236   2207   	superc = 1;
  2237         -
  2238         -	/*
  2239         -	 * Corresponding TclOODecrRefCount is near the end of this function.
  2240         -	 */
  2241         -
  2242   2208   	AddRef(superclasses[0]->thisPtr);
  2243   2209       } else {
  2244   2210   	for (i=0 ; i<superc ; i++) {
  2245   2211   	    superclasses[i] = GetClassInOuterContext(interp, superv[i],
  2246   2212   		    "only a class can be a superclass");
  2247   2213   	    if (superclasses[i] == NULL) {
  2248   2214   		i--;
................................................................................
  2284   2250        * it used to be a member of and splicing it into the new superclasses'
  2285   2251        * subclass list.
  2286   2252        */
  2287   2253   
  2288   2254       if (oPtr->classPtr->superclasses.num != 0) {
  2289   2255   	FOREACH(superPtr, oPtr->classPtr->superclasses) {
  2290   2256   	    TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
         2257  +	    TclOODecrRefCount(superPtr->thisPtr);
  2291   2258   	}
  2292   2259   	ckfree(oPtr->classPtr->superclasses.list);
  2293   2260       }
  2294   2261       oPtr->classPtr->superclasses.list = superclasses;
  2295   2262       oPtr->classPtr->superclasses.num = superc;
  2296   2263       FOREACH(superPtr, oPtr->classPtr->superclasses) {
  2297   2264   	TclOOAddToSubclasses(oPtr->classPtr, superPtr);
  2298         -
  2299         -	/*
  2300         -	 * To account for the AddRef() earlier in this function.
  2301         -	 */
  2302         -
  2303         -	TclOODecrRefCount(superPtr->thisPtr);
  2304   2265       }
  2305   2266       BumpGlobalEpoch(interp, oPtr->classPtr);
  2306   2267   
  2307   2268       return TCL_OK;
  2308   2269   }
  2309   2270   
  2310   2271   /*
................................................................................
  2590   2551   
  2591   2552       mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);
  2592   2553   
  2593   2554       for (i=0 ; i<mixinc ; i++) {
  2594   2555   	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
  2595   2556   		"may only mix in classes");
  2596   2557   	if (mixins[i] == NULL) {
  2597         -	    while (i-- > 0) {
  2598         -		TclOODecrRefCount(mixins[i]->thisPtr);
  2599         -	    }
  2600   2558   	    TclStackFree(interp, mixins);
  2601   2559   	    return TCL_ERROR;
  2602   2560   	}
  2603         -
  2604         -	/*
  2605         -	 * Corresponding TclOODecrRefCount() is in TclOOObjectSetMixins() or
  2606         -	 * just above if this function fails.
  2607         -	 */
  2608         -
  2609         -	AddRef(mixins[i]->thisPtr);
  2610   2561       }
  2611   2562   
  2612   2563       TclOOObjectSetMixins(oPtr, mixinc, mixins);
  2613   2564       TclStackFree(interp, mixins);
  2614   2565       return TCL_OK;
  2615   2566   }
  2616   2567   

Changes to tests/oo.test.

     8      8   # this file, and for a DISCLAIMER OF ALL WARRANTIES.
     9      9   
    10     10   package require TclOO 1.0.3
    11     11   package require tcltest 2
    12     12   if {"::tcltest" in [namespace children]} {
    13     13       namespace import -force ::tcltest::*
    14     14   }
           15  +
           16  +
           17  +# The foundational objects oo::object and oo::class are sensitive to reference
           18  +# counting errors and are deallocated only when an interp is deleted, so in
           19  +# this test suite, interp creation and interp deletion are often used in
           20  +# leaktests in order to leverage this sensitivity.
           21  +
    15     22   
    16     23   testConstraint memory [llength [info commands memory]]
    17     24   if {[testConstraint memory]} {
    18     25       proc getbytes {} {
    19     26   	set lines [split [memory info] \n]
    20     27   	return [lindex $lines 3 3]
    21     28       }
................................................................................
    53     60   test oo-0.4 {basic test of OO's ability to clean up its initial state} -body {
    54     61       leaktest {
    55     62   	oo::class create foo
    56     63   	foo new
    57     64   	foo destroy
    58     65       }
    59     66   } -constraints memory -result 0
    60         -test oo-0.5 {testing literal leak on interp delete} memory {
           67  +test oo-0.5.1 {testing object foundation cleanup} memory {
           68  +    leaktest {
           69  +	interp create foo
           70  +	interp delete foo
           71  +    }
           72  +} 0
           73  +test oo-0.5.2 {testing literal leak on interp delete} memory {
    61     74       leaktest {
    62     75   	interp create foo
    63     76   	foo eval {oo::object new}
    64     77   	interp delete foo
    65     78       }
    66     79   } 0
    67     80   test oo-0.6 {cleaning the core class pair; way #1} -setup {
................................................................................
   261    274   } -body {
   262    275       oo::define B constructor {} {A create test-oo-1.18}
   263    276       B create C
   264    277   } -cleanup {
   265    278       rename test-oo-1.18 {}
   266    279       A destroy
   267    280   } -result ::C
   268         -test oo-1.18.1 {Bug 75b8433707: memory leak in oo-1.18} -setup {
          281  +test oo-1.18.1 {no memory leak: superclass} -setup {
          282  +} -constraints memory -body {
          283  +
          284  +    leaktest {
          285  +	interp create t
          286  +	t eval {
          287  +	    oo::class create A {
          288  +		superclass oo::class
          289  +	    }
          290  +	}
          291  +	interp delete t
          292  +    }
          293  +} -cleanup {
          294  +} -result 0
          295  +test oo-1.18.2 {Bug 75b8433707: memory leak in oo-1.18} -setup {
   269    296       proc test-oo-1.18 {} return
   270    297   } -constraints memory -body {
   271    298       leaktest {
   272    299   	oo::class create A
   273    300   	oo::class create B {superclass A}
   274    301   	oo::define B constructor {} {A create test-oo-1.18}
   275    302   	B create C
   276    303   	A destroy
   277    304       }
   278    305   } -cleanup {
   279    306       rename test-oo-1.18 {}
   280    307   } -result 0
   281         -test oo-1.18.2 {Bug 21c144f0f5} -setup {
          308  +test oo-1.18.3 {Bug 21c144f0f5} -setup {
   282    309       interp create slave
   283    310   } -body {
   284    311       slave eval {
   285    312   	oo::define [oo::class create foo] superclass oo::class
   286    313   	oo::class destroy
   287    314       }
   288    315   } -cleanup {
................................................................................
  1498   1525       }}}
  1499   1526   
  1500   1527       rename obj1 {}
  1501   1528       # No segmentation fault
  1502   1529       return done
  1503   1530   } done
  1504   1531   
  1505         -test oo-11.6 {
         1532  +test oo-11.6.1 {
         1533  +    OO: cleanup of when an class is mixed into itself
         1534  +} -constraints memory -body {
         1535  +    leaktest {
         1536  +	interp create interp1
         1537  +	oo::class create obj1
         1538  +	::oo::define obj1 {self mixin [uplevel 1 {namespace which obj1}]}
         1539  +	rename obj1 {}
         1540  +	interp delete interp1
         1541  +    }
         1542  +} -result 0 -cleanup {
         1543  +}
         1544  +
         1545  +test oo-11.6.2 {
         1546  +    OO: cleanup ReleaseClassContents() where class is mixed into one of its
         1547  +    instances
         1548  +} -constraints memory -body {
         1549  +    leaktest {
         1550  +	interp create interp1
         1551  +	interp1 eval {
         1552  +	    oo::class create obj1
         1553  +	    ::oo::copy obj1 obj2
         1554  +	    rename obj2 {}
         1555  +	    rename obj1 {}
         1556  +	}
         1557  +	interp delete interp1
         1558  +    }
         1559  +} -result 0 -cleanup {
         1560  +}
         1561  +
         1562  +test oo-11.6.3 {
         1563  +    OO: cleanup ReleaseClassContents() where class is mixed into one of its
         1564  +    instances
         1565  +} -constraints memory -body {
         1566  +    leaktest {
         1567  +	interp create interp1
         1568  +	interp1 eval {
         1569  +	    oo::class create obj1
         1570  +	    ::oo::define obj1 {self mixin [uplevel 1 {namespace which obj1}]}
         1571  +
         1572  +	    ::oo::copy obj1 obj2
         1573  +	    rename obj2 {}
         1574  +	    rename obj1 {}
         1575  +	}
         1576  +	interp delete interp1
         1577  +    }
         1578  +} -result 0 -cleanup {
         1579  +}
         1580  +
         1581  +test oo-11.6.4 {
  1506   1582       OO: cleanup ReleaseClassContents() where class is mixed into one of its
  1507   1583       instances
  1508   1584   } -body {
  1509   1585       oo::class create obj1
  1510   1586       ::oo::define obj1 {self mixin [self]}
  1511   1587   
  1512   1588       ::oo::copy obj1 obj2
................................................................................
  2061   2137   } -body {
  2062   2138       namespace eval ::existing {}
  2063   2139       oo::copy Cls {} ::existing
  2064   2140   } -returnCodes error -cleanup {
  2065   2141       Super destroy
  2066   2142       catch {namespace delete ::existing}
  2067   2143   } -result {::existing refers to an existing namespace}
  2068         -test oo-15.13 {OO: object cloning with target NS} -setup {
         2144  +test oo-15.13.1 {
         2145  +    OO: object cloning with target NS
         2146  +    Valgrind will report a leak if the reference count of the namespace isn't
         2147  +    properly incremented.
         2148  +} -setup {
         2149  +    oo::class create Cls {}
         2150  +} -body {
         2151  +    oo::copy Cls Cls2 ::dupens
         2152  +    return done
         2153  +} -cleanup {
         2154  +    Cls destroy
         2155  +    Cls2 destroy
         2156  +} -result done 
         2157  +test oo-15.13.2 {OO: object cloning with target NS} -setup {
  2069   2158       oo::class create Super
  2070   2159       oo::class create Cls {superclass Super}
  2071   2160   } -body {
  2072   2161       list [namespace exist ::dupens] [oo::copy Cls Cls2 ::dupens] [namespace exist ::dupens]
  2073   2162   } -cleanup {
  2074   2163       Super destroy
  2075   2164   } -result {0 ::Cls2 1}
................................................................................
  3657   3746   	}
  3658   3747       }
  3659   3748       list [leaktest {[cls new] destroy}] [info class instances cls]
  3660   3749   } -cleanup {
  3661   3750       cls destroy
  3662   3751   } -result {0 {}}
  3663   3752   
  3664         -oo::class create SampleSlot {
  3665         -    superclass oo::Slot
  3666         -    constructor {} {
  3667         -	variable contents {a b c} ops {}
  3668         -    }
  3669         -    method contents {} {variable contents; return $contents}
  3670         -    method ops {} {variable ops; return $ops}
  3671         -    method Get {} {
  3672         -	variable contents
  3673         -	variable ops
  3674         -	lappend ops [info level] Get
  3675         -	return $contents
  3676         -    }
  3677         -    method Set {lst} {
  3678         -	variable contents $lst
  3679         -	variable ops
  3680         -	lappend ops [info level] Set $lst
  3681         -	return
  3682         -    }
         3753  +proc SampleSlotSetup script {
         3754  +    set script0 {
         3755  +	oo::class create SampleSlot {
         3756  +	    superclass oo::Slot
         3757  +	    constructor {} {
         3758  +		variable contents {a b c} ops {}
         3759  +	    }
         3760  +	    method contents {} {variable contents; return $contents}
         3761  +	    method ops {} {variable ops; return $ops}
         3762  +	    method Get {} {
         3763  +		variable contents
         3764  +		variable ops
         3765  +		lappend ops [info level] Get
         3766  +		return $contents
         3767  +	    }
         3768  +	    method Set {lst} {
         3769  +		variable contents $lst
         3770  +		variable ops
         3771  +		lappend ops [info level] Set $lst
         3772  +		return
         3773  +	    }
         3774  +	}
         3775  +    }
         3776  +    append script0 \n$script
         3777  +}
         3778  +
         3779  +proc SampleSlotCleanup script {
         3780  +    set script0 {
         3781  +	SampleSlot destroy
         3782  +    }
         3783  +    append script \n$script0
  3683   3784   }
  3684   3785   
  3685         -test oo-32.1 {TIP 380: slots - class test} -setup {
         3786  +test oo-32.1 {TIP 380: slots - class test} -setup [SampleSlotSetup {
  3686   3787       SampleSlot create sampleSlot
  3687         -} -body {
         3788  +}] -body {
  3688   3789       list [info level] [sampleSlot contents] [sampleSlot ops]
  3689         -} -cleanup {
         3790  +} -cleanup [SampleSlotCleanup {
  3690   3791       rename sampleSlot {}
  3691         -} -result {0 {a b c} {}}
  3692         -test oo-32.2 {TIP 380: slots - class test} -setup {
         3792  +}] -result {0 {a b c} {}}
         3793  +test oo-32.2 {TIP 380: slots - class test} -setup [SampleSlotSetup {
  3693   3794       SampleSlot create sampleSlot
  3694         -} -body {
         3795  +}] -body {
  3695   3796       list [info level] [sampleSlot -clear] \
  3696   3797   	[sampleSlot contents] [sampleSlot ops]
  3697         -} -cleanup {
         3798  +} -cleanup [SampleSlotCleanup {
  3698   3799       rename sampleSlot {}
  3699         -} -result {0 {} {} {1 Set {}}}
  3700         -test oo-32.3 {TIP 380: slots - class test} -setup {
         3800  +}] -result {0 {} {} {1 Set {}}}
         3801  +test oo-32.3 {TIP 380: slots - class test} -setup [SampleSlotSetup {
  3701   3802       SampleSlot create sampleSlot
  3702         -} -body {
         3803  +}] -body {
  3703   3804       list [info level] [sampleSlot -append g h i] \
  3704   3805   	[sampleSlot contents] [sampleSlot ops]
  3705         -} -cleanup {
         3806  +} -cleanup [SampleSlotCleanup {
  3706   3807       rename sampleSlot {}
  3707         -} -result {0 {} {a b c g h i} {1 Get 1 Set {a b c g h i}}}
  3708         -test oo-32.4 {TIP 380: slots - class test} -setup {
         3808  +}] -result {0 {} {a b c g h i} {1 Get 1 Set {a b c g h i}}}
         3809  +test oo-32.4 {TIP 380: slots - class test} -setup [SampleSlotSetup {
  3709   3810       SampleSlot create sampleSlot
  3710         -} -body {
         3811  +}] -body {
  3711   3812       list [info level] [sampleSlot -set d e f] \
  3712   3813   	[sampleSlot contents] [sampleSlot ops]
  3713         -} -cleanup {
         3814  +} -cleanup [SampleSlotCleanup {
  3714   3815       rename sampleSlot {}
  3715         -} -result {0 {} {d e f} {1 Set {d e f}}}
  3716         -test oo-32.5 {TIP 380: slots - class test} -setup {
         3816  +}] -result {0 {} {d e f} {1 Set {d e f}}}
         3817  +test oo-32.5 {TIP 380: slots - class test} -setup [SampleSlotSetup {
  3717   3818       SampleSlot create sampleSlot
  3718         -} -body {
         3819  +}] -body {
  3719   3820       list [info level] [sampleSlot -set d e f] [sampleSlot -append g h i] \
  3720   3821   	[sampleSlot contents] [sampleSlot ops]
  3721         -} -cleanup {
         3822  +} -cleanup [SampleSlotCleanup {
  3722   3823       rename sampleSlot {}
  3723         -} -result {0 {} {} {d e f g h i} {1 Set {d e f} 1 Get 1 Set {d e f g h i}}}
         3824  +}] -result {0 {} {} {d e f g h i} {1 Set {d e f} 1 Get 1 Set {d e f g h i}}}
  3724   3825   
  3725         -test oo-33.1 {TIP 380: slots - defaulting} -setup {
         3826  +test oo-33.1 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
  3726   3827       set s [SampleSlot new]
  3727         -} -body {
         3828  +}] -body {
  3728   3829       list [$s x y] [$s contents]
  3729         -} -cleanup {
         3830  +} -cleanup [SampleSlotCleanup {
  3730   3831       rename $s {}
  3731         -} -result {{} {a b c x y}}
  3732         -test oo-33.2 {TIP 380: slots - defaulting} -setup {
         3832  +}] -result {{} {a b c x y}}
         3833  +test oo-33.2 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
  3733   3834       set s [SampleSlot new]
  3734         -} -body {
         3835  +}] -body {
  3735   3836       list [$s destroy; $s unknown] [$s contents]
  3736         -} -cleanup {
         3837  +} -cleanup [SampleSlotCleanup {
  3737   3838       rename $s {}
  3738         -} -result {{} {a b c destroy unknown}}
  3739         -test oo-33.3 {TIP 380: slots - defaulting} -setup {
         3839  +}] -result {{} {a b c destroy unknown}}
         3840  +test oo-33.3 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
  3740   3841       set s [SampleSlot new]
  3741         -} -body {
         3842  +}] -body {
  3742   3843       oo::objdefine $s forward --default-operation  my -set
  3743   3844       list [$s destroy; $s unknown] [$s contents] [$s ops]
  3744         -} -cleanup {
         3845  +} -cleanup [SampleSlotCleanup {
  3745   3846       rename $s {}
  3746         -} -result {{} unknown {1 Set destroy 1 Set unknown}}
  3747         -test oo-33.4 {TIP 380: slots - errors} -setup {
         3847  +}] -result {{} unknown {1 Set destroy 1 Set unknown}}
         3848  +test oo-33.4 {TIP 380: slots - errors} -setup [SampleSlotSetup {
  3748   3849       set s [SampleSlot new]
  3749         -} -body {
         3850  +}] -body {
  3750   3851       # Method names beginning with "-" are special to slots
  3751   3852       $s -grill q
  3752         -} -returnCodes error -cleanup {
         3853  +} -returnCodes error -cleanup [SampleSlotCleanup {
  3753   3854       rename $s {}
  3754         -} -result {unknown method "-grill": must be -append, -clear, -set, contents or ops}
  3755         -
  3756         -SampleSlot destroy
         3855  +}] -result \
         3856  +    {unknown method "-grill": must be -append, -clear, -set, contents or ops}
  3757   3857   
  3758   3858   test oo-34.1 {TIP 380: slots - presence} -setup {
  3759   3859       set obj [oo::object new]
  3760   3860       set result {}
  3761   3861   } -body {
  3762   3862       oo::define oo::object {
  3763   3863   	::lappend ::result [::info object class filter]