Thread: [Instantobjects-cvscommit] SF.net SVN: instantobjects: [570] trunk/Source/Tests

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

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;







Thread: [Instantobjects-cvscommit] SF.net SVN: instantobjects: [570] trunk/Source/Tests

instantobjects-cvscommit