Menu
▾
▴
[Instantobjects-cvscommit] SF.net SVN: instantobjects: [570] trunk/Source/Tests
|
From: <sr...@us...> - 2006-02-01 02:23:00
|
Revision: 570 Author: srmitch Date: 2006-01-31 18:22:31 -0800 (Tue, 31 Jan 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=570&view=rev Log Message: ----------- Changes: 1. Minor changes to Model.pas to allow required circular reference test structures; 2. Added test procedures to TestInstantReferences.pas to facilitate memory leak testing for object structures with circular references. Modified Paths: -------------- trunk/Source/Tests/TestIO.mdr trunk/Source/Tests/TestIO.mdx trunk/Source/Tests/TestInstantReferences.pas trunk/Source/Tests/TestModel.pas Modified: trunk/Source/Tests/TestIO.mdr =================================================================== (Binary files differ) Modified: trunk/Source/Tests/TestIO.mdx =================================================================== --- trunk/Source/Tests/TestIO.mdx 2006-01-27 19:08:04 UTC (rev 569) +++ trunk/Source/Tests/TestIO.mdx 2006-02-01 02:22:31 UTC (rev 570) @@ -1 +1 @@ -<TInstantClassMetadatas><TInstantClassMetadata><Name>TAddress</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>State</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>4</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Street</Name><AttributeType>atMemo</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Zip</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCountry</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPhone</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TEmail</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>100</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCategory</Name><Persistence>peStored</Persistence><StorageName>Categories</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContact</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Phones</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPhone</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Projects</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Contact_Projects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>PartExternal</Name><AttributeType>atPart</AttributeType><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPartExternal</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalParts</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Contact_ExternalParts</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPartsExternal</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContactFilter</Name><ParentName>TContact</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPerson</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>BirthDate</Name><AttributeType>atDateTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Emails</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TEmail</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employer</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Picture</Name><AttributeType>atBlob</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Salary</Name><AttributeType>atCurrency</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employed</Name><AttributeType>atBoolean</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>AL_hours</Name><AttributeType>atFloat</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCompany</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Employees</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>NoOfBranches</Name><AttributeType>atInteger</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProject</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPartExternal</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPartsExternal</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas> \ No newline at end of file +<TInstantClassMetadatas><TInstantClassMetadata><Name>TAddress</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>State</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>4</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Street</Name><AttributeType>atMemo</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Zip</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCountry</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPhone</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TEmail</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>100</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCategory</Name><Persistence>peStored</Persistence><StorageName>Categories</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContact</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Phones</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPhone</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Projects</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Contact_Projects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalAddress</Name><AttributeType>atPart</AttributeType><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalPhones</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Contact_ExternalPhones</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalPhones</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContactFilter</Name><ParentName>TContact</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPerson</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>BirthDate</Name><AttributeType>atDateTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Emails</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TEmail</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employer</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Picture</Name><AttributeType>atBlob</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Salary</Name><AttributeType>atCurrency</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employed</Name><AttributeType>atBoolean</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>AL_hours</Name><AttributeType>atFloat</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCompany</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Employees</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>NoOfBranches</Name><AttributeType>atInteger</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProject</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_Address</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>SubProjects</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_SubProjects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalAddress</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Site_Contact</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalPhones</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas> \ No newline at end of file Modified: trunk/Source/Tests/TestInstantReferences.pas =================================================================== --- trunk/Source/Tests/TestInstantReferences.pas 2006-01-27 19:08:04 UTC (rev 569) +++ trunk/Source/Tests/TestInstantReferences.pas 2006-02-01 02:22:31 UTC (rev 570) @@ -36,6 +36,8 @@ type + // Use these tests in conjunction with a memory + // leak test utility. TestTInstantReferences_Leak = class(TTestCase) private FConn: TInstantMockConnector; @@ -47,9 +49,15 @@ published procedure TestAddEmbeddedObject; procedure TestAddExternalObject; + + // A -> <- B -> C + procedure TestCircularReferences; + // A -> B {Parts}-> C -> A + procedure TestCircularReferences1; + // A -> B {Parts}-> C {Parts}-> D -> A + procedure TestCircularReferences2; end; - // Test methods for class TInstantReferences TestTInstantEmbReferences = class(TTestCase) private FConn: TInstantMockConnector; @@ -184,6 +192,164 @@ end; end; +// A -> <- B -> C +procedure TestTInstantReferences_Leak.TestCircularReferences; +var + vPerson1: TPerson; + vCategory: TCategory; +begin + FOwner.Name := 'Owner'; + + vPerson1 := TPerson.Create(FConn); + try + AssertNotNull(vPerson1); + vPerson1.Name := 'vPerson1'; + + vPerson1.EmployBy(FOwner); + AssertNotNull(vPerson1.Employer); + AssertEquals('vPerson1.Employer.Name A', 'Owner', vPerson1.Employer.Name); + finally + vPerson1.Free; + end; + AssertEquals('FOwner.RefCount 1', 2, FOwner.RefCount); + AssertEquals('FOwner.ReferencedBy.Count 1', 1, FOwner.ReferencedBy.Count); + AssertEquals('FOwner.EmployeeCount 1', 1, FOwner.EmployeeCount); + AssertEquals('FOwner.Employees[0].RefCount 1', + 1, FOwner.Employees[0].RefCount); + AssertEquals('FOwner.Employees[0].ReferencedBy.Count 1', + 1, FOwner.Employees[0].ReferencedBy.Count); + + vCategory := TCategory.Create(FConn); + try + AssertNotNull(vCategory); + vCategory.Name := 'vCategory'; + + FOwner.Employees[0].Category := vCategory; + finally + vCategory.Free; + end; + AssertEquals('FOwner.RefCount 2', 2, FOwner.RefCount); + AssertEquals('FOwner.ReferencedBy.Count 2', 1, FOwner.ReferencedBy.Count); + + AssertEquals('FOwner.Employees[0].RefCount 2', + 1, FOwner.Employees[0].RefCount); + AssertEquals('FOwner.Employees[0].ReferencedBy.Count 2', + 1, FOwner.Employees[0].ReferencedBy.Count); + + AssertEquals('FOwner.Employees[0].Category.RefCount 1', + 1, FOwner.Employees[0].Category.RefCount); + AssertEquals('FOwner.Employees[0].Category.ReferencedBy.Count 1', + 1, FOwner.Employees[0].Category.ReferencedBy.Count); +end; + +// A -> B {Parts}-> C -> A +procedure TestTInstantReferences_Leak.TestCircularReferences1; +var + vPerson: TPerson; + vProject: TProject; + vAddress: TExternalAddress; +begin + vPerson := TPerson.Create(FConn); + try + AssertNotNull(vPerson); + vPerson.Name := 'vPerson1'; + + vProject := TProject.Create(FConn); + try + AssertNotNull(vProject); + vProject.Name := 'vProject1'; + vAddress := TExternalAddress.Create(FConn); + try + AssertNotNull(vAddress); + vAddress.Site_Contact := vPerson; + AssertEquals('vPerson1', vAddress.Site_Contact.Name); + vProject.AddAddress(vAddress); + except + vAddress.Free; + end; + vPerson.AddProject(vProject); + finally + vProject.Free; + end; + AssertEquals('vPerson.RefCount 1', 2, vPerson.RefCount); + AssertEquals('vPerson.ReferencedBy.Count 1', 1, vPerson.ReferencedBy.Count); + AssertEquals('vPerson.Projects[0].RefCount', 1, vPerson.Projects[0].RefCount); + AssertEquals('vPerson.Projects[0].ReferencedBy.Count', + 1, vPerson.Projects[0].ReferencedBy.Count); + AssertEquals('vPerson.Projects[0].Address[0].RefCount', + 1, vPerson.Projects[0].Address[0].RefCount); + AssertEquals('vPerson.Projects[0].Address[0].ReferencedBy.Count', + 0, vPerson.Projects[0].Address[0].ReferencedBy.Count); + finally + vPerson.Free; + end; +// AssertEquals('vPerson.RefCount 2', 1, vPerson.RefCount); +// AssertEquals('vPerson.ReferencedBy.Count 2', 1, vPerson.ReferencedBy.Count); +end; + +// A -> B {Parts}-> C {Parts}-> D -> A +procedure TestTInstantReferences_Leak.TestCircularReferences2; +var + vPerson: TPerson; + vProject: TProject; + vSubProject: TProject; + vAddress: TExternalAddress; +begin + vPerson := TPerson.Create(FConn); + try + AssertNotNull(vPerson); + vPerson.Name := 'vPerson'; + + vProject := TProject.Create(FConn); + try + AssertNotNull(vProject); + vProject.Name := 'vProject'; + + vSubProject := TProject.Create(FConn); + try + vAddress := TExternalAddress.Create(FConn); + try + AssertNotNull(vAddress); + vAddress.Site_Contact := vPerson; + AssertEquals('vPerson', vAddress.Site_Contact.Name); + vSubProject.AddAddress(vAddress); + except + vAddress.Free; + raise; + end; + vProject.AddSubProject(vSubProject); + except + vSubProject.Free; + raise; + end; + vPerson.AddProject(vProject); + finally + vProject.Free; + end; + AssertEquals('vPerson.RefCount 1', 2, vPerson.RefCount); + AssertEquals('vPerson.ReferencedBy.Count 1', 1, vPerson.ReferencedBy.Count); + + AssertEquals('vPerson.Projects[0].RefCount', + 1, vPerson.Projects[0].RefCount); + AssertEquals('vPerson.Projects[0].ReferencedBy.Count', + 1, vPerson.Projects[0].ReferencedBy.Count); + + AssertEquals('vPerson.Projects[0].SubProjects[0].RefCount', + 1, vPerson.Projects[0].SubProjects[0].RefCount); + AssertEquals('vPerson.Projects[0].SubProjects[0].ReferencedBy.Count', + 0, vPerson.Projects[0].SubProjects[0].ReferencedBy.Count); + + AssertEquals('vPerson.Projects[0].SubProjects[0].Address[0].RefCount', + 1, vPerson.Projects[0].SubProjects[0].Address[0].RefCount); + AssertEquals('vPerson.Projects[0].SubProjects[0].Address[0].ReferencedBy.Count', + 0, vPerson.Projects[0].SubProjects[0].Address[0].ReferencedBy.Count); + finally + vPerson.Free; + end; +// AssertEquals('vPerson.RefCount 2', 1, vPerson.RefCount); +// AssertEquals('vPerson.ReferencedBy.Count 2', 1, vPerson.ReferencedBy.Count); +end; + function TestTInstantEmbReferences.RefsEmbeddedCompare(Holder, Obj1, Obj2: TInstantObject): Integer; var Modified: trunk/Source/Tests/TestModel.pas =================================================================== --- trunk/Source/Tests/TestModel.pas 2006-01-27 19:08:04 UTC (rev 569) +++ trunk/Source/Tests/TestModel.pas 2006-02-01 02:22:31 UTC (rev 570) @@ -94,8 +94,7 @@ end; TPhone = class(TInstantObject) - {IOMETADATA stored; - Name: String(20); + {IOMETADATA Name: String(20); Number: String(20) mask '(000) 000-0000;0;_'; } _Name: TInstantString; _Number: TInstantString; @@ -305,11 +304,38 @@ TProject = class(TInstantObject) {IOMETADATA stored; - Name: String(30); } + Name: String(30); + Address: Parts(TExternalAddress) external 'Project_Address'; + SubProjects: Parts(TProject) external 'Project_SubProjects'; } + _Address: TInstantParts; _Name: TInstantString; + _SubProjects: TInstantParts; private + function GetAddressCount: Integer; + function GetAddress(Index: Integer): TExternalAddress; function GetName: string; + function GetSubProjectCount: Integer; + function GetSubProjects(Index: Integer): TProject; + procedure SetAddress(Index: Integer; Value: TExternalAddress); procedure SetName(const Value: string); + procedure SetSubProjects(Index: Integer; Value: TProject); + public + function AddAddress(Address: TExternalAddress): Integer; + function AddSubProject(SubProject: TProject): Integer; + procedure ClearAddress; + procedure ClearSubProjects; + procedure DeleteAddress(Index: Integer); + procedure DeleteSubProject(Index: Integer); + function IndexOfAddress(Address: TExternalAddress): Integer; + function IndexOfSubProject(SubProject: TProject): Integer; + procedure InsertAddress(Index: Integer; Address: TExternalAddress); + procedure InsertSubProject(Index: Integer; SubProject: TProject); + function RemoveAddress(Address: TExternalAddress): Integer; + function RemoveSubProject(SubProject: TProject): Integer; + property AddressCount: Integer read GetAddressCount; + property SubProjectCount: Integer read GetSubProjectCount; + property SubProjects[Index: Integer]: TProject read GetSubProjects write SetSubProjects; + property Address[Index: Integer]: TExternalAddress read GetAddress write SetAddress; published property Name: string read GetName write SetName; end; @@ -317,17 +343,22 @@ TExternalAddress = class(TInstantObject) {IOMETADATA stored; Name: String(30); - Category: Reference(TCategory); } + Category: Reference(TCategory); + Site_Contact: Reference(TPerson); } _Category: TInstantReference; _Name: TInstantString; + _Site_Contact: TInstantReference; private function GetCategory: TCategory; function GetName: string; + function GetSite_Contact: TPerson; procedure SetCategory(Value: TCategory); procedure SetName(const Value: string); + procedure SetSite_Contact(Value: TPerson); published property Category: TCategory read GetCategory write SetCategory; property Name: string read GetName write SetName; + property Site_Contact: TPerson read GetSite_Contact write SetSite_Contact; end; TExternalPhones = class(TInstantObject) @@ -639,16 +670,106 @@ { TProject } +function TProject.AddAddress(Address: TExternalAddress): Integer; +begin + Result := _Address.Add(Address); +end; + +function TProject.AddSubProject(SubProject: TProject): Integer; +begin + Result := _SubProjects.Add(SubProject); +end; + +procedure TProject.ClearAddress; +begin + _Address.Clear; +end; + +procedure TProject.ClearSubProjects; +begin + _SubProjects.Clear; +end; + +procedure TProject.DeleteAddress(Index: Integer); +begin + _Address.Delete(Index); +end; + +function TProject.GetAddressCount: Integer; +begin + Result := _Address.Count; +end; + +procedure TProject.DeleteSubProject(Index: Integer); +begin + _SubProjects.Delete(Index); +end; + +function TProject.GetAddress(Index: Integer): TExternalAddress; +begin + Result := _Address[Index] as TExternalAddress; +end; + function TProject.GetName: string; begin Result := _Name.Value; end; +function TProject.GetSubProjectCount: Integer; +begin + Result := _SubProjects.Count; +end; + +function TProject.GetSubProjects(Index: Integer): TProject; +begin + Result := _SubProjects[Index] as TProject; +end; + +function TProject.IndexOfAddress(Address: TExternalAddress): Integer; +begin + Result := _Address.IndexOf(Address); +end; + +function TProject.IndexOfSubProject(SubProject: TProject): Integer; +begin + Result := _SubProjects.IndexOf(SubProject); +end; + +procedure TProject.InsertAddress(Index: Integer; Address: TExternalAddress); +begin + _Address.Insert(Index, Address); +end; + +procedure TProject.InsertSubProject(Index: Integer; SubProject: TProject); +begin + _SubProjects.Insert(Index, SubProject); +end; + +function TProject.RemoveAddress(Address: TExternalAddress): Integer; +begin + Result := _Address.Remove(Address); +end; + +function TProject.RemoveSubProject(SubProject: TProject): Integer; +begin + Result := _SubProjects.Remove(SubProject); +end; + +procedure TProject.SetAddress(Index: Integer; Value: TExternalAddress); +begin + _Address[Index] := Value; +end; + procedure TProject.SetName(const Value: string); begin _Name.Value := Value; end; +procedure TProject.SetSubProjects(Index: Integer; Value: TProject); +begin + _SubProjects[Index] := Value; +end; + { TEmail } function TEmail.GetAddress: string; @@ -1011,6 +1132,11 @@ Result := _Name.Value; end; +function TExternalAddress.GetSite_Contact: TPerson; +begin + Result := _Site_Contact.Value as TPerson; +end; + procedure TExternalAddress.SetCategory(Value: TCategory); begin _Category.Value := Value; @@ -1023,6 +1149,11 @@ { TExternalPhones } +procedure TExternalAddress.SetSite_Contact(Value: TPerson); +begin + _Site_Contact.Value := Value; +end; + function TExternalPhones.GetName: string; begin Result := _Name.Value; |
