Menu
▾
▴
[Instantobjects-cvscommit] SF.net SVN: instantobjects: [642] trunk/Source/Tests
|
From: <sr...@us...> - 2006-03-10 05:23:21
|
Revision: 642 Author: srmitch Date: 2006-03-09 21:23:01 -0800 (Thu, 09 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=642&view=rev Log Message: ----------- 1. Update of tests suite to be compatible with D5. Need ubMock project files modified for compatibility with D5 to compile and run the tests in D5. 2. Took some tests out of TestInstantReferences.pas unit and put them into a new TestInstantCircularReferences.pas unit. Added a new test to this new unit. Modified Paths: -------------- trunk/Source/Tests/TestIO.dpr trunk/Source/Tests/TestIO.mdr trunk/Source/Tests/TestIO.mdx trunk/Source/Tests/TestIO.res trunk/Source/Tests/TestInstantBlob.pas trunk/Source/Tests/TestInstantClasses.pas trunk/Source/Tests/TestInstantObject.pas trunk/Source/Tests/TestInstantParts.pas trunk/Source/Tests/TestInstantReferences.pas trunk/Source/Tests/TestInstantRtti.pas trunk/Source/Tests/TestInstantString.pas trunk/Source/Tests/TestModel.pas Added Paths: ----------- trunk/Source/Tests/TestInstantCircularReferences.pas Removed Paths: ------------- trunk/Source/Tests/MinimalModel.pas trunk/Source/Tests/TestInstantPersistence.pas trunk/Source/Tests/TestMinimalModelDb.pas trunk/Source/Tests/TestModelDb.pas trunk/Source/Tests/TestSimpleModel.pas trunk/Source/Tests/testcontactdb.pas trunk/Source/Tests/ttestminimalmodel.pas Deleted: trunk/Source/Tests/MinimalModel.pas =================================================================== --- trunk/Source/Tests/MinimalModel.pas 2006-03-10 00:40:50 UTC (rev 641) +++ trunk/Source/Tests/MinimalModel.pas 2006-03-10 05:23:01 UTC (rev 642) @@ -1,111 +0,0 @@ -(* - * InstantObjects Test Suite - * MinimalModel - *) - -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is: InstantObjects Test Suite/MinimalModel - * - * The Initial Developer of the Original Code is: Uberto Barbini - * - * Portions created by the Initial Developer are Copyright (C) 2005 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Steven Mitchell - * - * ***** END LICENSE BLOCK ***** *) - -unit MinimalModel; - -interface - -uses - InstantPersistence; - -type - TSimpleClass = class(TInstantObject) - {IOMETADATA stored 'SIMPLE'; - StringProperty: String(20) stored 'STRING'; } - _StringProperty: TInstantString; - private - function GetStringProperty: string; - procedure SetStringProperty(const Value: string); - published - property StringProperty: string read GetStringProperty write SetStringProperty; - end; - -procedure CreateMinimalModel; - -implementation - -procedure CreateMinimalModel; -var - InstantClassMetadata : TInstantClassMetadata; - InstantAttributeMetadata : TInstantAttributeMetadata; -begin -(* -<TInstantClassMetadatas> - <TInstantClassMetadata> - <Name>TSimpleClass</Name> - <Persistence>peStored</Persistence> - <StorageName>SIMPLE</StorageName> - <AttributeMetadatas> - <TInstantAttributeMetadatas> - <TInstantAttributeMetadata> - <Name>StringProperty</Name> - <AttributeType>atString</AttributeType> - <IsIndexed>FALSE</IsIndexed> - <IsRequired>FALSE</IsRequired> - <Size>10</Size> - <StorageName>STRING</StorageName> - </TInstantAttributeMetadata> - </TInstantAttributeMetadatas> - </AttributeMetadatas> - </TInstantClassMetadata> -</TInstantClassMetadatas> -*) - // An empty InstantModel.ClassMetadatas should already be available - InstantClassMetadata := InstantModel.ClassMetadatas.Add; - InstantClassMetadata.Name := 'TSimpleClass'; - InstantClassMetadata.Persistence := peStored; - InstantClassMetadata.StorageName := 'SIMPLE'; - InstantAttributeMetadata := InstantClassMetadata.AttributeMetadatas.Add; - InstantAttributeMetadata.Name := 'StringProperty'; - InstantAttributeMetadata.AttributeType := atString; - InstantAttributeMetadata.IsIndexed := FALSE; - InstantAttributeMetadata.IsRequired := FALSE; - InstantAttributeMetadata.Size := 10; - InstantAttributeMetadata.StorageName := 'STRING'; -end; - -{ TSimpleClass } - -function TSimpleClass.GetStringProperty: string; -begin - Result := _StringProperty.Value; -end; - -procedure TSimpleClass.SetStringProperty(const Value: string); -begin - _StringProperty.Value := Value; -end; - -initialization - InstantRegisterClasses([ - TSimpleClass - ]); - -end. Modified: trunk/Source/Tests/TestIO.dpr =================================================================== --- trunk/Source/Tests/TestIO.dpr 2006-03-10 00:40:50 UTC (rev 641) +++ trunk/Source/Tests/TestIO.dpr 2006-03-10 05:23:01 UTC (rev 642) @@ -20,8 +20,8 @@ InstantMock in 'InstantMock.pas', TestMockConnector in 'TestMockConnector.pas', TestMockBroker in 'TestMockBroker.pas', + TestModel in 'TestModel.pas', TestInstantMetadata in 'TestInstantMetadata.pas', - TestModel in 'TestModel.pas', TestInstantFieldMetadata in 'TestInstantFieldMetadata.pas', TestInstantClassMetadata in 'TestInstantClassMetadata.pas', TestInstantAttributeMetadata in 'TestInstantAttributeMetadata.pas', @@ -49,7 +49,8 @@ TestInstantCache in 'TestInstantCache.pas', TestInstantObjectStore in 'TestInstantObjectStore.pas', TestInstantParts in 'TestInstantParts.pas', - TestInstantReferences in 'TestInstantReferences.pas'; + TestInstantReferences in 'TestInstantReferences.pas', + TestInstantCircularReferences in 'TestInstantCircularReferences.pas'; {$R *.res} {$R *.mdr} {TestModel} Modified: trunk/Source/Tests/TestIO.mdr =================================================================== (Binary files differ) Modified: trunk/Source/Tests/TestIO.mdx =================================================================== --- trunk/Source/Tests/TestIO.mdx 2006-03-10 00:40:50 UTC (rev 641) +++ trunk/Source/Tests/TestIO.mdx 2006-03-10 05:23:01 UTC (rev 642) @@ -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><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 +<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>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Participants</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Project_Participants</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</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/TestIO.res =================================================================== (Binary files differ) Modified: trunk/Source/Tests/TestInstantBlob.pas =================================================================== --- trunk/Source/Tests/TestInstantBlob.pas 2006-03-10 00:40:50 UTC (rev 641) +++ trunk/Source/Tests/TestInstantBlob.pas 2006-03-10 05:23:01 UTC (rev 642) @@ -143,8 +143,13 @@ procedure TestTInstantBlob.TestAsVariant; begin FInstantBlob.AsVariant := 'NewString'; + {$IFDEF VER130} + AssertEquals('NewString', VarToStr(FInstantBlob.Value)); + AssertEquals('NewString', VarToStr(FInstantBlob.AsVariant)); + {$ELSE} AssertEquals('NewString', FInstantBlob.Value); AssertEquals('NewString', FInstantBlob.AsVariant); + {$ENDIF} end; procedure TestTInstantBlob.TestClear; Added: trunk/Source/Tests/TestInstantCircularReferences.pas =================================================================== --- trunk/Source/Tests/TestInstantCircularReferences.pas (rev 0) +++ trunk/Source/Tests/TestInstantCircularReferences.pas 2006-03-10 05:23:01 UTC (rev 642) @@ -0,0 +1,678 @@ +(* + * InstantObjects Test Suite + * TestInstantReferences + *) + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is: InstantObjects Test Suite/TestInstantCircularReferences + * + * The Initial Developer of the Original Code is: Steven Mitchell + * + * Portions created by the Initial Developer are Copyright (C) 2005 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * + * ***** END LICENSE BLOCK ***** *) + +unit TestInstantCircularReferences; + +interface + +uses fpcunit, InstantMock, InstantPersistence, TestModel; + +type + + // For leak testing, run these tests in conjunction + // with a memory leak test utility. + + TestCircularReferences = class(TTestCase) + private + FConn: TInstantMockConnector; + FInstantReferences: TInstantReferences; + FOwner: TCompany; + public + procedure SetUp; override; + procedure TearDown; override; + 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; + // A -> <- B + // | + // + -> C + // then delete C + procedure TestCircularReferences3; + // A -> B -> C -> A + // | + // + -> D + // then delete D + procedure TestCircularReferences4; + // A -> B -> C -> A + // | + // + -> D -> E + // then delete E + procedure TestCircularReferences5; + // +-> E -> F + // | + // A -> B -> C -> A + // ^ ^ ^ + // +--D-+----+ + procedure TestCircularReferences6; + end; + +implementation + +uses SysUtils, Classes, Windows, testregistry; + +procedure TestCircularReferences.SetUp; +begin + FConn := TInstantMockConnector.Create(nil); + FConn.BrokerClass := TInstantMockBroker; + + if InstantModel.ClassMetadatas.Count > 0 then + InstantModel.ClassMetadatas.Clear; + InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr')); + + FOwner := TCompany.Create(FConn); +end; + +procedure TestCircularReferences.TearDown; +begin + FInstantReferences := nil; + FreeAndNil(FOwner); + InstantModel.ClassMetadatas.Clear; + FreeAndNil(FConn); +end; + +procedure TestCircularReferences.TestAddEmbeddedObject; +var + vReturnValue: Integer; + vReference: TPerson; +begin + FInstantReferences := FOwner._Employees; + + vReference := TPerson.Create(FConn); + try + vReturnValue := FInstantReferences.Add(vReference); + AssertTrue(vReturnValue <> -1); + AssertEquals('FInstantReferences.Count 1', 1, FInstantReferences.Count); + AssertEquals('vReference.RefCount 1', 2, vReference.RefCount); + + vReturnValue := FInstantReferences.Remove(vReference); + AssertTrue(vReturnValue <> -1); + AssertEquals('FInstantReferences.Count 2', 0, FInstantReferences.Count); + AssertEquals('vReference.RefCount 2', 1, vReference.RefCount); + finally + vReference.Free; +// AssertException(EAccessViolation, vReference.Free); + end; +end; + +procedure TestCircularReferences.TestAddExternalObject; +var + vReturnValue: Integer; + vReference: TProject; +begin + FInstantReferences := FOwner._Projects; + + vReference := TProject.Create(FConn); + try + AssertEquals(1, vReference.RefCount); + + vReturnValue := FInstantReferences.Add(vReference); + AssertTrue(vReturnValue <> -1); + AssertEquals('FInstantReferences.Count 1', 1, FInstantReferences.Count); + AssertEquals('vReference.RefCount 1', 2, vReference.RefCount); + + vReturnValue := FInstantReferences.Remove(vReference); + AssertTrue(vReturnValue <> -1); + AssertEquals('FInstantReferences.Count 2', 0, FInstantReferences.Count); + AssertEquals('vReference.RefCount 2', 1, vReference.RefCount); + finally + vReference.Free; +// AssertException(EAccessViolation, vReference.Free); + end; +end; + +// A -> <- B -> C +procedure TestCircularReferences.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 TestCircularReferences.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].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; +// 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 TestCircularReferences.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].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; +// AssertEquals('vPerson.RefCount 2', 1, vPerson.RefCount); +// AssertEquals('vPerson.ReferencedBy.Count 2', 1, vPerson.ReferencedBy.Count); +end; + +// A -> <- B +// | +// + -> C +// then delete C +procedure TestCircularReferences.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 TestCircularReferences.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; + +// A -> B -> C -> A +// | +// + -> D -> E +// then delete E +procedure TestCircularReferences.TestCircularReferences5; +var + vPerson: TPerson; + vProject1: TProject; + vProject2: TProject; + vPerson2: TPerson; +begin + FOwner.Name := 'Owner'; // B + + vPerson := TPerson.Create(FConn); // A + 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); // C + try + AssertNotNull(vProject1); + vProject1.Name := 'vProject1'; + vProject1.Manager := vPerson; + FOwner.AddProject(vProject1); + finally + vProject1.Free; + end; + + vProject2 := TProject.Create(FConn); // D + try + AssertNotNull(vProject2); + vProject2.Name := 'vProject2'; + vPerson2 := TPerson.Create(FConn); // E + 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; + +// +-> E -> F +// | +//A -> B -> C -> A +//^ ^ ^ +//+--D-+----+ +// +//where I observed a disconnection between B and C using +//this sequence of assignment: +// +//VA.RefB := VB; +//VB.RefC := VC; +//VB.RefE := VE; +//VC.RefA := VA; +//VD.RefA := VA; +//VD.RefB := VB; +//VD.RefC := VC; +//VE.RefF := VF; +// +//and this sequence of disposing: +// +//VE.Free; +//VB.Free; +//VA.Free; +//VC.Free; +// +//Test here, VD.RefB.RefC (or VD.RefC, I don't remember) is nil +// +//F.Free; +//D.Free; +procedure TestCircularReferences.TestCircularReferences6; +var + vPerson: TPerson; + vProject1: TProject; + vProject2: TProject; + vPerson2: TPerson; + vCategory: TCategory; +begin + vPerson2 := nil; //E + vProject1 := nil; //C + vProject2 := nil; //D + vCategory := nil; //F + + FOwner.Name := 'Owner'; // B + + vPerson := TPerson.Create(FConn); // A + try + AssertNotNull(vPerson); + vPerson.Name := 'vPerson'; + + // A -> B + vPerson.Employer := FOwner; + AssertNotNull(vPerson.Employer); + AssertEquals('vPerson.Employer.Name A', 'Owner', vPerson.Employer.Name); + + vProject1 := TProject.Create(FConn); // C + AssertNotNull(vProject1); + vProject1.Name := 'vProject1'; + // B -> C + FOwner.AddProject(vProject1); + + vPerson2 := TPerson.Create(FConn); // E + AssertNotNull(vPerson2); + vPerson2.Name := 'vPerson2'; + // B -> E + FOwner.AddEmployee(vPerson2); + + // C -> A + vProject1.Manager := vPerson; + AssertNotNull(vProject1); + + vProject2 := TProject.Create(FConn); // D + AssertNotNull(vProject2); + vProject2.Name := 'vProject2'; + // D -> A + vProject2.AddParticipant(vPerson); + // D -> B + vProject2.Manager := FOwner; + AssertNotNull(vProject2); + AssertNotNull(vProject1); +// // D -> C +// // If the following line is uncommented <-------------- +// // an AV will be raised at runtime <-------------- +// vProject2.AddSubProject(vProject1); + +// vCategory := TCategory.Create(FConn); // F +// AssertNotNull(vCategory); +// vCategory.Name := 'vCategory'; +// // E -> F +// vPerson2.Category := vCategory; + +// AssertEquals('vPerson.RefCount 1', +// 3, vPerson.RefCount); +// AssertEquals('vPerson.ReferencedBy.Count 1', +// 2, vPerson.ReferencedBy.Count); +// +// AssertEquals('FOwner.RefCount 1', +// 3, FOwner.RefCount); +// AssertEquals('FOwner.ReferencedBy.Count 1', +// 2, FOwner.ReferencedBy.Count); +// +// AssertEquals('FOwner.EmployeeCount 1', +// 1, vPerson.Employer.EmployeeCount); +// +// AssertEquals('FOwner.ProjectCount 1', +// 1, FOwner.ProjectCount); +// AssertEquals('vProject1.RefCount 1', +// 3, vProject1.RefCount); +// AssertEquals('vProject1.ReferencedBy.Count 1', +// 1, vProject1.ReferencedBy.Count); +// +// AssertEquals('vPerson2.RefCount 1', +// 2, vPerson2.RefCount); +// AssertEquals('vPerson2.ReferencedBy.Count 1', +// 1, vPerson2.ReferencedBy.Count); +// +// AssertEquals('vCategory.RefCount 1', +// 2, vCategory.RefCount); +// AssertEquals('vCategory.ReferencedBy.Count 1', +// 1, vCategory.ReferencedBy.Count); +// +// AssertEquals('vProject2.RefCount 1', +// 1, vProject2.RefCount); +// AssertEquals('vProject2.ReferencedBy.Count 1', +// 0, vProject2.ReferencedBy.Count); + + finally + vPerson2.Free; //E + FreeAndNil(FOwner); //B + vPerson.Free; //A + vProject1.Free; //C + vCategory.Free; //F + vProject2.Free; //D + end; +end; + + +initialization + // Register any test cases with the test runner +{$IFNDEF CURR_TESTS} + RegisterTests([TestCircularReferences]); +{$ELSE} + RegisterTests([TestCircularReferences]); +{$ENDIF} + +end. + \ No newline at end of file Modified: trunk/Source/Tests/TestInstantClasses.pas =================================================================== --- trunk/Source/Tests/TestInstantClasses.pas 2006-03-10 00:40:50 UTC (rev 641) +++ trunk/Source/Tests/TestInstantClasses.pas 2006-03-10 05:23:01 UTC (rev 642) @@ -268,7 +268,11 @@ {$IFDEF FPC} AssertEquals('1154496E7374616E744775696E6561506967034167650440E20100065765696768740500A873EA6FAE069EFFBF075069674E616D65060B415A617AF2E8ECF92021240000', hs); {$ELSE} + {$IFDEF VER130} + AssertEquals('1154496E7374616E744775696E6561506967034167650440E20100065765696768740500A873EA6FAE069EFFBF075069674E616D65060B415A617AF2E8ECF92021240000', hs); + {$ELSE} AssertEquals('1154496E7374616E744775696E6561506967034167650440E20100065765696768740500A873EA6FAE069EFFBF075069674E616D65140F000000415A617AC3B2C3A8C3ACC3B92021240000', hs); + {$ENDIF} {$ENDIF} c.PigName := ''; c.Age := 0; Modified: trunk/Source/Tests/TestInstantObject.pas =================================================================== --- trunk/Source/Tests/TestInstantObject.pas 2006-03-10 00:40:50 UTC (rev 641) +++ trunk/Source/Tests/TestInstantObject.pas 2006-03-10 05:23:01 UTC (rev 642) @@ -225,7 +225,11 @@ begin vReturnValue := FInstantObject.AttributeByName('Name'); AssertNotNull('Name', vReturnValue); + {$IFDEF VER130} + AssertEquals('Name', 'InitPerson', VarToStr(vReturnValue.Value)); + {$ELSE} AssertEquals('Name', 'InitPerson', vReturnValue.Value); + {$ENDIF} vReturnValue := FInstantObject.AttributeByName('Employer'); AssertNotNull('Employer', vReturnValue); AssertEquals('Employer', 'Employer', vReturnValue.Name); @@ -345,7 +349,11 @@ begin vReturnValue := FInstantObject.FindAttribute('Name'); AssertNotNull('Name', vReturnValue); + {$IFDEF VER130} + AssertEquals('InitPerson', VarToStr(vReturnValue.Value)); + {$ELSE} AssertEquals('InitPerson', vReturnValue.Value); + {$ENDIF} vReturnValue := FInstantObject.FindAttribute('Employer'); AssertNotNull('Employer', vReturnValue); AssertEquals('Employer', 'Employer', vReturnValue.Name); Modified: trunk/Source/Tests/TestInstantParts.pas =================================================================== --- trunk/Source/Tests/TestInstantParts.pas 2006-03-10 00:40:50 UTC (rev 641) +++ trunk/Source/Tests/TestInstantParts.pas 2006-03-10 05:23:01 UTC (rev 642) @@ -652,12 +652,6 @@ RegisterTests([TestTInstantExtParts, TestTinstantEmbParts, TestTInstantParts_Leak]); -{$ELSE} - RegisterTests([ - TestTInstantExtParts, - TestTinstantEmbParts, - TestTInstantParts_Leak - ]); {$ENDIF} end. Deleted: trunk/Source/Tests/TestInstantPersistence.pas =================================================================== --- trunk/Source/Tests/TestInstantPersistence.pas 2006-03-10 00:40:50 UTC (rev 641) +++ trunk/Source/Tests/TestInstantPersistence.pas 2006-03-10 05:23:01 UTC (rev 642) @@ -1,123 +0,0 @@ -(* - * InstantObjects Test Suite - * TestInstantPersistence - *) - -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is: InstantObjects Test Suite/TestInstantPersistence - * - * The Initial Developer of the Original Code is: Uberto Barbini - * - * Portions created by the Initial Developer are Copyright (C) 2005 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * - * ***** END LICENSE BLOCK ***** *) - -unit TestInstantPersistence; - -interface - -uses - Classes, SysUtils, - InstantPersistence, - fpcunit, - testregistry; - -type - - { TTestInstantPersistence } - - TTestInstantPersistence = class(TTestCase) - published - procedure TestMetadatas; - procedure TestInstantAttributeMetadatas; - procedure TestInstantFieldMetadatas; - procedure TestInstantString; - end; - -implementation - - -{ TTestInstantPersistence } - -procedure TTestInstantPersistence.TestMetadatas; -var - i: TInstantMetadata; - c: TInstantMetadatas; -begin - c := TInstantMetadatas.Create(nil, TInstantMetadata); - AssertNotNull(c); - AssertEquals(0, c.Count); - i := c.add as TInstantMetadata; - AssertEquals(1, c.Count); - i.Name := 'pippo'; - AssertTrue(i = c.Find('pippo')); - AssertTrue(i.Collection = c); -end; - -procedure TTestInstantPersistence.TestInstantAttributeMetadatas; -var - i: TInstantAttributeMetadata; - c: TInstantAttributeMetadatas; -begin - c := TInstantAttributeMetadatas.Create(nil); - AssertNotNull(c); - AssertEquals(0, c.Count); - i := c.add; - AssertEquals(1, c.Count); - i.Name := 'pippo'; - i.DefaultValue := '1'; - AssertTrue(i = c.Find('pippo')); - AssertTrue(i.Collection = c); - AssertEquals('1', i.DefaultValue); -end; - -procedure TTestInstantPersistence.TestInstantFieldMetadatas; -var - i: TInstantFieldMetadata; - c: TInstantFieldMetadatas; -begin - c := TInstantFieldMetadatas.Create(nil); - AssertNotNull(c); - AssertEquals(0, c.Count); - i := c.add; - AssertEquals(1, c.Count); - i.Name := 'pippo'; - AssertTrue(i = c.Find('pippo')); - AssertTrue(i.Collection = c); -end; - -procedure TTestInstantPersistence.TestInstantString; -var - c: TInstantString; -begin - c := TInstantString.Create(); - try - AssertFalse(c.IsChanged); - c.AsString := 'goofy'; - AssertTrue(c.IsChanged); - finally - c.Free; - end; -end; - - -initialization - RegisterTests([TTestInstantPersistence]); - -end. Modified: trunk/Source/Tests/TestInstantReferences.pas =================================================================== --- trunk/Source/Tests/TestInstantReferences.pas 2006-03-10 00:40:50 UTC (rev 641) +++ trunk/Source/Tests/TestInstantReferences.pas 2006-03-10 05:23:01 UTC (rev 642) @@ -36,50 +36,6 @@ type - // Use these tests in conjunction with a memory - // leak test utility. - TestTInstantReferences_Leak = class(TTestCase) - private - FConn: TInstantMockConnector; - FInstantReferences: TInstantReferences; - FOwner: TCompany; - public - procedure SetUp; override; - procedure TearDown; override; - - // Emulate the retrieve behavior - // Feb 2006 - IO Beta 2 - // Do not run by default as it crashes - // GUITestRunner with stack overflow. - // Left here for future consideration. - procedure TestCircularReferencesRetrieve; - 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; - // A -> <- B - // | - // + -> C - // then delete C - procedure TestCircularReferences3; - // A -> B -> C -> A - // | - // + -> D - // then delete D - procedure TestCircularReferences4; - // A -> B -> C -> A - // | - // + -> D -> E - // then delete E - procedure TestCircularReferences5; - end; - TestTInstantEmbReferences = class(TTestCase) private FConn: TInstantMockConnector; @@ -144,504 +100,6 @@ uses SysUtils, Classes, testregistry; -procedure TestTInstantReferences_Leak.SetUp; -begin - FConn := TInstantMockConnector.Create(nil); - FConn.BrokerClass := TInstantMockBroker; - - if InstantModel.ClassMetadatas.Count > 0 then - InstantModel.ClassMetadatas.Clear; - InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr')); - - FOwner := TCompany.Create(FConn); -end; - -procedure TestTInstantReferences_Leak.TearDown; -begin - FInstantReferences := nil; - FreeAndNil(FOwner); - InstantModel.ClassMetadatas.Clear; - FreeAndNil(FConn); -end; - -procedure TestTInstantReferences_Leak.TestAddEmbeddedObject; -var - vReturnValue: Integer; - vReference: TPerson; -begin - FInstantReferences := FOwner._Employees; - - vReference := TPerson.Create(FConn); - try - vReturnValue := FInstantReferences.Add(vReference); - AssertTrue(vReturnValue <> -1); - AssertEquals('FInstantReferences.Count 1', 1, FInstantReferences.Count); - AssertEquals('vReference.RefCount 1', 2, vReference.RefCount); - - vReturnValue := FInstantReferences.Remove(vReference); - AssertTrue(vReturnValue <> -1); - AssertEquals('FInstantReferences.Count 2', 0, FInstantReferences.Count); - AssertEquals('vReference.RefCount 2', 1, vReference.RefCount); - finally - vReference.Free; -// AssertException(EAccessViolation, vReference.Free); - end; -end; - -procedure TestTInstantReferences_Leak.TestAddExternalObject; -var - vReturnValue: Integer; - vReference: TProject; -begin - FInstantReferences := FOwner._Projects; - - vReference := TProject.Create(FConn); - try - AssertEquals(1, vReference.RefCount); - - vReturnValue := FInstantReferences.Add(vReference); - AssertTrue(vReturnValue <> -1); - AssertEquals('FInstantReferences.Count 1', 1, FInstantReferences.Count); - AssertEquals('vReference.RefCount 1', 2, vReference.RefCount); - - vReturnValue := FInstantReferences.Remove(vReference); - AssertTrue(vReturnValue <> -1); - AssertEquals('FInstantReferences.Count 2', 0, FInstantReferences.Count); - AssertEquals('vReference.RefCount 2', 1, vReference.RefCount); - finally - vReference.Free; -// AssertException(EAccessViolation, vReference.Free); - 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 - vPr... [truncated message content] |
