You can subscribe to this list here.
2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(13) |
Sep
(25) |
Oct
(10) |
Nov
(19) |
Dec
(20) |
---|---|---|---|---|---|---|---|---|---|---|---|---|
2005 |
Jan
|
Feb
(206) |
Mar
(43) |
Apr
(25) |
May
(20) |
Jun
(69) |
Jul
(121) |
Aug
(95) |
Sep
(122) |
Oct
(213) |
Nov
(46) |
Dec
(39) |
2006 |
Jan
(28) |
Feb
(57) |
Mar
(21) |
Apr
(7) |
May
(11) |
Jun
(2) |
Jul
(8) |
Aug
(13) |
Sep
(2) |
Oct
(2) |
Nov
(20) |
Dec
(16) |
2007 |
Jan
(9) |
Feb
(15) |
Mar
|
Apr
(4) |
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
|
Nov
|
Dec
|
2008 |
Jan
|
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
|
Jul
(3) |
Aug
(1) |
Sep
(9) |
Oct
|
Nov
(1) |
Dec
|
2009 |
Jan
|
Feb
|
Mar
(8) |
Apr
(1) |
May
|
Jun
|
Jul
(11) |
Aug
(57) |
Sep
(2) |
Oct
(6) |
Nov
|
Dec
(7) |
2010 |
Jan
(11) |
Feb
(1) |
Mar
|
Apr
(1) |
May
|
Jun
|
Jul
(1) |
Aug
(2) |
Sep
(27) |
Oct
(3) |
Nov
(7) |
Dec
(1) |
2011 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
(10) |
Oct
|
Nov
|
Dec
|
2012 |
Jan
(8) |
Feb
(1) |
Mar
|
Apr
|
May
|
Jun
|
Jul
(1) |
Aug
|
Sep
|
Oct
(3) |
Nov
(1) |
Dec
(1) |
2013 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
2014 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(3) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
|
Nov
(4) |
Dec
|
2015 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(1) |
Sep
(1) |
Oct
|
Nov
|
Dec
|
2016 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(3) |
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
2017 |
Jan
|
Feb
|
Mar
(1) |
Apr
(4) |
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
2018 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
(3) |
Oct
|
Nov
(4) |
Dec
|
2022 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(1) |
From: <fas...@us...> - 2006-02-03 02:48:04
|
Revision: 575 Author: fastbike2 Date: 2006-02-02 18:47:44 -0800 (Thu, 02 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=575&view=rev Log Message: ----------- Fix for Bug 1423157. Parts Attribute Insert causes Error Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-03 01:59:28 UTC (rev 574) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-03 02:47:44 UTC (rev 575) @@ -26,7 +26,7 @@ * Contributor(s): * Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell, * Joao Morais, Cesar Coll, Uberto Barbini, David Taylor, Hanedi Salas, - * Riceball Lee + * Riceball Lee, David Moorhouse * * ***** END LICENSE BLOCK ***** *) @@ -6592,7 +6592,8 @@ procedure TInstantContainer.Insert(Index: Integer; AObject: TInstantObject); begin - CheckRange(Index); + if Index <> 0 then + CheckRange(Index); ValidateObject(AObject); BeforeContentChange(ctAdd, Index, AObject); InternalInsert(Index, AObject); |
From: <sr...@us...> - 2006-02-03 01:59:47
|
Revision: 574 Author: srmitch Date: 2006-02-02 17:59:28 -0800 (Thu, 02 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=574&view=rev Log Message: ----------- Changes: 1. Added another test procedure to TestInstantReferences.pas to facilitate memory leak testing for object structures with circular references: A -> B -> C -> A | + -> D -> E then delete E Modified Paths: -------------- trunk/Source/Tests/TestInstantReferences.pas Modified: trunk/Source/Tests/TestInstantReferences.pas =================================================================== --- trunk/Source/Tests/TestInstantReferences.pas 2006-02-03 01:24:03 UTC (rev 573) +++ trunk/Source/Tests/TestInstantReferences.pas 2006-02-03 01:59:28 UTC (rev 574) @@ -58,14 +58,19 @@ procedure TestCircularReferences2; // A -> <- B // | - // +-> C + // + -> C // then delete C procedure TestCircularReferences3; - // A->B->C->A + // A -> B -> C -> A // | - // +->D + // + -> D // then delete D procedure TestCircularReferences4; + // A -> B -> C -> A + // | + // + -> D -> E + // then delete E + procedure TestCircularReferences5; end; TestTInstantEmbReferences = class(TTestCase) @@ -362,7 +367,7 @@ // A -> <- B // | -// +-> C +// + -> C // then delete C procedure TestTInstantReferences_Leak.TestCircularReferences3; var @@ -413,9 +418,9 @@ AssertEquals('FOwner.EmployeeCount', 1, FOwner.EmployeeCount); end; -// A->B->C->A +// A -> B -> C -> A // | -// +->D +// + -> D // then delete D procedure TestTInstantReferences_Leak.TestCircularReferences4; var @@ -488,6 +493,96 @@ end; end; +// A -> B -> C -> A +// | +// + -> D -> E +// then delete E +procedure TestTInstantReferences_Leak.TestCircularReferences5; +var + vPerson: TPerson; + vProject1: TProject; + vProject2: TProject; + vPerson2: TPerson; +begin + FOwner.Name := 'Owner'; + + vPerson := TPerson.Create(FConn); + try + AssertNotNull(vPerson); + vPerson.Name := 'vPerson'; + + vPerson.EmployBy(FOwner); + AssertNotNull(vPerson.Employer); + AssertEquals('vPerson.Employer.Name A', 'Owner', vPerson.Employer.Name); + FOwner.DeleteEmployee(0); + + vProject1 := TProject.Create(FConn); + try + AssertNotNull(vProject1); + vProject1.Name := 'vProject1'; + vProject1.Manager := vPerson; + FOwner.AddProject(vProject1); + finally + vProject1.Free; + end; + + vProject2 := TProject.Create(FConn); + try + AssertNotNull(vProject2); + vProject2.Name := 'vProject2'; + vPerson2 := TPerson.Create(FConn); + try + AssertNotNull(vPerson2); + vPerson2.Name := 'vPerson2'; + + vProject2.Manager := vPerson2; + finally + vPerson2.Free; + end; + FOwner.AddProject(vProject2); + finally + vProject2.Free; + end; + + FreeAndNil(FOwner); + + AssertEquals('vPerson.RefCount 1', + 2, vPerson.RefCount); + AssertEquals('vPerson.ReferencedBy.Count 1', + 1, vPerson.ReferencedBy.Count); + + AssertEquals('vPerson.Employer.RefCount 1', + 1, vPerson.Employer.RefCount); + AssertEquals('vPerson.Employer.ReferencedBy.Count 1', + 1, vPerson.Employer.ReferencedBy.Count); + + AssertEquals('vPerson.Employer.EmployeeCount 1', + 0, vPerson.Employer.EmployeeCount); + + AssertEquals('vPerson.Employer.ProjectCount 1', + 2, vPerson.Employer.ProjectCount); + AssertEquals('vPerson.Employer.Projects[0].RefCount 1', + 1, vPerson.Employer.Projects[0].RefCount); + AssertEquals('vPerson.Employer.Projects[0].ReferencedBy.Count 1', + 1, vPerson.Employer.Projects[0].ReferencedBy.Count); + AssertEquals('vPerson.Employer.Projects[1].RefCount 1', + 1, vPerson.Employer.Projects[1].RefCount); + AssertEquals('vPerson.Employer.Projects[1].ReferencedBy.Count 1', + 1, vPerson.Employer.Projects[1].ReferencedBy.Count); + + AssertEquals('vPerson.Employer.Projects[1].Manager.RefCount 1', + 1, vPerson.Employer.Projects[1].Manager.RefCount); + AssertEquals('vPerson.Employer.Projects[1].Manager.ReferencedBy.Count 1', + 1, vPerson.Employer.Projects[1].Manager.ReferencedBy.Count); + + vPerson.Employer.Projects[1].Manager := nil; + AssertEquals('vPerson.Employer.ProjectCount 1', + 2, vPerson.Employer.ProjectCount); + finally + vPerson.Free; + end; +end; + function TestTInstantEmbReferences.RefsEmbeddedCompare(Holder, Obj1, Obj2: TInstantObject): Integer; var |
From: <fas...@us...> - 2006-02-03 01:24:23
|
Revision: 573 Author: fastbike2 Date: 2006-02-02 17:24:03 -0800 (Thu, 02 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=573&view=rev Log Message: ----------- Internal transaction now AutoCommits. Fix for bug 1402383 "Hanging Transactions". Modified Paths: -------------- trunk/Source/Brokers/IBX/InstantIBX.pas Modified: trunk/Source/Brokers/IBX/InstantIBX.pas =================================================================== --- trunk/Source/Brokers/IBX/InstantIBX.pas 2006-02-02 02:23:34 UTC (rev 572) +++ trunk/Source/Brokers/IBX/InstantIBX.pas 2006-02-03 01:24:03 UTC (rev 573) @@ -244,8 +244,9 @@ try FTransaction.DefaultDatabase := Connection; FTransaction.Params.Add('read_committed'); + FTransaction.AutoStopAction := saCommit; except - FTransaction.Free; + FreeAndNil(FTransaction); raise; end end; |
From: <sr...@us...> - 2006-02-02 02:24:03
|
Revision: 572 Author: srmitch Date: 2006-02-01 18:23:34 -0800 (Wed, 01 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=572&view=rev Log Message: ----------- Changes: 1. Minor change to TProject in Model.pas to allow required circular reference test structures; 2. Added more 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-02-01 04:35:49 UTC (rev 571) +++ trunk/Source/Tests/TestIO.mdx 2006-02-02 02:23:34 UTC (rev 572) @@ -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>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>SubProjects</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_SubProjects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Addresses</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_Addresses</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</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 +<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>SubProjects</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_SubProjects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Addresses</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_Addresses</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Manager</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</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-02-01 04:35:49 UTC (rev 571) +++ trunk/Source/Tests/TestInstantReferences.pas 2006-02-02 02:23:34 UTC (rev 572) @@ -56,6 +56,16 @@ procedure TestCircularReferences1; // A -> B {Parts}-> C {Parts}-> D -> A procedure TestCircularReferences2; + // A -> <- B + // | + // +-> C + // then delete C + procedure TestCircularReferences3; + // A->B->C->A + // | + // +->D + // then delete D + procedure TestCircularReferences4; end; TestTInstantEmbReferences = class(TTestCase) @@ -350,6 +360,134 @@ // AssertEquals('vPerson.ReferencedBy.Count 2', 1, vPerson.ReferencedBy.Count); end; +// A -> <- B +// | +// +-> C +// then delete C +procedure TestTInstantReferences_Leak.TestCircularReferences3; +var + vPerson1: TPerson; + vPerson2: TPerson; +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); + + vPerson2 := TPerson.Create(FConn); + try + AssertNotNull(vPerson2); + vPerson2.Name := 'vPerson2'; + + FOwner.AddEmployee(vPerson2); + AssertNull(vPerson2.Employer); + finally + vPerson2.Free; + end; + AssertEquals('FOwner.RefCount 1', 2, FOwner.RefCount); + AssertEquals('FOwner.ReferencedBy.Count 1', 1, FOwner.ReferencedBy.Count); + + AssertEquals('FOwner.EmployeeCount', 2, FOwner.EmployeeCount); + AssertEquals('FOwner.Employees[1].RefCount 1', + 1, FOwner.Employees[1].RefCount); + AssertEquals('FOwner.Employees[1].ReferencedBy.Count 1', + 1, FOwner.Employees[1].ReferencedBy.Count); + + FOwner.DeleteEmployee(1); + AssertEquals('FOwner.EmployeeCount', 1, FOwner.EmployeeCount); +end; + +// A->B->C->A +// | +// +->D +// then delete D +procedure TestTInstantReferences_Leak.TestCircularReferences4; +var + vPerson: TPerson; + vProject1: TProject; + vProject2: TProject; +begin + FOwner.Name := 'Owner'; + + vPerson := TPerson.Create(FConn); + try + AssertNotNull(vPerson); + vPerson.Name := 'vPerson'; + + vPerson.EmployBy(FOwner); + AssertNotNull(vPerson.Employer); + AssertEquals('vPerson.Employer.Name A', 'Owner', vPerson.Employer.Name); + FOwner.DeleteEmployee(0); + + vProject1 := TProject.Create(FConn); + try + AssertNotNull(vProject1); + vProject1.Name := 'vProject1'; + vProject1.Manager := vPerson; + FOwner.AddProject(vProject1); + finally + vProject1.Free; + end; + + vProject2 := TProject.Create(FConn); + try + AssertNotNull(vProject2); + vProject2.Name := 'vProject2'; + FOwner.AddProject(vProject2); + finally + vProject2.Free; + end; + + FreeAndNil(FOwner); + + AssertEquals('vPerson.RefCount 1', + 2, vPerson.RefCount); + AssertEquals('vPerson.ReferencedBy.Count 1', + 1, vPerson.ReferencedBy.Count); + + AssertEquals('vPerson.Employer.RefCount 1', + 1, vPerson.Employer.RefCount); + AssertEquals('vPerson.Employer.ReferencedBy.Count 1', + 1, vPerson.Employer.ReferencedBy.Count); + + AssertEquals('vPerson.Employer.EmployeeCount 1', + 0, vPerson.Employer.EmployeeCount); + + AssertEquals('vPerson.Employer.ProjectCount 1', + 2, vPerson.Employer.ProjectCount); + AssertEquals('vPerson.Employer.Projects[0].RefCount 1', + 1, vPerson.Employer.Projects[0].RefCount); + AssertEquals('vPerson.Employer.Projects[0].ReferencedBy.Count 1', + 1, vPerson.Employer.Projects[0].ReferencedBy.Count); + AssertEquals('vPerson.Employer.Projects[1].RefCount 1', + 1, vPerson.Employer.Projects[1].RefCount); + AssertEquals('vPerson.Employer.Projects[1].ReferencedBy.Count 1', + 1, vPerson.Employer.Projects[1].ReferencedBy.Count); + + vPerson.Employer.DeleteProject(1); + AssertEquals('vPerson.Employer.ProjectCount 1', + 1, vPerson.Employer.ProjectCount); + finally + vPerson.Free; + end; +end; + function TestTInstantEmbReferences.RefsEmbeddedCompare(Holder, Obj1, Obj2: TInstantObject): Integer; var Modified: trunk/Source/Tests/TestModel.pas =================================================================== --- trunk/Source/Tests/TestModel.pas 2006-02-01 04:35:49 UTC (rev 571) +++ trunk/Source/Tests/TestModel.pas 2006-02-02 02:23:34 UTC (rev 572) @@ -306,17 +306,21 @@ {IOMETADATA stored; Name: String(30); SubProjects: Parts(TProject) external 'Project_SubProjects'; - Addresses: Parts(TExternalAddress) external 'Project_Addresses'; } + Addresses: Parts(TExternalAddress) external 'Project_Addresses'; + Manager: Reference(TPerson); } _Addresses: TInstantParts; + _Manager: TInstantReference; _Name: TInstantString; _SubProjects: TInstantParts; private function GetAddressCount: Integer; function GetAddresses(Index: Integer): TExternalAddress; + function GetManager: TPerson; function GetName: string; function GetSubProjectCount: Integer; function GetSubProjects(Index: Integer): TProject; procedure SetAddresses(Index: Integer; Value: TExternalAddress); + procedure SetManager(Value: TPerson); procedure SetName(const Value: string); procedure SetSubProjects(Index: Integer; Value: TProject); public @@ -337,6 +341,7 @@ property SubProjectCount: Integer read GetSubProjectCount; property SubProjects[Index: Integer]: TProject read GetSubProjects write SetSubProjects; published + property Manager: TPerson read GetManager write SetManager; property Name: string read GetName write SetName; end; @@ -708,6 +713,11 @@ Result := _Addresses[Index] as TExternalAddress; end; +function TProject.GetManager: TPerson; +begin + Result := _Manager.Value as TPerson; +end; + function TProject.GetName: string; begin Result := _Name.Value; @@ -758,6 +768,11 @@ _Addresses[Index] := Value; end; +procedure TProject.SetManager(Value: TPerson); +begin + _Manager.Value := Value; +end; + procedure TProject.SetName(const Value: string); begin _Name.Value := Value; |
From: <sr...@us...> - 2006-02-01 04:36:21
|
Revision: 571 Author: srmitch Date: 2006-01-31 20:35:49 -0800 (Tue, 31 Jan 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=571&view=rev Log Message: ----------- Changes: 1. In Model.pas for TProject class changed name of 'Address' parts attribute to more appropriate 'Addresses'. 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-02-01 02:22:31 UTC (rev 570) +++ trunk/Source/Tests/TestIO.mdx 2006-02-01 04:35:49 UTC (rev 571) @@ -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>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 +<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>SubProjects</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_SubProjects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Addresses</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_Addresses</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</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-02-01 02:22:31 UTC (rev 570) +++ trunk/Source/Tests/TestInstantReferences.pas 2006-02-01 04:35:49 UTC (rev 571) @@ -276,10 +276,10 @@ 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); + AssertEquals('vPerson.Projects[0].Addresses[0].RefCount', + 1, vPerson.Projects[0].Addresses[0].RefCount); + AssertEquals('vPerson.Projects[0].Addresses[0].ReferencedBy.Count', + 0, vPerson.Projects[0].Addresses[0].ReferencedBy.Count); finally vPerson.Free; end; @@ -339,10 +339,10 @@ 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); + AssertEquals('vPerson.Projects[0].SubProjects[0].Addresses[0].RefCount', + 1, vPerson.Projects[0].SubProjects[0].Addresses[0].RefCount); + AssertEquals('vPerson.Projects[0].SubProjects[0].Addresses[0].ReferencedBy.Count', + 0, vPerson.Projects[0].SubProjects[0].Addresses[0].ReferencedBy.Count); finally vPerson.Free; end; Modified: trunk/Source/Tests/TestModel.pas =================================================================== --- trunk/Source/Tests/TestModel.pas 2006-02-01 02:22:31 UTC (rev 570) +++ trunk/Source/Tests/TestModel.pas 2006-02-01 04:35:49 UTC (rev 571) @@ -305,24 +305,24 @@ TProject = class(TInstantObject) {IOMETADATA stored; Name: String(30); - Address: Parts(TExternalAddress) external 'Project_Address'; - SubProjects: Parts(TProject) external 'Project_SubProjects'; } - _Address: TInstantParts; + SubProjects: Parts(TProject) external 'Project_SubProjects'; + Addresses: Parts(TExternalAddress) external 'Project_Addresses'; } + _Addresses: TInstantParts; _Name: TInstantString; _SubProjects: TInstantParts; private function GetAddressCount: Integer; - function GetAddress(Index: Integer): TExternalAddress; + function GetAddresses(Index: Integer): TExternalAddress; function GetName: string; function GetSubProjectCount: Integer; function GetSubProjects(Index: Integer): TProject; - procedure SetAddress(Index: Integer; Value: TExternalAddress); + procedure SetAddresses(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 ClearAddresses; procedure ClearSubProjects; procedure DeleteAddress(Index: Integer); procedure DeleteSubProject(Index: Integer); @@ -333,9 +333,9 @@ function RemoveAddress(Address: TExternalAddress): Integer; function RemoveSubProject(SubProject: TProject): Integer; property AddressCount: Integer read GetAddressCount; + property Addresses[Index: Integer]: TExternalAddress read GetAddresses write SetAddresses; 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; @@ -668,11 +668,9 @@ _Number.Value := Value; end; -{ TProject } - function TProject.AddAddress(Address: TExternalAddress): Integer; begin - Result := _Address.Add(Address); + Result := _Addresses.Add(Address); end; function TProject.AddSubProject(SubProject: TProject): Integer; @@ -680,9 +678,9 @@ Result := _SubProjects.Add(SubProject); end; -procedure TProject.ClearAddress; +procedure TProject.ClearAddresses; begin - _Address.Clear; + _Addresses.Clear; end; procedure TProject.ClearSubProjects; @@ -692,12 +690,12 @@ procedure TProject.DeleteAddress(Index: Integer); begin - _Address.Delete(Index); + _Addresses.Delete(Index); end; function TProject.GetAddressCount: Integer; begin - Result := _Address.Count; + Result := _Addresses.Count; end; procedure TProject.DeleteSubProject(Index: Integer); @@ -705,9 +703,9 @@ _SubProjects.Delete(Index); end; -function TProject.GetAddress(Index: Integer): TExternalAddress; +function TProject.GetAddresses(Index: Integer): TExternalAddress; begin - Result := _Address[Index] as TExternalAddress; + Result := _Addresses[Index] as TExternalAddress; end; function TProject.GetName: string; @@ -727,7 +725,7 @@ function TProject.IndexOfAddress(Address: TExternalAddress): Integer; begin - Result := _Address.IndexOf(Address); + Result := _Addresses.IndexOf(Address); end; function TProject.IndexOfSubProject(SubProject: TProject): Integer; @@ -737,7 +735,7 @@ procedure TProject.InsertAddress(Index: Integer; Address: TExternalAddress); begin - _Address.Insert(Index, Address); + _Addresses.Insert(Index, Address); end; procedure TProject.InsertSubProject(Index: Integer; SubProject: TProject); @@ -747,7 +745,7 @@ function TProject.RemoveAddress(Address: TExternalAddress): Integer; begin - Result := _Address.Remove(Address); + Result := _Addresses.Remove(Address); end; function TProject.RemoveSubProject(SubProject: TProject): Integer; @@ -755,9 +753,9 @@ Result := _SubProjects.Remove(SubProject); end; -procedure TProject.SetAddress(Index: Integer; Value: TExternalAddress); +procedure TProject.SetAddresses(Index: Integer; Value: TExternalAddress); begin - _Address[Index] := Value; + _Addresses[Index] := Value; end; procedure TProject.SetName(const Value: string); |
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; |
From: <na...@us...> - 2006-01-27 19:09:17
|
Revision: 569 Author: nandod Date: 2006-01-27 11:08:04 -0800 (Fri, 27 Jan 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=569&view=rev Log Message: ----------- modified svn:ignore Property Changed: ---------------- trunk/Source/Brokers/ADO/ trunk/Source/Brokers/ADO/D2006/ trunk/Source/Brokers/ADO/D7/ trunk/Source/Brokers/BDE/ trunk/Source/Brokers/BDE/D2006/ trunk/Source/Brokers/BDE/D7/ trunk/Source/Brokers/DBX/ trunk/Source/Brokers/DBX/D2006/ trunk/Source/Brokers/DBX/D7/ Property changes on: trunk/Source/Brokers/ADO ___________________________________________________________________ Name: svn:ignore + *.dcu Property changes on: trunk/Source/Brokers/ADO/D2006 ___________________________________________________________________ Name: svn:ignore + *.dcu Property changes on: trunk/Source/Brokers/ADO/D7 ___________________________________________________________________ Name: svn:ignore + *.dcu Property changes on: trunk/Source/Brokers/BDE ___________________________________________________________________ Name: svn:ignore + *.dcu Property changes on: trunk/Source/Brokers/BDE/D2006 ___________________________________________________________________ Name: svn:ignore + *.dcu Property changes on: trunk/Source/Brokers/BDE/D7 ___________________________________________________________________ Name: svn:ignore + *.dcu Property changes on: trunk/Source/Brokers/DBX ___________________________________________________________________ Name: svn:ignore + *.dcu Property changes on: trunk/Source/Brokers/DBX/D2006 ___________________________________________________________________ Name: svn:ignore + *.dcu Property changes on: trunk/Source/Brokers/DBX/D7 ___________________________________________________________________ Name: svn:ignore + *.dcu |
From: <na...@us...> - 2006-01-27 12:06:56
|
Revision: 568 Author: nandod Date: 2006-01-27 04:06:38 -0800 (Fri, 27 Jan 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=568&view=rev Log Message: ----------- modified svn:ignore Property Changed: ---------------- trunk/Demos/PrimerCross/ModelExternal/ |
From: <na...@us...> - 2006-01-27 12:01:38
|
Revision: 567 Author: nandod Date: 2006-01-27 04:00:44 -0800 (Fri, 27 Jan 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=567&view=rev Log Message: ----------- PrimerCross: added ability to refresh contact grid through the F5 key. Modified Paths: -------------- trunk/Demos/PrimerCross/ContactView.pas Property Changed: ---------------- trunk/Source/Brokers/NexusDb/ trunk/Source/Brokers/UIB/ trunk/Source/Brokers/UIB/D7/ trunk/Source/Brokers/XML/D2006/ trunk/Source/Core/D7/ |
From: <na...@us...> - 2006-01-27 11:57:25
|
Revision: 566 Author: nandod Date: 2006-01-27 03:57:02 -0800 (Fri, 27 Jan 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=566&view=rev Log Message: ----------- PrimerCross: added ability to refresh grid contents through the F5 key. Modified Paths: -------------- trunk/Demos/PrimerCross/BasicBrowse.dfm trunk/Demos/PrimerCross/BasicBrowse.pas |
From: <na...@us...> - 2006-01-27 11:27:41
|
Revision: 565 Author: nandod Date: 2006-01-27 03:27:21 -0800 (Fri, 27 Jan 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=565&view=rev Log Message: ----------- Fixed bug #1416083 (Storage Name ignored for external Part attributes) on behalf of David Taylor. Modified Paths: -------------- trunk/Source/Core/InstantCode.pas |
From: <na...@us...> - 2006-01-26 14:26:48
|
Revision: 564 Author: nandod Date: 2006-01-26 06:26:01 -0800 (Thu, 26 Jan 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=564&view=rev Log Message: ----------- added value marks to the performance chart. Modified Paths: -------------- trunk/Demos/PrimerCross/PerformanceView.dfm |
Revision: 563 Author: jcmoraisjr Date: 2006-01-20 02:27:07 -0800 (Fri, 20 Jan 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=563&view=rev Log Message: ----------- Fixed bug # 1410657, where TInstantSelector.GetIsChanged fetches all non-retrieved objects looking for changes. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas trunk/Source/Core/InstantPresentation.pas |
Revision: 562 Author: srmitch Date: 2006-01-19 23:13:19 -0800 (Thu, 19 Jan 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=562&view=rev Log Message: ----------- Refactored TInstantSQLQuery class to use the TInstantObjectReferenceList class instead of TObjectList. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas |
From: <sr...@us...> - 2006-01-20 06:18:07
|
Revision: 561 Author: srmitch Date: 2006-01-19 22:17:47 -0800 (Thu, 19 Jan 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=561&view=rev Log Message: ----------- Changes: 1. The IDE menu item "Build Database..." has been changed to "Build InstantObjects Database..."; 2. The BDS IDEs do not have a "Database" Main menu item, so the "&Build InstantObjects Database..." menu item is inserted in the Main View menu item under the "Data Explorer" item if it exists. Otherwise it is appended. Modified Paths: -------------- trunk/Source/Design/InstantModelExpert.pas trunk/Source/Design/InstantModelExplorer.dfm |
From: <sr...@us...> - 2006-01-19 03:22:46
|
Revision: 560 Author: srmitch Date: 2006-01-18 19:22:25 -0800 (Wed, 18 Jan 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=560&view=rev Log Message: ----------- Additional changes that were missed in rev. 558 update for the following: For Model Explorer and ObjectFoundry - 1. Fix for SF Bug 1404242: External Part storage definition. The StorageKindEdit control is not enabled for non-stored ObjectClasses; 2. Non-stored classes are not shown in the ObjectClass dropdown list for Reference or References attribute types; For only ObjectFoundry - 3. The default new attribute type has been changed to Part, which is valid for both embedded and stored ObjectClasses; 4. The attribute type dropdown list now only contains Part, Parts, Reference and References for stored ObjectClasses and only contains Part and Parts for non-stored ObjectClasses; 5. The ObjectClasses dropdown list now only contains the target ObjectClass unless ModelMaker does not provide it. Also added missing Licence Block to OF units. Modified Paths: -------------- trunk/Source/ObjectFoundry/OFClasses.pas trunk/Source/ObjectFoundry/OFExpert.pas |
From: <car...@us...> - 2006-01-18 15:02:26
|
Revision: 559 Author: carlobar Date: 2006-01-18 07:01:52 -0800 (Wed, 18 Jan 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=559&view=rev Log Message: ----------- wrong path for inc file Modified Paths: -------------- trunk/Demos/PrimerCross/Primer.dpr |
From: @users.sourceforge.net - 2006-01-18 07:53:56
|
Revision: 558 Author: Date: ViewCVS: http://svn.sourceforge.net/instantobjects?rev=558&view=rev Log Message: ----------- |
From: @users.sourceforge.net - 2006-01-17 23:44:41
|
Revision: 557 Author: Date: ViewCVS: http://svn.sourceforge.net/instantobjects?rev=557&view=rev Log Message: ----------- |
From: @users.sourceforge.net - 2006-01-17 23:34:32
|
Revision: 556 Author: Date: ViewCVS: http://svn.sourceforge.net/instantobjects?rev=556&view=rev Log Message: ----------- |
From: @users.sourceforge.net - 2006-01-17 23:17:53
|
Revision: 555 Author: Date: ViewCVS: http://svn.sourceforge.net/instantobjects?rev=555&view=rev Log Message: ----------- |
From: @users.sourceforge.net - 2006-01-17 22:49:46
|
Revision: 554 Author: Date: ViewCVS: http://svn.sourceforge.net/instantobjects?rev=554&view=rev Log Message: ----------- |
From: @users.sourceforge.net - 2006-01-17 10:30:50
|
Revision: 553 Author: Date: ViewCVS: http://svn.sourceforge.net/instantobjects?rev=553&view=rev Log Message: ----------- |
From: Nando D. <na...@us...> - 2006-01-17 09:01:10
|
Update of /cvsroot/instantobjects/Source/PackageGroups In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19043/Source/PackageGroups Modified Files: Install.txt Log Message: updated for 2.0 beta 2 Index: Install.txt =================================================================== RCS file: /cvsroot/instantobjects/Source/PackageGroups/Install.txt,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Install.txt 2 Dec 2005 10:59:49 -0000 1.3 --- Install.txt 17 Jan 2006 09:01:02 -0000 1.4 *************** *** 1,8 **** ------------------------------------------------------------------ ! InstantObjects 2.0 Beta 1 (1.9.1.1) for Delphi, Kylix, FPC Mozilla Public License 1.1 Edition ! October 2005 release Based on Seleqt InstantObjects. --- 1,8 ---- ------------------------------------------------------------------ ! InstantObjects 2.0 Beta 2 (1.9.2.1) for Delphi, Kylix, FPC Mozilla Public License 1.1 Edition ! January 2006 release Based on Seleqt InstantObjects. |
From: Nando D. <na...@us...> - 2006-01-17 09:01:10
|
Update of /cvsroot/instantobjects In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19043 Modified Files: Readme1st.txt Log Message: updated for 2.0 beta 2 Index: Readme1st.txt =================================================================== RCS file: /cvsroot/instantobjects/Readme1st.txt,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Readme1st.txt 4 Nov 2005 12:40:31 -0000 1.2 --- Readme1st.txt 17 Jan 2006 09:01:02 -0000 1.3 *************** *** 1,8 **** ------------------------------------------------------------------ ! InstantObjects 2.0 Beta 1 (1.9.1.1) for Delphi, Kylix, FPC Mozilla Public License 1.1 Edition ! November 2005 release Based on Seleqt InstantObjects. --- 1,8 ---- ------------------------------------------------------------------ ! InstantObjects 2.0 Beta 2 (1.9.2.1) for Delphi, Kylix, FPC Mozilla Public License 1.1 Edition ! January 2006 release Based on Seleqt InstantObjects. |