Menu
▾
▴
instantobjects-cvscommit — Generates a message for every commit made on CVS
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-04-10 19:13:50
|
Revision: 665 Author: fastbike2 Date: 2006-04-10 11:55:03 -0700 (Mon, 10 Apr 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=665&view=rev Log Message: ----------- Bug Fix [ 1464661 ] TInstantReference.Assign causes AV Check for nil before we try to clone a TInstantReference attribute object. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-04-10 08:31:44 UTC (rev 664) +++ trunk/Source/Core/InstantPersistence.pas 2006-04-10 18:55:03 UTC (rev 665) @@ -6285,7 +6285,12 @@ begin // cross-connector object assignment must be supported for InstantPump. if Self.Connector <> Connector then - Self.Value := Value.Clone(Self.Connector) + begin + if Assigned(Value) then + Self.Value := Value.Clone(Self.Connector) + else + Self.Value := nil; + end else Self.Value := Value; end; |
|
From: <na...@us...> - 2006-04-10 08:32:04
|
Revision: 664 Author: nandod Date: 2006-04-10 01:31:44 -0700 (Mon, 10 Apr 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=664&view=rev Log Message: ----------- * fixed invalida Primer.bdsproj. + new PrimerExternal.bdsproj. Modified Paths: -------------- trunk/Demos/PrimerCross/Primer.bdsproj Added Paths: ----------- trunk/Demos/PrimerCross/PrimerExternal.bdsproj Modified: trunk/Demos/PrimerCross/Primer.bdsproj =================================================================== --- trunk/Demos/PrimerCross/Primer.bdsproj 2006-04-07 21:25:56 UTC (rev 663) +++ trunk/Demos/PrimerCross/Primer.bdsproj 2006-04-10 08:31:44 UTC (rev 664) @@ -1,4 +1,4 @@ -?<?xml version="1.0" encoding="utf-8"?> +<?xml version="1.0" encoding="utf-8"?> <BorlandProject> <PersonalityInfo> <Option> Added: trunk/Demos/PrimerCross/PrimerExternal.bdsproj =================================================================== --- trunk/Demos/PrimerCross/PrimerExternal.bdsproj (rev 0) +++ trunk/Demos/PrimerCross/PrimerExternal.bdsproj 2006-04-10 08:31:44 UTC (rev 664) @@ -0,0 +1,19 @@ +<?xml version="1.0" encoding="utf-8"?> +<BorlandProject> + <PersonalityInfo> + <Option> + <Option Name="Personality">Delphi.Personality</Option> + <Option Name="ProjectType">VCLApplication</Option> + <Option Name="Version">1.0</Option> + <Option Name="GUID">{6DDF3705-1EC1-4B67-8127-F887A4DEB03E}</Option> + </Option> + </PersonalityInfo> + <Delphi.Personality> + <Source> + <Source Name="MainSource">PrimerExternal.dpr</Source> + </Source> + <FileVersion> + <FileVersion Name="Version">7.0</FileVersion> + </FileVersion> + </Delphi.Personality> +</BorlandProject> \ No newline at end of file |
|
From: <fas...@us...> - 2006-04-07 21:26:08
|
Revision: 663 Author: fastbike2 Date: 2006-04-07 14:25:56 -0700 (Fri, 07 Apr 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=663&view=rev Log Message: ----------- [ 1466586 ] Minor Error in Attribute Editor Force the main definition tabsheet to be active before enabling focus of attribute Name or Size edit controls. Modified Paths: -------------- trunk/Source/Design/InstantAttributeEditor.pas Modified: trunk/Source/Design/InstantAttributeEditor.pas =================================================================== --- trunk/Source/Design/InstantAttributeEditor.pas 2006-03-30 22:30:33 UTC (rev 662) +++ trunk/Source/Design/InstantAttributeEditor.pas 2006-04-07 21:25:56 UTC (rev 663) @@ -24,7 +24,7 @@ * the Initial Developer. All Rights Reserved. * * Contributor(s): - * Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Steven Mitchell + * Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Steven Mitchell, David Moorhouse * * ***** END LICENSE BLOCK ***** *) @@ -389,8 +389,9 @@ if (Attribute <> Subject) and SameText(Attribute.Name, Subject.Name) then begin ModalResult := mrNone; + PageControl.ActivePage := DefinitionSheet; NameEdit.SetFocus; - raise Exception.Create('Name already used'); + raise Exception.Create('Attribute Name already used'); end; end; @@ -398,6 +399,7 @@ if not Confirm(SConfirmZeroSizeStringAttribute) then begin ModalResult := mrNone; + PageControl.ActivePage := DefinitionSheet; SizeEdit.SetFocus; Abort; end; |
|
From: <na...@us...> - 2006-03-30 22:30:49
|
Revision: 662 Author: nandod Date: 2006-03-30 14:30:33 -0800 (Thu, 30 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=662&view=rev Log Message: ----------- Tag for IO 2.0 Beta 3 Added Paths: ----------- tags/IO2_BETA3/ Copied: tags/IO2_BETA3 (from rev 661, trunk) |
|
From: <na...@us...> - 2006-03-30 09:34:11
|
Revision: 661 Author: nandod Date: 2006-03-30 01:29:16 -0800 (Thu, 30 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=661&view=rev Log Message: ----------- - Updates for 2.0 Beta 3: Resource files rebuilt. Modified Paths: -------------- trunk/ReleaseTools/InstantVersion.res trunk/Source/Brokers/ADO/D2005/DclIOADO.res trunk/Source/Brokers/ADO/D2005/IOADO.res trunk/Source/Brokers/ADO/D2006/DclIOADO.res trunk/Source/Brokers/ADO/D2006/IOADO.res trunk/Source/Brokers/ADO/D5/DclIOADO_D5.res trunk/Source/Brokers/ADO/D5/IOADO_D5.res trunk/Source/Brokers/ADO/D6/DclIOADO.res trunk/Source/Brokers/ADO/D6/IOADO.res trunk/Source/Brokers/ADO/D7/DclIOADO.res trunk/Source/Brokers/ADO/D7/IOADO.res trunk/Source/Brokers/ADS/D5/DclIOADS_D5.res trunk/Source/Brokers/ADS/D5/ioads_D5.res trunk/Source/Brokers/BDE/D2005/DclIOBDE.res trunk/Source/Brokers/BDE/D2005/IOBDE.res trunk/Source/Brokers/BDE/D2006/DclIOBDE.res trunk/Source/Brokers/BDE/D2006/IOBDE.res trunk/Source/Brokers/BDE/D5/DclIOBDE_D5.res trunk/Source/Brokers/BDE/D5/Iobde_D5.res trunk/Source/Brokers/BDE/D6/DclIOBDE.res trunk/Source/Brokers/BDE/D6/IOBDE.res trunk/Source/Brokers/BDE/D7/DclIOBDE.res trunk/Source/Brokers/BDE/D7/IOBDE.res trunk/Source/Brokers/DBISAM/D6/DclDBISAM.res trunk/Source/Brokers/DBISAM/D6/IODBISAM.res trunk/Source/Brokers/DBISAM/D7/DclDBISAM.res trunk/Source/Brokers/DBISAM/D7/IODBISAM.res trunk/Source/Brokers/DBX/D2005/DclIODBX.res trunk/Source/Brokers/DBX/D2005/IODBX.res trunk/Source/Brokers/DBX/D2006/DclIODBX.res trunk/Source/Brokers/DBX/D2006/IODBX.res trunk/Source/Brokers/DBX/D6/DclIODBX.res trunk/Source/Brokers/DBX/D6/IODBX.res trunk/Source/Brokers/DBX/D7/DclIODBX.res trunk/Source/Brokers/DBX/D7/IODBX.res trunk/Source/Brokers/DBX/K3/DclIODBX.res trunk/Source/Brokers/DBX/K3/IODBX.res trunk/Source/Brokers/FlashFiler/D5/DclIOff_D5.res trunk/Source/Brokers/FlashFiler/D5/ioff_D5.res trunk/Source/Brokers/IBX/D2005/DclIOIBX.res trunk/Source/Brokers/IBX/D2005/IOIBX.res trunk/Source/Brokers/IBX/D2006/DclIOIBX.res trunk/Source/Brokers/IBX/D2006/IOIBX.res trunk/Source/Brokers/IBX/D5/DclIOIBX_D5.res trunk/Source/Brokers/IBX/D5/Ioibx_D5.res trunk/Source/Brokers/IBX/D6/DclIOIBX.res trunk/Source/Brokers/IBX/D6/IOIBX.res trunk/Source/Brokers/IBX/D7/DclIOIBX.res trunk/Source/Brokers/IBX/D7/IOIBX.res trunk/Source/Brokers/NexusDb/D2005/DclIONexusDB.res trunk/Source/Brokers/NexusDb/D2005/IONexusDB.res trunk/Source/Brokers/NexusDb/D2006/DclIONexusDB.res trunk/Source/Brokers/NexusDb/D2006/IONexusDB.res trunk/Source/Brokers/NexusDb/D5/DclIONexusDB_D5.res trunk/Source/Brokers/NexusDb/D5/IONexusDB_D5.res trunk/Source/Brokers/NexusDb/D6/DclIONexusDB.res trunk/Source/Brokers/NexusDb/D6/IONexusDB.res trunk/Source/Brokers/NexusDb/D7/DclIONexusDB.res trunk/Source/Brokers/NexusDb/D7/IONexusDB.res trunk/Source/Brokers/UIB/D2005/DclIOUIB.res trunk/Source/Brokers/UIB/D2005/IOUIB.res trunk/Source/Brokers/UIB/D2006/DclIOUIB.res trunk/Source/Brokers/UIB/D2006/IOUIB.res trunk/Source/Brokers/UIB/D5/DclIOUIB_D5.res trunk/Source/Brokers/UIB/D5/IOUIB_D5.res trunk/Source/Brokers/UIB/D6/DclIOUIB.res trunk/Source/Brokers/UIB/D6/IOUIB.res trunk/Source/Brokers/UIB/D7/DclIOUIB.res trunk/Source/Brokers/UIB/D7/IOUIB.res trunk/Source/Brokers/XML/D2005/DclIOXML.res trunk/Source/Brokers/XML/D2005/IOXML.res trunk/Source/Brokers/XML/D2006/DclIOXML.res trunk/Source/Brokers/XML/D2006/IOXML.res trunk/Source/Brokers/XML/D5/DclIOXML_D5.res trunk/Source/Brokers/XML/D5/Ioxml_D5.res trunk/Source/Brokers/XML/D6/DclIOXML.res trunk/Source/Brokers/XML/D6/IOXML.res trunk/Source/Brokers/XML/D7/DclIOXML.res trunk/Source/Brokers/XML/D7/IOXML.res trunk/Source/Brokers/XML/k3/DclIOXML.res trunk/Source/Brokers/XML/k3/IOXML.res trunk/Source/Brokers/ZeosDBO/D2005/DclIOZeosDBO.res trunk/Source/Brokers/ZeosDBO/D2005/IOZeosDBO.res trunk/Source/Brokers/ZeosDBO/D2006/DclIOZeosDBO.res trunk/Source/Brokers/ZeosDBO/D2006/IOZeosDBO.res trunk/Source/Brokers/ZeosDBO/D5/DclIOZeosDBO_D5.res trunk/Source/Brokers/ZeosDBO/D5/IOZeosDBO_D5.res trunk/Source/Brokers/ZeosDBO/D6/DclIOZeosDBO.res trunk/Source/Brokers/ZeosDBO/D6/IOZeosDBO.res trunk/Source/Brokers/ZeosDBO/D7/DclIOZeosDBO.res trunk/Source/Brokers/ZeosDBO/D7/IOZeosDBO.res trunk/Source/Catalogs/IBFb/D2005/IOIBFbCatalog.res trunk/Source/Catalogs/IBFb/D2006/IOIBFbCatalog.res trunk/Source/Catalogs/IBFb/D5/IOIBFbCatalog_D5.res trunk/Source/Catalogs/IBFb/D6/IOIBFbCatalog.res trunk/Source/Catalogs/IBFb/D7/IOIBFbCatalog.res trunk/Source/Catalogs/IBFb/K3/IOIBFbCatalog.res trunk/Source/Catalogs/MSSql/D2005/IOMSSqlCatalog.res trunk/Source/Catalogs/MSSql/D2006/IOMSSqlCatalog.res trunk/Source/Catalogs/MSSql/D5/IOMSSqlCatalog_D5.res trunk/Source/Catalogs/MSSql/D6/IOMSSqlCatalog.res trunk/Source/Catalogs/MSSql/D7/IOMSSqlCatalog.res trunk/Source/Catalogs/MSSql/K3/IOMSSqlCatalog.res trunk/Source/Core/D2005/IOCore.res trunk/Source/Core/D2006/IOCore.res trunk/Source/Core/D5/IOCore_D5.res trunk/Source/Core/D6/IOCore.res trunk/Source/Core/D7/IOCore.res trunk/Source/Core/K3/IOCore.res trunk/Source/Design/D2005/DclIOCore.res trunk/Source/Design/D2006/DclIOCore.res trunk/Source/Design/D5/DclIOCore_D5.res trunk/Source/Design/D6/DclIOCore.res trunk/Source/Design/D7/DclIOCore.res trunk/Source/Design/K3/DclIOCore.res Modified: trunk/ReleaseTools/InstantVersion.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ADO/D2005/DclIOADO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ADO/D2005/IOADO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ADO/D2006/DclIOADO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ADO/D2006/IOADO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ADO/D5/DclIOADO_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ADO/D5/IOADO_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ADO/D6/DclIOADO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ADO/D6/IOADO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ADO/D7/DclIOADO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ADO/D7/IOADO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ADS/D5/DclIOADS_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ADS/D5/ioads_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/BDE/D2005/DclIOBDE.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/BDE/D2005/IOBDE.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/BDE/D2006/DclIOBDE.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/BDE/D2006/IOBDE.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/BDE/D5/DclIOBDE_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/BDE/D5/Iobde_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/BDE/D6/DclIOBDE.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/BDE/D6/IOBDE.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/BDE/D7/DclIOBDE.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/BDE/D7/IOBDE.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/DBISAM/D6/DclDBISAM.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/DBISAM/D6/IODBISAM.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/DBISAM/D7/DclDBISAM.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/DBISAM/D7/IODBISAM.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/DBX/D2005/DclIODBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/DBX/D2005/IODBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/DBX/D2006/DclIODBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/DBX/D2006/IODBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/DBX/D6/DclIODBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/DBX/D6/IODBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/DBX/D7/DclIODBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/DBX/D7/IODBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/DBX/K3/DclIODBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/DBX/K3/IODBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/FlashFiler/D5/DclIOff_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/FlashFiler/D5/ioff_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/IBX/D2005/DclIOIBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/IBX/D2005/IOIBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/IBX/D2006/DclIOIBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/IBX/D2006/IOIBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/IBX/D5/DclIOIBX_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/IBX/D5/Ioibx_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/IBX/D6/DclIOIBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/IBX/D6/IOIBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/IBX/D7/DclIOIBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/IBX/D7/IOIBX.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/NexusDb/D2005/DclIONexusDB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/NexusDb/D2005/IONexusDB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/NexusDb/D2006/DclIONexusDB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/NexusDb/D2006/IONexusDB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/NexusDb/D5/DclIONexusDB_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/NexusDb/D5/IONexusDB_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/NexusDb/D6/DclIONexusDB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/NexusDb/D6/IONexusDB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/NexusDb/D7/DclIONexusDB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/NexusDb/D7/IONexusDB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/UIB/D2005/DclIOUIB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/UIB/D2005/IOUIB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/UIB/D2006/DclIOUIB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/UIB/D2006/IOUIB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/UIB/D5/DclIOUIB_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/UIB/D5/IOUIB_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/UIB/D6/DclIOUIB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/UIB/D6/IOUIB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/UIB/D7/DclIOUIB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/UIB/D7/IOUIB.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/XML/D2005/DclIOXML.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/XML/D2005/IOXML.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/XML/D2006/DclIOXML.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/XML/D2006/IOXML.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/XML/D5/DclIOXML_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/XML/D5/Ioxml_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/XML/D6/DclIOXML.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/XML/D6/IOXML.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/XML/D7/DclIOXML.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/XML/D7/IOXML.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/XML/k3/DclIOXML.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/XML/k3/IOXML.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ZeosDBO/D2005/DclIOZeosDBO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ZeosDBO/D2005/IOZeosDBO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ZeosDBO/D2006/DclIOZeosDBO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ZeosDBO/D2006/IOZeosDBO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ZeosDBO/D5/DclIOZeosDBO_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ZeosDBO/D5/IOZeosDBO_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ZeosDBO/D6/DclIOZeosDBO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ZeosDBO/D6/IOZeosDBO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ZeosDBO/D7/DclIOZeosDBO.res =================================================================== (Binary files differ) Modified: trunk/Source/Brokers/ZeosDBO/D7/IOZeosDBO.res =================================================================== (Binary files differ) Modified: trunk/Source/Catalogs/IBFb/D2005/IOIBFbCatalog.res =================================================================== (Binary files differ) Modified: trunk/Source/Catalogs/IBFb/D2006/IOIBFbCatalog.res =================================================================== (Binary files differ) Modified: trunk/Source/Catalogs/IBFb/D5/IOIBFbCatalog_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Catalogs/IBFb/D6/IOIBFbCatalog.res =================================================================== (Binary files differ) Modified: trunk/Source/Catalogs/IBFb/D7/IOIBFbCatalog.res =================================================================== (Binary files differ) Modified: trunk/Source/Catalogs/IBFb/K3/IOIBFbCatalog.res =================================================================== (Binary files differ) Modified: trunk/Source/Catalogs/MSSql/D2005/IOMSSqlCatalog.res =================================================================== (Binary files differ) Modified: trunk/Source/Catalogs/MSSql/D2006/IOMSSqlCatalog.res =================================================================== (Binary files differ) Modified: trunk/Source/Catalogs/MSSql/D5/IOMSSqlCatalog_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Catalogs/MSSql/D6/IOMSSqlCatalog.res =================================================================== (Binary files differ) Modified: trunk/Source/Catalogs/MSSql/D7/IOMSSqlCatalog.res =================================================================== (Binary files differ) Modified: trunk/Source/Catalogs/MSSql/K3/IOMSSqlCatalog.res =================================================================== (Binary files differ) Modified: trunk/Source/Core/D2005/IOCore.res =================================================================== (Binary files differ) Modified: trunk/Source/Core/D2006/IOCore.res =================================================================== (Binary files differ) Modified: trunk/Source/Core/D5/IOCore_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Core/D6/IOCore.res =================================================================== (Binary files differ) Modified: trunk/Source/Core/D7/IOCore.res =================================================================== (Binary files differ) Modified: trunk/Source/Core/K3/IOCore.res =================================================================== (Binary files differ) Modified: trunk/Source/Design/D2005/DclIOCore.res =================================================================== (Binary files differ) Modified: trunk/Source/Design/D2006/DclIOCore.res =================================================================== (Binary files differ) Modified: trunk/Source/Design/D5/DclIOCore_D5.res =================================================================== (Binary files differ) Modified: trunk/Source/Design/D6/DclIOCore.res =================================================================== (Binary files differ) Modified: trunk/Source/Design/D7/DclIOCore.res =================================================================== (Binary files differ) Modified: trunk/Source/Design/K3/DclIOCore.res =================================================================== (Binary files differ) |
|
From: <na...@us...> - 2006-03-30 09:27:23
|
Revision: 660 Author: nandod Date: 2006-03-30 01:27:09 -0800 (Thu, 30 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=660&view=rev Log Message: ----------- - Updates for 2.0 Beta 3: Changelog updated. Modified Paths: -------------- trunk/Docs/Changes.txt Modified: trunk/Docs/Changes.txt =================================================================== --- trunk/Docs/Changes.txt 2006-03-30 09:14:58 UTC (rev 659) +++ trunk/Docs/Changes.txt 2006-03-30 09:27:09 UTC (rev 660) @@ -1,6 +1,226 @@ VERSION HISTORY --------------- + +Version 2.0 Beta 3 (1.9.1.3) (2006-03-31) + +- The IDE menu item "Build Database..." has been changed + to "Build InstantObjects Database...". + +- 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. + +- Fixed bug # 1410657, where TInstantSelector.GetIsChanged + fetches all non-retrieved objects looking for changes. + +- Fixed bug #1416083 (Storage Name ignored for external + Part attributes). + +- IBX: Internal transaction now AutoCommits. + Fix for bug 1402383 "Hanging Transactions". + Warning: the bug is not fixed if you use Delphi 5. + +- Fix for Bug 1423157. Parts Attribute Insert causes Error. + +- Fixed Bug 1385748 "Nested calls to Store cause Stack Overflow". + +- Added new public property RefItems to TInstantReferences. + This is an indexed property that returns the + TInstantObjectReference from the internal list, allowing you + to get a list of referenced object IDs without retrieving them. + +- FR # 1424512 - Added fields to enter user name, password, + sql role and character set name to IBX's ConnectionDef form. + InternalCreateDatabase uses current character set to create + physical database. + +- Added fields for user name, password, sql role, character + set and db library name for UIB broker. FR # 1424520. + +- Fixed leakage using TInstantObject instance via interface + pointer. Bug # 1424540. + +- PrimerCross: added ability to refresh grid contents + through the F5 key. + +- Test: minor changes to Model.pas to allow required circular + reference test structures. + +- Added test procedures to TestInstantReferences.pas to + facilitate memory leak testing for object structures + with circular references. + +- 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. + +- Test case to demostrate the infinite loop in + FreeCircularReferences. + +- Many fixes and enhancements in demos and tests. + +- Fixed leakage using TInstantObject instance via interface pointer. + Bug # 1424540. + +- Fixed bug # 1410138 where in some situations a Selector raises + an exception because database component name wasn't uploaded + from stream. + +- Fixed leakages with part and parts attributes in circular + reference check effort. + +- Unsupported column types found in the database no longer stop + the build/evolution process. + +- Fix for bug #1426929. For an application compiled in D2006, + adding entries into a new record in a DbGrid with an attached + Selector results in an application crash (stack overflow) + when trying to tab from the second column. + +- InstantExplorer memory leak resolved (bug n. 1423344). + +- Fix for bug #1423177 - Memory leak handling exceptions. + +- Fix for Bug 1375131: Evolving database with part attributes + causes "Class Not Registered" error when object is retrieved. + +- Changed how packages include resource files: we're back to the + standard approach of one res file per package. + +- Implemented overloaded version of TInstantParts.DestroyObject + and TInstantReferences.DestroyObject that receives a + TInstantObject parameter. + +- Fixed an unwished disconnection inside FreeCircularReference + method. + +- Fixes for ZeosDBO broker and catalog: + - Changed SQLGenerator's drop index for MySQL database, + that doesn't support DROP INDEX statement. Bug # 1434240; + - Built own SQLDelimiter method, because ZeosDBO's method + is available only when database (or at least the driver) + is connected; + - Changed GetDBMSName method to return property value for + disconnected databases; + - Changed physical IB/FB creation to support codepage + parameter (Character Set); + - Fixed evolve error. Bug # 1429529; + - Performed work arounds for MySQL driver (Bug # 1434244) that: + 1. doesn't name Primary Key; + 2. return wrong value for Unique fields (true/false). + +- Fixed AV (bug # 1434585) and leakage (bug # 1434710) inside + TInstantNavigationalQuery. + +- Fixed a leakage with some kinds of circular references. + +- Fixed bug # 1430106. + +- New Remember/Revert mechanism; fixed bugs: + 1232576 Deleting from Selectors without eoAutoApply; + 1410736 Revert method is overriding References attributes; + 1430109 InternalRemoveObject of Exposers doesn't refresh grid; + 1430117 Add/InsertObject (Exposers) with inconsistent behavior; + 1430119 Leakage inserting record; + 1430127 Leakage with InternalCancel and DeferInsert checked; + 1436858 Exposer.AutoDispose disposing referenced object. + +- Fixed Info.Conflict assignment into + TInstantSQLResolver.ExecuteStatement method. + +- Fixed exception into D5 and IBX. + InternalCommit and InternalRollback methods. + +- Fixed bug #1430106 - TInstantBlobAttribute.Assign doesn't work + properly because LoadDataFromStream doesn't clear stream. + +- Fixed bug #1410143 - When an EditForm of a Person with image + that was just edited is opened, Primer raises an exception + with message "Unsupported graphic stream format", "Metafile + is not valid" or "Stream read error". + +- Fix for bug 1437815 - Exposer.RemoveObject messes up TDataSet + data. + +- Fixed bug # 1438840 Exposers with DeferInsert doesn't own object + before store. + +- Implemented Revert buffer for objects removed through + RemoveObject method. + +- Implemented bmp with TGraphicHeader recognition + (bug # 1439017). + +- Fixed bug # 1439025 Apply/RestoreState decrementing StateLevel. + +- Fixed bug # 1436858 Exposer.AutoDispose disposing referenced + object. + +- FR# 1440209 - Pass the object instance to OnGenerateId. + +- Fixed Bug # 1439851 - Required fields not checked in Exposers. + +- Fixed Bug # 1439234 - Params not working with MS Access. + +- Fixed bug # 1439091 - Exposer.AddObject duplicating object + (sorted lists). + +- Implemented Exposer's eoNotDisposeReferences option. + +- Fixed stack overflow due to recursive calls to + IsInsideCircularReference function; + Improvements into circular reference check. + +- 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. + +- Fixed Index out of Bounds error into FreeCircularReference. + +- Fixed bugs [SF #1447789] in InstantRtti.pas related to + compilation and handling of Boolean type in private unit + function AccessProperty. + +- Bug fix [SF #1447794] for ObjectFoundry. + +- Fixed bug [1446833] - Currency fields receives odd values. + +- Update to NexusDB Broker. The modifications mainly apply + to the connection dialog of the Remote server version. + Modifications to the Embedded version were due to + resource string renaming and some extra connection + dialog +button hints. Main changes: + - The default Servername 'NexusDB@localhost' has been removed. + The default is now an empty string. + - There is no longer an initial delay when launching the + connection +dialog as there is no checking of available + NexusDB servers until requested via the 'Load Servers' button. + - The 'Load Servers' speed button has been enlarged and has a + caption to make its function more obvious. + - There is more user feedback in the entry combo boxes to + indicate current status. Popup hints are also available on + the speed buttons. + - A bug fix for enablement of the OK button when using alias + as path entries. + +- Implemented TInstantCustomExposer.Remove method. + +- Implemented eoAutoRemember option. + +- Fixed bug # 1461222 - "ORA-01722: invalid number" with + DBX broker. + +- Many small bug fixes and improvements. + + Version 2.0 Beta 2 (1.9.1.2) (2006-01) - Fixed possible AV in TInstantBrokerCatalog. |
|
From: <na...@us...> - 2006-03-30 09:15:13
|
Revision: 659 Author: nandod Date: 2006-03-30 01:14:58 -0800 (Thu, 30 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=659&view=rev Log Message: ----------- - Fixed bug # 1461222 - "ORA-01722: invalid number" with DBX broker. Modified Paths: -------------- trunk/Source/Brokers/DBX/InstantDBX.pas Modified: trunk/Source/Brokers/DBX/InstantDBX.pas =================================================================== --- trunk/Source/Brokers/DBX/InstantDBX.pas 2006-03-27 11:50:07 UTC (rev 658) +++ trunk/Source/Brokers/DBX/InstantDBX.pas 2006-03-30 09:14:58 UTC (rev 659) @@ -602,8 +602,6 @@ case SourceParam.DataType of ftBoolean: TargetParam.AsString := IntToStr(Integer(SourceParam.AsBoolean)); - ftFloat: - TargetParam.AsString := FloatToStr(SourceParam.AsFloat); ftInteger: TargetParam.AsString := IntToStr(SourceParam.AsInteger); else |
|
From: <jcm...@us...> - 2006-03-27 11:50:15
|
Revision: 658 Author: jcmoraisjr Date: 2006-03-27 03:50:07 -0800 (Mon, 27 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=658&view=rev Log Message: ----------- Rolled back part of the fix for the bug "1424540 Leakage using interfaces", that is raising AVs when class and interface pointers are used together. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-03-23 08:34:36 UTC (rev 657) +++ trunk/Source/Core/InstantPersistence.pas 2006-03-27 11:50:07 UTC (rev 658) @@ -9036,7 +9036,7 @@ begin FreeCircularReferences; Result := DoRelease; - if FRefCount = 1 then + if FRefCount = 0 then try Finit; finally |
|
From: <car...@us...> - 2006-03-23 08:34:45
|
Revision: 657 Author: carlobar Date: 2006-03-23 00:34:36 -0800 (Thu, 23 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=657&view=rev Log Message: ----------- Added DbExpress Corelab Oracle Net driver support Modified Paths: -------------- trunk/Source/Brokers/DBX/InstantDBX.pas Modified: trunk/Source/Brokers/DBX/InstantDBX.pas =================================================================== --- trunk/Source/Brokers/DBX/InstantDBX.pas 2006-03-23 00:44:47 UTC (rev 656) +++ trunk/Source/Brokers/DBX/InstantDBX.pas 2006-03-23 08:34:36 UTC (rev 657) @@ -240,6 +240,8 @@ Result := TInstantDBXOracleBroker.Create(Self) else if SameText(Connection.DriverName, 'Oracle (Core Lab)') then //For CoreLab driver Result := TInstantDBXOracleBroker.Create(Self) + else if SameText(Connection.DriverName, 'Oracle Net (Core Lab)') then //For CoreLab driver + Result := TInstantDBXOracleBroker.Create(Self) else if SameText(Connection.DriverName, 'DB2') then Result := TInstantDBXDB2Broker.Create(Self) else if SameText(Connection.DriverName, 'MySQL') then |
|
From: <jcm...@us...> - 2006-03-23 00:44:55
|
Revision: 656 Author: jcmoraisjr Date: 2006-03-22 16:44:47 -0800 (Wed, 22 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=656&view=rev Log Message: ----------- Implemented 'RaiseException: Boolean' parameter to the InstantFindAttribute function. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas trunk/Source/Core/InstantPresentation.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-03-23 00:42:05 UTC (rev 655) +++ trunk/Source/Core/InstantPersistence.pas 2006-03-23 00:44:47 UTC (rev 656) @@ -2652,7 +2652,7 @@ function InstantDefaultConnector: TInstantConnector; procedure InstantDisableNotifiers; procedure InstantEnableNotifiers; -function InstantFindAttribute(const Path: string; AObject: TInstantObject): TInstantAttribute; +function InstantFindAttribute(const Path: string; AObject: TInstantObject; RaiseExceptions: Boolean = True): TInstantAttribute; function InstantFindClass(const ClassName: string): TInstantObjectClass; function InstantFindClassMetadata(const ClassName: string): TInstantClassMetadata; function InstantGetClass(const ClassName: string): TInstantObjectClass; @@ -2956,8 +2956,8 @@ ObjectNotifiers.Enable; end; -function InstantFindAttribute(const Path: string; - AObject: TInstantObject): TInstantAttribute; +function InstantFindAttribute(const Path: string; AObject: TInstantObject; + RaiseExceptions: Boolean = True): TInstantAttribute; var I: Integer; AttribName: string; @@ -2969,7 +2969,12 @@ AttribName := InstantPartStr(Path, I, InstantDot); while (AttribName <> '') and Assigned(AObject) do begin - Result := AObject.AttributeByName(AttribName); + if RaiseExceptions then + Result := AObject.AttributeByName(AttribName) + else + Result := AObject.FindAttribute(AttribName); + if not Assigned(Result) then + Exit; Inc(I); AttribName := InstantPartStr(Path, I, InstantDot); if (AttribName <> '') and (Result is TInstantElement) then Modified: trunk/Source/Core/InstantPresentation.pas =================================================================== --- trunk/Source/Core/InstantPresentation.pas 2006-03-23 00:42:05 UTC (rev 655) +++ trunk/Source/Core/InstantPresentation.pas 2006-03-23 00:44:47 UTC (rev 656) @@ -1689,11 +1689,8 @@ if Assigned(FSubject) and Assigned(AField) and (FindFieldIndex(AField) = -1) then begin VAttr := nil; - try - if FSubject is TInstantObject then - VAttr := InstantFindAttribute(AField.FieldName, TInstantObject(FSubject)); - except - end; + if FSubject is TInstantObject then + VAttr := InstantFindAttribute(AField.FieldName, TInstantObject(FSubject), False); if Assigned(VAttr) then VarClear(VProperty) else |
|
From: <jcm...@us...> - 2006-03-23 00:42:16
|
Revision: 655 Author: jcmoraisjr Date: 2006-03-22 16:42:05 -0800 (Wed, 22 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=655&view=rev Log Message: ----------- - Fixed bug # 1456595 - "RepositionObject method can include fields"; - Small improvements into revert buffer mechanism; - Fixed the patch to the bug # 1439091 - "Exposer.AddObject duplicating object (sorted lists)", that wasn't refreshing Query views. Modified Paths: -------------- trunk/Source/Core/InstantPresentation.pas Modified: trunk/Source/Core/InstantPresentation.pas =================================================================== --- trunk/Source/Core/InstantPresentation.pas 2006-03-17 20:51:19 UTC (rev 654) +++ trunk/Source/Core/InstantPresentation.pas 2006-03-23 00:42:05 UTC (rev 655) @@ -1460,8 +1460,9 @@ begin if Altered then begin - RemoveFromView(AObject); - Result := AddToView(AObject); + Result := RemoveFromView(AObject); + if Result >= 0 then + Result := AddToView(AObject); end else Result := -1; end; @@ -1765,11 +1766,9 @@ if not AutoApplyChanges then for I := 0 to Pred(RecordBufferCount) do with RecordBuffer[I] do - if (UpdateStatus = usDeleted) and - Assigned(DeletedObjectInstance) and DeletedObjectWasDisposed then - with DeletedObjectInstance do - if CanDispose then - Dispose; + if (UpdateStatus = usDeleted) and DeletedObjectWasDisposed and + DeletedObjectInstance.CanDispose then + DeletedObjectInstance.Dispose; end; function TInstantContentBuffer.FindRecordBuffer(AObject: TObject): TInstantRecordBuffer; @@ -1785,10 +1784,9 @@ function TInstantContentBuffer.FindRecordBufferIndex(AObject: TObject): Integer; begin - if AObject is TInstantObject then - for Result := 0 to Pred(RecordBufferCount) do - if RecordBuffer[Result].Subject = AObject then - Exit; + for Result := 0 to Pred(RecordBufferCount) do + if RecordBuffer[Result].Subject = AObject then + Exit; Result := -1; end; @@ -1888,6 +1886,7 @@ ARecordBuffer.UndoChanges; if AutoApplyChanges and (ARecordBuffer.Subject is TInstantObject) then TInstantObject(ARecordBuffer.Subject).Store; + AExposer.Accessor.RepositionObject(ARecordBuffer.Subject); // Friend class end; procedure RevertInserted(ARecordBuffer: TInstantRecordBuffer); @@ -1913,12 +1912,11 @@ else AExposer.InternalInsertObject(DeletedObjectRecNo, DeletedObjectInstance); // Friend class - if AutoApplyChanges and DeletedObjectWasDisposed and - (DeletedObjectInstance is TInstantObject) then + if AutoApplyChanges and DeletedObjectWasDisposed then begin if AExposer is TInstantSelector then // TInstantQuery - TheObject.Store is enough - TInstantObject(DeletedObjectInstance).Store + DeletedObjectInstance.Store else // TInstantParts or TInstantRefereces - need to call Subject.Store SubjectChanged := True; @@ -3912,16 +3910,15 @@ finally List.Free; end; + if State in [dsEdit, dsInsert] then + Cancel; if InContent and Assigned(FContentBuffer) then begin FContentBuffer.RevertChanges(Self); FreeAndNil(FContentBuffer); FContentChanged := False; end else if not InContent then - begin - Undo; RefreshDataView; - end; end; procedure TInstantCustomExposer.SaveField(Field: TField); @@ -4465,8 +4462,16 @@ function TInstantQueryAccessor.InternalAddObject( AObject: TObject): Integer; +var + Index: Integer; begin Result := Subject.AddObject(AObject); + if Altered then + begin + Index := AddToView(AObject); + if Index > -1 then + Result := Index; + end; end; procedure TInstantQueryAccessor.InternalApplyChanges; @@ -4504,6 +4509,8 @@ AObject: TObject): Integer; begin Subject.InsertObject(Index, AObject); + if Altered then + InsertInView(Index, AObject); Result := Index; end; @@ -4519,8 +4526,16 @@ function TInstantQueryAccessor.InternalRemoveObject( AObject: TObject): Integer; +var + Index: Integer; begin Result := Subject.RemoveObject(AObject); + if Altered then + begin + Index := RemoveFromView(AObject); + if Index > -1 then + Result := Index; + end; end; class function TInstantQueryAccessor.SubjectClass: TClass; |
|
From: <jcm...@us...> - 2006-03-17 20:51:33
|
Revision: 654 Author: jcmoraisjr Date: 2006-03-17 12:51:19 -0800 (Fri, 17 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=654&view=rev Log Message: ----------- Fixed a possible AV source into the last revision. Modified Paths: -------------- trunk/Source/Core/InstantPresentation.pas Modified: trunk/Source/Core/InstantPresentation.pas =================================================================== --- trunk/Source/Core/InstantPresentation.pas 2006-03-17 20:35:48 UTC (rev 653) +++ trunk/Source/Core/InstantPresentation.pas 2006-03-17 20:51:19 UTC (rev 654) @@ -1906,6 +1906,7 @@ procedure RevertDeleted(ARecordBuffer: TInstantRecordBuffer); begin with ARecordBuffer do + if Assigned(DeletedObjectInstance) then begin if DeletedObjectRecNo > AExposer.ObjectCount then AExposer.InternalAddObject(DeletedObjectInstance) // Friend class |
|
From: <jcm...@us...> - 2006-03-17 20:35:58
|
Revision: 653 Author: jcmoraisjr Date: 2006-03-17 12:35:48 -0800 (Fri, 17 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=653&view=rev Log Message: ----------- Changed TInstantRecordBuffer and TInstantContentBuffer to support all published properties, with or without an attribute, as well as other classes beyond TInstantObject. Modified Paths: -------------- trunk/Source/Core/InstantPresentation.pas Modified: trunk/Source/Core/InstantPresentation.pas =================================================================== --- trunk/Source/Core/InstantPresentation.pas 2006-03-16 21:44:48 UTC (rev 652) +++ trunk/Source/Core/InstantPresentation.pas 2006-03-17 20:35:48 UTC (rev 653) @@ -199,6 +199,7 @@ Field: TField; Attribute: TInstantAttribute; ClonedAttr: TInstantAttribute; + PropertyValue: Variant; end; TInstantContentBuffer = class; @@ -208,7 +209,7 @@ FDeletedObjectBM: TInstantDeletedObjectBookmark; FFieldBufferList: TList; FOwner: TInstantContentBuffer; - FSubject: TInstantObject; + FSubject: TObject; FUpdateStatus: TUpdateStatus; procedure FreeFieldBufferList; function GetDeletedObjectInstance: TInstantObject; @@ -235,7 +236,7 @@ property FieldBuffer[AIndex: Integer]: PInstantFieldBuffer read GetFieldBuffer; property FieldBufferCount: Integer read GetFieldBufferCount; property IsChanged: Boolean read GetIsChanged; - property Subject: TInstantObject read FSubject; + property Subject: TObject read FSubject; property UpdateStatus: TUpdateStatus read FUpdateStatus; end; @@ -1562,10 +1563,10 @@ constructor TInstantRecordBuffer.Create(AObject: TObject; AOwner: TInstantContentBuffer); begin inherited Create; - if AObject is TInstantObject then - FSubject := TInstantObject(AObject); + FSubject := AObject; FOwner := AOwner; FUpdateStatus := usUnmodified; + FDeletedObjectBM.Instance := nil; end; destructor TInstantRecordBuffer.Destroy; @@ -1651,14 +1652,15 @@ if UpdateStatus <> usInserted then begin FDeletedObjectBM.RecNo := ARecNo; - FDeletedObjectBM.Instance.Free; - if AAutoApplyChanges and ADispose then - FDeletedObjectBM.Instance := Subject.Clone - else - begin - FDeletedObjectBM.Instance := Subject; - Subject.AddRef; - end; + FreeAndNil(FDeletedObjectBM.Instance); + if Subject is TInstantObject then + if AAutoApplyChanges and ADispose then + FDeletedObjectBM.Instance := TInstantObject(Subject).Clone + else + begin + FDeletedObjectBM.Instance := TInstantObject(Subject); + FDeletedObjectBM.Instance.AddRef; + end; FDeletedObjectBM.WasDisposed := ADispose; FUpdateStatus := usDeleted; end else @@ -1681,20 +1683,39 @@ var VFieldBuffer: PInstantFieldBuffer; VAttr: TInstantAttribute; + VProperty: Variant; begin - if not Assigned(FSubject) or - not Assigned(AField) or (FindFieldIndex(AField) >= 0) then - Exit; - VAttr := InstantFindAttribute(AField.FieldName, FSubject); - if Assigned(VAttr) then + if Assigned(FSubject) and Assigned(AField) and (FindFieldIndex(AField) = -1) then begin + VAttr := nil; + try + if FSubject is TInstantObject then + VAttr := InstantFindAttribute(AField.FieldName, TInstantObject(FSubject)); + except + end; + if Assigned(VAttr) then + VarClear(VProperty) + else + VProperty := InstantGetProperty(FSubject, AField.FieldName); + New(VFieldBuffer); - VFieldBuffer.Field := AField; - VFieldBuffer.Attribute := VAttr; - VFieldBuffer.ClonedAttr := - TInstantAttributeClass(VAttr.ClassType).Create(nil, nil); - VFieldBuffer.ClonedAttr.Assign(VAttr); - FieldBufferList.Add(VFieldBuffer); + VFieldBuffer.ClonedAttr := nil; + try + VFieldBuffer.Field := AField; + VFieldBuffer.Attribute := VAttr; + if Assigned(VAttr) then + begin + VFieldBuffer.ClonedAttr := + TInstantAttributeClass(VAttr.ClassType).Create(nil, nil); + VFieldBuffer.ClonedAttr.Assign(VAttr); + end; + VFieldBuffer.PropertyValue := VProperty; + FieldBufferList.Add(VFieldBuffer); + except + FreeAndNil(VFieldBuffer.ClonedAttr); + Dispose(VFieldBuffer); + raise; + end; if UpdateStatus = usUnmodified then FUpdateStatus := usModified; end; @@ -1708,7 +1729,10 @@ begin for I := Pred(FieldBufferCount) downto 0 do with FieldBuffer[I]^ do - Attribute.Assign(ClonedAttr); + if Assigned(Attribute) then + Attribute.Assign(ClonedAttr) + else if not VarIsEmpty(PropertyValue) and not VarIsNull(PropertyValue) then + InstantSetProperty(FSubject, Field.FieldName, PropertyValue); FreeFieldBufferList; FUpdateStatus := usUnmodified; end; @@ -1740,11 +1764,12 @@ begin if not AutoApplyChanges then for I := 0 to Pred(RecordBufferCount) do - if (RecordBuffer[I].UpdateStatus = usDeleted) and - RecordBuffer[I].DeletedObjectWasDisposed then - with RecordBuffer[I].DeletedObjectInstance do - if CanDispose then - Dispose; + with RecordBuffer[I] do + if (UpdateStatus = usDeleted) and + Assigned(DeletedObjectInstance) and DeletedObjectWasDisposed then + with DeletedObjectInstance do + if CanDispose then + Dispose; end; function TInstantContentBuffer.FindRecordBuffer(AObject: TObject): TInstantRecordBuffer; @@ -1861,15 +1886,16 @@ procedure RevertModified(ARecordBuffer: TInstantRecordBuffer); begin ARecordBuffer.UndoChanges; - if AutoApplyChanges then - ARecordBuffer.Subject.Store; + if AutoApplyChanges and (ARecordBuffer.Subject is TInstantObject) then + TInstantObject(ARecordBuffer.Subject).Store; end; procedure RevertInserted(ARecordBuffer: TInstantRecordBuffer); begin - if AutoApplyChanges and (AExposer is TInstantSelector) then + if AutoApplyChanges and (ARecordBuffer.Subject is TInstantObject) and + (AExposer is TInstantSelector) then // Only Selectors can AutoStore new objects - ARecordBuffer.Subject.Dispose; + TInstantObject(ARecordBuffer.Subject).Dispose; AExposer.InternalRemoveObject(ARecordBuffer.Subject); // Friend class AExposer.Resync([]); end; @@ -1886,11 +1912,12 @@ else AExposer.InternalInsertObject(DeletedObjectRecNo, DeletedObjectInstance); // Friend class - if AutoApplyChanges and DeletedObjectWasDisposed then + if AutoApplyChanges and DeletedObjectWasDisposed and + (DeletedObjectInstance is TInstantObject) then begin if AExposer is TInstantSelector then // TInstantQuery - TheObject.Store is enough - DeletedObjectInstance.Store + TInstantObject(DeletedObjectInstance).Store else // TInstantParts or TInstantRefereces - need to call Subject.Store SubjectChanged := True; @@ -1913,8 +1940,8 @@ else ; end; - if SubjectChanged then - (AExposer.Subject as TInstantObject).Store; + if SubjectChanged and (AExposer.Subject is TInstantObject) then + TInstantObject(AExposer.Subject).Store; FreeRecordBufferList; end; |
|
From: <sr...@us...> - 2006-03-16 21:44:56
|
Revision: 652 Author: srmitch Date: 2006-03-16 13:44:48 -0800 (Thu, 16 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=652&view=rev Log Message: ----------- Fix to NexusDB Broker for compile failure: 1. Added terminating semicolon to end of Interface uses clause in InstantNexusDB.pas. Modified Paths: -------------- trunk/Source/Brokers/NexusDb/InstantNexusDB.pas Modified: trunk/Source/Brokers/NexusDb/InstantNexusDB.pas =================================================================== --- trunk/Source/Brokers/NexusDb/InstantNexusDB.pas 2006-03-15 08:18:07 UTC (rev 651) +++ trunk/Source/Brokers/NexusDb/InstantNexusDB.pas 2006-03-16 21:44:48 UTC (rev 652) @@ -44,7 +44,7 @@ Windows, {$ENDIF} Classes, DB, InstantPersistence, InstantCommand, - nxptBasePooledTransport, nxsdServerEngine, nxdb, nxsdDataDictionary + nxptBasePooledTransport, nxsdServerEngine, nxdb, nxsdDataDictionary; type TNexusDBTable = class(TnxTable) |
|
From: <sr...@us...> - 2006-03-15 08:18:12
|
Revision: 651 Author: srmitch Date: 2006-03-15 00:18:07 -0800 (Wed, 15 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=651&view=rev Log Message: ----------- Update to unit tests: 1. Tidied up circular reference tests in TestInstantCircularReferences.pas. Modified Paths: -------------- trunk/Source/Tests/TestInstantCircularReferences.pas Modified: trunk/Source/Tests/TestInstantCircularReferences.pas =================================================================== --- trunk/Source/Tests/TestInstantCircularReferences.pas 2006-03-15 02:49:38 UTC (rev 650) +++ trunk/Source/Tests/TestInstantCircularReferences.pas 2006-03-15 08:18:07 UTC (rev 651) @@ -43,7 +43,7 @@ private FConn: TInstantMockConnector; FInstantReferences: TInstantReferences; - FOwner: TCompany; + FCompany: TCompany; public procedure SetUp; override; procedure TearDown; override; @@ -106,13 +106,13 @@ InstantModel.ClassMetadatas.Clear; InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr')); - FOwner := TCompany.Create(FConn); + FCompany := TCompany.Create(FConn); end; procedure TestCircularReferences.TearDown; begin FInstantReferences := nil; - FreeAndNil(FOwner); + FreeAndNil(FCompany); InstantModel.ClassMetadatas.Clear; FreeAndNil(FConn); end; @@ -122,7 +122,7 @@ vReturnValue: Integer; vReference: TPerson; begin - FInstantReferences := FOwner._Employees; + FInstantReferences := FCompany._Employees; vReference := TPerson.Create(FConn); try @@ -137,7 +137,6 @@ AssertEquals('vReference.RefCount 2', 1, vReference.RefCount); finally vReference.Free; -// AssertException(EAccessViolation, vReference.Free); end; end; @@ -146,7 +145,7 @@ vReturnValue: Integer; vReference: TProject; begin - FInstantReferences := FOwner._Projects; + FInstantReferences := FCompany._Projects; vReference := TProject.Create(FConn); try @@ -163,7 +162,6 @@ AssertEquals('vReference.RefCount 2', 1, vReference.RefCount); finally vReference.Free; -// AssertException(EAccessViolation, vReference.Free); end; end; @@ -173,48 +171,49 @@ vPerson1: TPerson; vCategory: TCategory; begin - FOwner.Name := 'Owner'; + //FCompany is A - vPerson1 := TPerson.Create(FConn); + vPerson1 := TPerson.Create(FConn); // B try AssertNotNull(vPerson1); - vPerson1.Name := 'vPerson1'; - - vPerson1.EmployBy(FOwner); + // B -> A + vPerson1.Employer := FCompany; AssertNotNull(vPerson1.Employer); - AssertEquals('vPerson1.Employer.Name A', 'Owner', vPerson1.Employer.Name); + // A -> B + FCompany.AddEmployee(vPerson1); + AssertEquals('FCompany.EmployeeCount A', 1, FCompany.EmployeeCount); finally - vPerson1.Free; + vPerson1.Free; // B end; - AssertEquals('FOwner.RefCount 1', 2, FOwner.RefCount); - AssertEquals('FOwner.RefByCount 1', 1, FOwner.RefByCount); - AssertEquals('FOwner.EmployeeCount 1', 1, FOwner.EmployeeCount); - AssertEquals('FOwner.Employees[0].RefCount 1', - 1, FOwner.Employees[0].RefCount); - AssertEquals('FOwner.Employees[0].RefByCount 1', - 1, FOwner.Employees[0].RefByCount); + AssertEquals('FCompany.RefCount 1', 2, FCompany.RefCount); + AssertEquals('FCompany.RefByCount 1', 1, FCompany.RefByCount); + AssertEquals('FCompany.EmployeeCount 1', 1, FCompany.EmployeeCount); + AssertEquals('FCompany.Employees[0].RefCount 1', + 1, FCompany.Employees[0].RefCount); + AssertEquals('FCompany.Employees[0].RefByCount 1', + 1, FCompany.Employees[0].RefByCount); - vCategory := TCategory.Create(FConn); + vCategory := TCategory.Create(FConn); // C try AssertNotNull(vCategory); - vCategory.Name := 'vCategory'; - - FOwner.Employees[0].Category := vCategory; + // B -> C + FCompany.Employees[0].Category := vCategory; + AssertNotNull(FCompany.Employees[0].Category); finally - vCategory.Free; + vCategory.Free; // C end; - AssertEquals('FOwner.RefCount 2', 2, FOwner.RefCount); - AssertEquals('FOwner.RefByCount 2', 1, FOwner.RefByCount); + AssertEquals('FCompany.RefCount 2', 2, FCompany.RefCount); + AssertEquals('FCompany.RefByCount 2', 1, FCompany.RefByCount); - AssertEquals('FOwner.Employees[0].RefCount 2', - 1, FOwner.Employees[0].RefCount); - AssertEquals('FOwner.Employees[0].RefByCount 2', - 1, FOwner.Employees[0].RefByCount); + AssertEquals('FCompany.Employees[0].RefCount 2', + 1, FCompany.Employees[0].RefCount); + AssertEquals('FCompany.Employees[0].RefByCount 2', + 1, FCompany.Employees[0].RefByCount); - AssertEquals('FOwner.Employees[0].Category.RefCount 1', - 1, FOwner.Employees[0].Category.RefCount); - AssertEquals('FOwner.Employees[0].Category.RefByCount 1', - 1, FOwner.Employees[0].Category.RefByCount); + AssertEquals('FCompany.Employees[0].Category.RefCount 1', + 1, FCompany.Employees[0].Category.RefCount); + AssertEquals('FCompany.Employees[0].Category.RefByCount 1', + 1, FCompany.Employees[0].Category.RefByCount); end; // A -> B {Parts}-> C -> A @@ -224,27 +223,30 @@ vProject: TProject; vAddress: TExternalAddress; begin - vPerson := TPerson.Create(FConn); + vPerson := TPerson.Create(FConn); // A try AssertNotNull(vPerson); - vPerson.Name := 'vPerson1'; - vProject := TProject.Create(FConn); + vProject := TProject.Create(FConn); // B try AssertNotNull(vProject); - vProject.Name := 'vProject1'; - vAddress := TExternalAddress.Create(FConn); + vAddress := TExternalAddress.Create(FConn); // C try AssertNotNull(vAddress); + // C -> A vAddress.Site_Contact := vPerson; - AssertEquals('vPerson1', vAddress.Site_Contact.Name); + AssertNotNull(vAddress.Site_Contact); + // B -> C vProject.AddAddress(vAddress); + AssertEquals('vProject.AddressCount 1', 1, vProject.AddressCount); except - vAddress.Free; + vAddress.Free; // C end; + // A -> B vPerson.AddProject(vProject); + AssertEquals('vPerson.ProjectCount 1', 1, vPerson.ProjectCount); finally - vProject.Free; + vProject.Free; // B end; AssertEquals('vPerson.RefCount 1', 2, vPerson.RefCount); AssertEquals('vPerson.RefByCount 1', 1, vPerson.RefByCount); @@ -256,10 +258,8 @@ AssertEquals('vPerson.Projects[0].Addresses[0].RefByCount', 0, vPerson.Projects[0].Addresses[0].RefByCount); finally - vPerson.Free; + vPerson.Free; // A end; -// AssertEquals('vPerson.RefCount 2', 1, vPerson.RefCount); -// AssertEquals('vPerson.RefByCount 2', 1, vPerson.RefByCount); end; // A -> B {Parts}-> C {Parts}-> D -> A @@ -270,36 +270,43 @@ vSubProject: TProject; vAddress: TExternalAddress; begin - vPerson := TPerson.Create(FConn); + vPerson := TPerson.Create(FConn); // A try AssertNotNull(vPerson); - vPerson.Name := 'vPerson'; - vProject := TProject.Create(FConn); + vProject := TProject.Create(FConn); // B try AssertNotNull(vProject); - vProject.Name := 'vProject'; - vSubProject := TProject.Create(FConn); + vSubProject := TProject.Create(FConn); // C try - vAddress := TExternalAddress.Create(FConn); + AssertNotNull(vSubProject); + vAddress := TExternalAddress.Create(FConn); // D try AssertNotNull(vAddress); + // D -> A vAddress.Site_Contact := vPerson; - AssertEquals('vPerson', vAddress.Site_Contact.Name); + AssertNotNull(vAddress.Site_Contact); + // C -> D vSubProject.AddAddress(vAddress); + AssertEquals('vSubProject.AddressCount 1', + 1, vSubProject.AddressCount); except - vAddress.Free; + vAddress.Free; // D raise; end; + // B -> C vProject.AddSubProject(vSubProject); + AssertEquals('vProject.SubProjectCount 1', 1, vProject.SubProjectCount); except - vSubProject.Free; + vSubProject.Free; // C raise; end; + // A -> B vPerson.AddProject(vProject); + AssertEquals('vPerson.ProjectCount 1', 1, vPerson.ProjectCount); finally - vProject.Free; + vProject.Free; // B end; AssertEquals('vPerson.RefCount 1', 2, vPerson.RefCount); AssertEquals('vPerson.RefByCount 1', 1, vPerson.RefByCount); @@ -321,8 +328,6 @@ finally vPerson.Free; end; -// AssertEquals('vPerson.RefCount 2', 1, vPerson.RefCount); -// AssertEquals('vPerson.RefByCount 2', 1, vPerson.RefByCount); end; // A -> <- B @@ -334,53 +339,53 @@ vPerson1: TPerson; vPerson2: TPerson; begin - FOwner.Name := 'Owner'; + // FCompany is A - vPerson1 := TPerson.Create(FConn); + vPerson1 := TPerson.Create(FConn); // B try AssertNotNull(vPerson1); - vPerson1.Name := 'vPerson1'; - - vPerson1.EmployBy(FOwner); + // B -> A + vPerson1.Employer := FCompany; AssertNotNull(vPerson1.Employer); - AssertEquals('vPerson1.Employer.Name A', 'Owner', vPerson1.Employer.Name); + // A -> B + FCompany.AddEmployee(vPerson1); + AssertEquals('FCompany.EmployeeCount 1', 1, FCompany.EmployeeCount); finally - vPerson1.Free; + vPerson1.Free; // B end; - AssertEquals('FOwner.RefCount 1', 2, FOwner.RefCount); - AssertEquals('FOwner.RefByCount 1', 1, FOwner.RefByCount); - AssertEquals('FOwner.EmployeeCount 1', 1, FOwner.EmployeeCount); - AssertEquals('FOwner.Employees[0].RefCount 1', - 1, FOwner.Employees[0].RefCount); - AssertEquals('FOwner.Employees[0].RefByCount 1', - 1, FOwner.Employees[0].RefByCount); + AssertEquals('FCompany.RefCount 1', 2, FCompany.RefCount); + AssertEquals('FCompany.RefByCount 1', 1, FCompany.RefByCount); + AssertEquals('FCompany.EmployeeCount 2', 1, FCompany.EmployeeCount); + AssertEquals('FCompany.Employees[0].RefCount 1', + 1, FCompany.Employees[0].RefCount); + AssertEquals('FCompany.Employees[0].RefByCount 1', + 1, FCompany.Employees[0].RefByCount); - vPerson2 := TPerson.Create(FConn); + vPerson2 := TPerson.Create(FConn); // C try AssertNotNull(vPerson2); - vPerson2.Name := 'vPerson2'; - - FOwner.AddEmployee(vPerson2); - AssertNull(vPerson2.Employer); + // A -> C + FCompany.AddEmployee(vPerson2); + AssertEquals('FCompany.EmployeeCount 3', 2, FCompany.EmployeeCount); finally - vPerson2.Free; + vPerson2.Free; // C end; - AssertEquals('FOwner.RefCount 1', 2, FOwner.RefCount); - AssertEquals('FOwner.RefByCount 1', 1, FOwner.RefByCount); + AssertEquals('FCompany.RefCount 2', 2, FCompany.RefCount); + AssertEquals('FCompany.RefByCount 2', 1, FCompany.RefByCount); - AssertEquals('FOwner.EmployeeCount', 2, FOwner.EmployeeCount); - AssertEquals('FOwner.Employees[1].RefCount 1', - 1, FOwner.Employees[1].RefCount); - AssertEquals('FOwner.Employees[1].RefByCount 1', - 1, FOwner.Employees[1].RefByCount); + AssertEquals('FCompany.EmployeeCount 4', 2, FCompany.EmployeeCount); + AssertEquals('FCompany.Employees[1].RefCount 1', + 1, FCompany.Employees[1].RefCount); + AssertEquals('FCompany.Employees[1].RefByCount 1', + 1, FCompany.Employees[1].RefByCount); - FOwner.DeleteEmployee(1); - AssertEquals('FOwner.EmployeeCount', 1, FOwner.EmployeeCount); + FCompany.DeleteEmployee(1); + AssertEquals('FCompany.EmployeeCount 5', 1, FCompany.EmployeeCount); end; // A -> B -> C -> A -// | -// + -> D +// | +// + -> D // then delete D procedure TestCircularReferences.TestCircularReferences4; var @@ -388,38 +393,39 @@ vProject1: TProject; vProject2: TProject; begin - FOwner.Name := 'Owner'; + // FCompany is B - vPerson := TPerson.Create(FConn); + vPerson := TPerson.Create(FConn); // A try AssertNotNull(vPerson); - vPerson.Name := 'vPerson'; - - vPerson.EmployBy(FOwner); + // A -> B + vPerson.Employer := FCompany; AssertNotNull(vPerson.Employer); - AssertEquals('vPerson.Employer.Name A', 'Owner', vPerson.Employer.Name); - FOwner.DeleteEmployee(0); - vProject1 := TProject.Create(FConn); + vProject1 := TProject.Create(FConn); // C try AssertNotNull(vProject1); - vProject1.Name := 'vProject1'; + // C -> A vProject1.Manager := vPerson; - FOwner.AddProject(vProject1); + AssertNotNull(vProject1.Manager); + // B -> C + FCompany.AddProject(vProject1); + AssertEquals('FCompany.ProjectCount 1', 1, FCompany.ProjectCount); finally - vProject1.Free; + vProject1.Free; // C end; - vProject2 := TProject.Create(FConn); + vProject2 := TProject.Create(FConn); // D try AssertNotNull(vProject2); - vProject2.Name := 'vProject2'; - FOwner.AddProject(vProject2); + // B -> D + FCompany.AddProject(vProject2); + AssertEquals('FCompany.ProjectCount 2', 2, FCompany.ProjectCount); finally - vProject2.Free; + vProject2.Free; // D end; - FreeAndNil(FOwner); + FreeAndNil(FCompany); // B AssertEquals('vPerson.RefCount 1', 2, vPerson.RefCount); @@ -449,13 +455,13 @@ AssertEquals('vPerson.Employer.ProjectCount 1', 1, vPerson.Employer.ProjectCount); finally - vPerson.Free; + vPerson.Free; // A end; end; // A -> B -> C -> A -// | -// + -> D -> E +// | +// + -> D -> E // then delete E procedure TestCircularReferences.TestCircularReferences5; var @@ -464,47 +470,50 @@ vProject2: TProject; vPerson2: TPerson; begin - FOwner.Name := 'Owner'; // B + //FCompany is B vPerson := TPerson.Create(FConn); // A try AssertNotNull(vPerson); vPerson.Name := 'vPerson'; - vPerson.EmployBy(FOwner); + // A -> B + vPerson.Employer := FCompany; 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'; + // C -> A vProject1.Manager := vPerson; - FOwner.AddProject(vProject1); + AssertNotNull(vProject1.Manager); + // B -> C + FCompany.AddProject(vProject1); + AssertEquals('FCompany.ProjectCount 1', 1, FCompany.ProjectCount); finally - vProject1.Free; + vProject1.Free; // C end; - vProject2 := TProject.Create(FConn); // D + vProject2 := TProject.Create(FConn); // D try AssertNotNull(vProject2); - vProject2.Name := 'vProject2'; - vPerson2 := TPerson.Create(FConn); // E + vPerson2 := TPerson.Create(FConn); // E try AssertNotNull(vPerson2); - vPerson2.Name := 'vPerson2'; - + // D -> E vProject2.Manager := vPerson2; + AssertNotNull(vProject2.Manager); finally - vPerson2.Free; + vPerson2.Free; // E end; - FOwner.AddProject(vProject2); + // B -> D + FCompany.AddProject(vProject2); + AssertEquals('FCompany.ProjectCount 2', 2, FCompany.ProjectCount); finally - vProject2.Free; + vProject2.Free; // D end; - FreeAndNil(FOwner); + FreeAndNil(FCompany); // B AssertEquals('vPerson.RefCount 1', 2, vPerson.RefCount); @@ -580,71 +589,65 @@ vPerson2: TPerson; vCategory: TCategory; begin -// vPerson2 := nil; //E -// vProject1 := nil; //C vCompany2 := 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; + vPerson.Employer := FCompany; 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); + FCompany.AddProject(vProject1); + AssertEquals('FCompany.ProjectCount 1', 1, FCompany.ProjectCount); vPerson2 := TPerson.Create(FConn); // E AssertNotNull(vPerson2); - vPerson2.Name := 'vPerson2'; // B -> E - FOwner.AddEmployee(vPerson2); + FCompany.AddEmployee(vPerson2); + AssertEquals('FCompany.EmployeeCount 1', 1, FCompany.EmployeeCount); // C -> A vProject1.Manager := vPerson; vCompany2 := TCompany.Create(FConn); // D AssertNotNull(vCompany2); - vCompany2.Name := 'vCompany2'; // D -> A vCompany2.AddEmployee(vPerson); + AssertEquals('vCompany2.EmployeeCount 1', 1, vCompany2.EmployeeCount); // D -> B - vCompany2.AddSubsidiary(FOwner); - AssertNotNull(vCompany2); - AssertNotNull(vProject1); + vCompany2.AddSubsidiary(FCompany); + AssertEquals('vCompany2.SubsidiaryCount', 1, vCompany2.SubsidiaryCount); // D -> C vCompany2.AddProject(vProject1); + AssertEquals('vCompany2.ProjectCount', 1, vCompany2.ProjectCount); vCategory := TCategory.Create(FConn); // F AssertNotNull(vCategory); - vCategory.Name := 'vCategory'; // E -> F vPerson2.Category := vCategory; + AssertNotNull(vPerson2.Category); AssertEquals('vPerson.RefCount 1', 3, vPerson.RefCount); AssertEquals('vPerson.RefByCount 1', 2, vPerson.RefByCount); - AssertEquals('FOwner.RefCount 1', - 3, FOwner.RefCount); - AssertEquals('FOwner.RefByCount 1', - 2, FOwner.RefByCount); + AssertEquals('FCompany.RefCount 1', + 3, FCompany.RefCount); + AssertEquals('FCompany.RefByCount 1', + 2, FCompany.RefByCount); - AssertEquals('FOwner.EmployeeCount 1', + AssertEquals('FCompany.EmployeeCount 2', 1, vPerson.Employer.EmployeeCount); - AssertEquals('FOwner.ProjectCount 1', - 1, FOwner.ProjectCount); + AssertEquals('FCompany.ProjectCount 2', + 1, FCompany.ProjectCount); AssertEquals('vProject1.RefCount 1', 3, vProject1.RefCount); AssertEquals('vProject1.RefByCount 1', @@ -666,7 +669,7 @@ 0, vCompany2.RefByCount); vPerson2.Free; //E - FOwner.Free; //B + FCompany.Free; //B try vPerson.Free; //A vProject1.Free; //C @@ -676,16 +679,16 @@ AssertEquals('vPerson.RefByCount 2', 2, vPerson.RefByCount); - AssertEquals('FOwner.RefCount 2', - 2, FOwner.RefCount); - AssertEquals('FOwner.RefByCount 2', - 2, FOwner.RefByCount); - - AssertEquals('FOwner.EmployeeCount 2', + AssertEquals('FCompany.RefCount 2', + 2, FCompany.RefCount); + AssertEquals('FCompany.RefByCount 2', + 2, FCompany.RefByCount); + + AssertEquals('FCompany.EmployeeCount 2', 1, vPerson.Employer.EmployeeCount); - AssertEquals('FOwner.ProjectCount 2', - 1, FOwner.ProjectCount); + AssertEquals('FCompany.ProjectCount 2', + 1, FCompany.ProjectCount); AssertEquals('vProject1.RefCount 2', 2, vProject1.RefCount); AssertEquals('vProject1.RefByCount 2', @@ -706,7 +709,7 @@ AssertEquals('vCompany2.RefByCount 2', 0, vCompany2.RefByCount); finally - FOwner := nil; + FCompany := nil; end; finally vCategory.Free; //F @@ -725,40 +728,39 @@ begin vCompany2 := nil; //C - FOwner.Name := 'Owner'; // B + // FCompany is B vPerson := TPerson.Create(FConn); // A try AssertNotNull(vPerson); - vPerson.Name := 'vPerson'; // A -> B - vPerson.Employer := FOwner; + vPerson.Employer := FCompany; AssertNotNull(vPerson.Employer); - AssertEquals('vPerson.Employer.Name A', 'Owner', vPerson.Employer.Name); // B -> A - FOwner.AddEmployee(vPerson); + FCompany.AddEmployee(vPerson); + AssertEquals('FCompany.EmployeeCount 1', 1, FCompany.EmployeeCount); vCompany2 := TCompany.Create(FConn); // C AssertNotNull(vCompany2); - vCompany2.Name := 'vCompany2'; // C -> A vCompany2.AddEmployee(vPerson); + AssertEquals('vCompany2.EmployeeCount 1', 1, vCompany2.EmployeeCount); // C -> B - vCompany2.AddSubsidiary(FOwner); - AssertNotNull(vCompany2); + vCompany2.AddSubsidiary(FCompany); + AssertEquals('vCompany2.SubsidiaryCount 1', 1, vCompany2.SubsidiaryCount); AssertEquals('vPerson.RefCount 1', 3, vPerson.RefCount); AssertEquals('vPerson.RefByCount 1', 2, vPerson.RefByCount); - AssertEquals('FOwner.RefCount 1', - 3, FOwner.RefCount); - AssertEquals('FOwner.RefByCount 1', - 2, FOwner.RefByCount); + AssertEquals('FCompany.RefCount 1', + 3, FCompany.RefCount); + AssertEquals('FCompany.RefByCount 1', + 2, FCompany.RefByCount); - AssertEquals('FOwner.EmployeeCount 1', + AssertEquals('FCompany.EmployeeCount 2', 1, vPerson.Employer.EmployeeCount); AssertEquals('vCompany2.RefCount 1', @@ -768,7 +770,7 @@ finally vPerson.Free; //A - FreeAndNil(FOwner); //B + FreeAndNil(FCompany); //B Free here is part of test specification vCompany2.Free; //C end; end; @@ -782,31 +784,33 @@ vPerson1: TPerson; vPerson2: TPerson; begin - vPerson2 := nil; // C + // FCompany is A - FOwner.Name := 'Employer'; // A - vPerson1 := TPerson.Create(FConn); // B try - vPerson1.Name := 'vPerson1'; + AssertNotNull(vPerson1); // A -> B - FOwner.AddEmployee(vPerson1); + FCompany.AddEmployee(vPerson1); + AssertEquals('FCompany.EmployeeCount 1', 1, FCompany.EmployeeCount); - vPerson2 := TPerson.Create(FConn); - vPerson2.Name := 'vPerson2'; + vPerson2 := TPerson.Create(FConn); // C + AssertNotNull(vPerson2); // A -> C - FOwner.AddEmployee(vPerson2); + FCompany.AddEmployee(vPerson2); + AssertEquals('FCompany.EmployeeCount 2', 2, FCompany.EmployeeCount); // B -> A - vPerson1.Employer := FOwner; + vPerson1.Employer := FCompany; + AssertNotNull(vPerson1.Employer); // C -> A - vPerson2.Employer := FOwner; + vPerson2.Employer := FCompany; + AssertNotNull(vPerson2.Employer); - AssertEquals('FOwner.RefCount 1', - 3, FOwner.RefCount); - AssertEquals('FOwner.RefByCount 1', - 2, FOwner.RefByCount); + AssertEquals('FCompany.RefCount 1', + 3, FCompany.RefCount); + AssertEquals('FCompany.RefByCount 1', + 2, FCompany.RefByCount); AssertEquals('vPerson1.RefCount 1', 2, vPerson1.RefCount); @@ -818,91 +822,65 @@ AssertEquals('vPerson2.RefByCount 1', 1, vPerson2.RefByCount); - FOwner.Free; // A + FCompany.Free; // A try - AssertEquals('FOwner.RefCount 2', - 2, FOwner.RefCount); + AssertEquals('FCompany.RefCount 2', + 2, FCompany.RefCount); + AssertEquals('FCompany.RefByCount 2', + 2, FCompany.RefByCount); AssertEquals('vPerson1.RefCount 2', 2, vPerson1.RefCount); + AssertEquals('vPerson1.RefByCount 2', + 1, vPerson1.RefByCount); AssertEquals('vPerson2.RefCount 2', 2, vPerson2.RefCount); + AssertEquals('vPerson2.RefByCount 2', + 1, vPerson2.RefByCount); vPerson1.Free; // B try - AssertEquals('FOwner.RefCount 3', - 2, FOwner.RefCount); + AssertEquals('FCompany.RefCount 3', + 2, FCompany.RefCount); + AssertEquals('FCompany.RefByCount 3', + 2, FCompany.RefByCount); AssertEquals('vPerson1.RefCount 3', 1, vPerson1.RefCount); + AssertEquals('vPerson1.RefByCount 3', + 1, vPerson1.RefByCount); AssertEquals('vPerson2.RefCount 3', 2, vPerson2.RefCount); + AssertEquals('vPerson2.RefByCount 3', + 1, vPerson2.RefByCount); - // This shouldn't raise AV because objects will be checked just after - // being removed. If you have problem within this test, just - // uncomment the following Exit call: - - // Exit; - vPerson2.Free; // C - - try - AssertEquals('FOwner.RefCount 4', - 0, FOwner.RefCount); - - AssertEquals('vPerson1.RefCount 4', - 0, vPerson1.RefCount); - - AssertEquals('vPerson2.RefCount 4', - 0, vPerson2.RefCount); - finally - vPerson2 := nil; - end; - finally vPerson1 := nil; end; finally - FOwner := nil; + FCompany := nil; end; finally - FreeAndNil(FOwner); // A vPerson1.Free; // B - vPerson2.Free; // C end; end; // A -> A procedure TestCircularReferences.TestCircularReferences9; begin - FOwner.AddSubsidiary(FOwner); - try - AssertEquals('FOwner.RefCount 1', - 2, FOwner.RefCount); - AssertEquals('FOwner.RefByCount 1', - 1, FOwner.RefByCount); + // FCompany is A - // This shouldn't raise AV because objects will be checked just after - // being removed. If you have problem within this test, just - // uncomment the following Exit call: - - // Exit; - - FOwner.Free; - try - AssertEquals('FOwner.RefCount 2', - 0, FOwner.RefCount); - finally - FOwner := nil; - end; - - finally - FreeAndNil(FOwner); - end; + FCompany.AddSubsidiary(FCompany); + AssertEquals('FCompany.SubsidiaryCount', 1, FCompany.SubsidiaryCount); + AssertEquals('FCompany.RefCount', + 2, FCompany.RefCount); + AssertEquals('FCompany.RefByCount', + 1, FCompany.RefByCount); end; initialization |
|
From: <jcm...@us...> - 2006-03-15 02:49:45
|
Revision: 650 Author: jcmoraisjr Date: 2006-03-14 18:49:38 -0800 (Tue, 14 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=650&view=rev Log Message: ----------- - Implemented TInstantCustomExposer.Remove method; - Implemented eoAutoRemember option; - Reverted logic of the eoDisposeReference option, named to eoNotDisposeReference. Modified Paths: -------------- trunk/Source/Core/InstantPresentation.pas Modified: trunk/Source/Core/InstantPresentation.pas =================================================================== --- trunk/Source/Core/InstantPresentation.pas 2006-03-15 02:44:36 UTC (rev 649) +++ trunk/Source/Core/InstantPresentation.pas 2006-03-15 02:49:38 UTC (rev 650) @@ -191,6 +191,7 @@ TInstantDeletedObjectBookmark = record RecNo: Integer; Instance: TInstantObject; + WasDisposed: Boolean; end; PInstantFieldBuffer = ^TInstantFieldBuffer; @@ -212,6 +213,7 @@ procedure FreeFieldBufferList; function GetDeletedObjectInstance: TInstantObject; function GetDeletedObjectRecNo: Integer; + function GetDeletedObjectWasDisposed: Boolean; function GetFieldBuffer(AIndex: Integer): PInstantFieldBuffer; function GetFieldBufferCount: Integer; function GetFieldBufferList: TList; @@ -222,13 +224,14 @@ public constructor Create(AObject: TObject; AOwner: TInstantContentBuffer = nil); destructor Destroy; override; - procedure RegisterAsDeleted(ARecNo: Integer; AAutoApplyChanges, ACanDispose: Boolean); + procedure RegisterAsDeleted(ARecNo: Integer; AAutoApplyChanges, ADispose: Boolean); procedure RegisterAsInserted; procedure RegisterAsModified; procedure RegisterField(AField: TField); procedure UndoChanges; property DeletedObjectInstance: TInstantObject read GetDeletedObjectInstance; property DeletedObjectRecNo: Integer read GetDeletedObjectRecNo; + property DeletedObjectWasDisposed: Boolean read GetDeletedObjectWasDisposed; property FieldBuffer[AIndex: Integer]: PInstantFieldBuffer read GetFieldBuffer; property FieldBufferCount: Integer read GetFieldBufferCount; property IsChanged: Boolean read GetIsChanged; @@ -241,7 +244,6 @@ TInstantContentBuffer = class(TObject) private FAutoApplyChanges: Boolean; - FCanDispose: Boolean; FRecordBufferList: TList; procedure FreeRecordBufferList; function GetRecordBuffer(AIndex: Integer): TInstantRecordBuffer; @@ -250,19 +252,19 @@ protected function FindRecordBuffer(AObject: TObject): TInstantRecordBuffer; function FindRecordBufferIndex(AObject: TObject): Integer; - procedure RegisterObjectUpdate(AObject: TObject; ARecNo: Integer; AUpdateStatus: TUpdateStatus); + procedure RegisterObjectUpdate(AObject: TObject; ARecNo: Integer; ADispose: Boolean; AUpdateStatus: TUpdateStatus); overload; + procedure RegisterObjectUpdate(AObject: TObject; AUpdateStatus: TUpdateStatus); overload; property AutoApplyChanges: Boolean read FAutoApplyChanges; - property CanDispose: Boolean read FCanDispose; property RecordBuffer[AIndex: Integer]: TInstantRecordBuffer read GetRecordBuffer; property RecordBufferCount: Integer read GetRecordBufferCount; property RecordBufferList: TList read GetRecordBufferList; public - constructor Create(AAutoApplyChanges, ACanDispose: Boolean); + constructor Create(AAutoApplyChanges: Boolean); destructor Destroy; override; procedure AddRecordBuffer(ARecordBuffer: TInstantRecordBuffer); procedure DisposeDeletedObjects; procedure ReleaseRecordBuffer(ARecordBuffer: TInstantRecordBuffer); - procedure RegisterAsDeleted(AObject: TObject; ARecNo: Integer); + procedure RegisterAsDeleted(AObject: TObject; ARecNo: Integer; ADispose: Boolean); procedure RegisterAsInserted(AObject: TObject); procedure RegisterAsModified(AObject: TObject; AState: TDataSetState); procedure RevertChanges(AExposer: TInstantCustomExposer); @@ -273,7 +275,7 @@ Instance: TObject; end; - TInstantExposerOption = (eoAutoApply, eoDisposeReferences, eoDeferInsert, eoSyncEdit); + TInstantExposerOption = (eoAutoApply, eoAutoRemember, eoNotDisposeReferences, eoDeferInsert, eoSyncEdit); TInstantExposerOptions = set of TInstantExposerOption; TInstantCustomExposer = class(TDataSet) @@ -507,6 +509,7 @@ procedure RefreshDataView; procedure Remember; procedure ReleaseObject(AObject: TObject); + procedure Remove; function RemoveObject(AObject: TObject): Integer; procedure Reset; procedure Revert; @@ -522,7 +525,7 @@ property FieldOptions: TInstantFieldOptions read FFieldOptions write SetFieldOptions default [foThorough]; property Filtered; property Limited: Boolean read GetLimited write SetLimited default False; - property Options: TInstantExposerOptions read FOptions write SetOptions default [eoAutoApply, eoDisposeReferences]; + property Options: TInstantExposerOptions read FOptions write SetOptions default [eoAutoApply, eoAutoRemember]; property ReadOnly: Boolean read FReadOnly write FReadOnly default False; property Sorted: Boolean read GetSorted write SetSorted default False; property AfterCancel; @@ -1606,6 +1609,11 @@ Result := FDeletedObjectBM.RecNo; end; +function TInstantRecordBuffer.GetDeletedObjectWasDisposed: Boolean; +begin + Result := FDeletedObjectBM.WasDisposed; +end; + function TInstantRecordBuffer.GetFieldBuffer(AIndex: Integer): PInstantFieldBuffer; begin if Assigned(FFieldBufferList) then @@ -1635,7 +1643,7 @@ end; procedure TInstantRecordBuffer.RegisterAsDeleted(ARecNo: Integer; - AAutoApplyChanges, ACanDispose: Boolean); + AAutoApplyChanges, ADispose: Boolean); begin if UpdateStatus = usModified then // Roll back changes, so RevertDeleted will restore the original object @@ -1644,13 +1652,14 @@ begin FDeletedObjectBM.RecNo := ARecNo; FDeletedObjectBM.Instance.Free; - if AAutoApplyChanges and ACanDispose then + if AAutoApplyChanges and ADispose then FDeletedObjectBM.Instance := Subject.Clone else begin FDeletedObjectBM.Instance := Subject; Subject.AddRef; end; + FDeletedObjectBM.WasDisposed := ADispose; FUpdateStatus := usDeleted; end else Free; @@ -1713,11 +1722,10 @@ RecordBufferList.Add(ARecordBuffer); end; -constructor TInstantContentBuffer.Create(AAutoApplyChanges, ACanDispose: Boolean); +constructor TInstantContentBuffer.Create(AAutoApplyChanges: Boolean); begin inherited Create; FAutoApplyChanges := AAutoApplyChanges; - FCanDispose := ACanDispose; end; destructor TInstantContentBuffer.Destroy; @@ -1730,10 +1738,11 @@ var I: Integer; begin - if not AutoApplyChanges and CanDispose then + if not AutoApplyChanges then for I := 0 to Pred(RecordBufferCount) do - if RecordBuffer[I].UpdateStatus = usDeleted then - with RecordBuffer[I].FDeletedObjectBM.Instance do + if (RecordBuffer[I].UpdateStatus = usDeleted) and + RecordBuffer[I].DeletedObjectWasDisposed then + with RecordBuffer[I].DeletedObjectInstance do if CanDispose then Dispose; end; @@ -1791,14 +1800,14 @@ end; procedure TInstantContentBuffer.RegisterAsDeleted(AObject: TObject; - ARecNo: Integer); + ARecNo: Integer; ADispose: Boolean); begin - RegisterObjectUpdate(AObject, ARecno, usDeleted); + RegisterObjectUpdate(AObject, ARecno, ADispose, usDeleted); end; procedure TInstantContentBuffer.RegisterAsInserted(AObject: TObject); begin - RegisterObjectUpdate(AObject, 0, usInserted); + RegisterObjectUpdate(AObject, usInserted); end; procedure TInstantContentBuffer.RegisterAsModified(AObject: TObject; AState: TDataSetState); @@ -1809,11 +1818,11 @@ dsInsert: VUpdateStatus := usInserted; else {dsEdit} VUpdateStatus := usModified; end; - RegisterObjectUpdate(AObject, 0, VUpdateStatus); + RegisterObjectUpdate(AObject, VUpdateStatus); end; procedure TInstantContentBuffer.RegisterObjectUpdate(AObject: TObject; - ARecNo: Integer; AUpdateStatus: TUpdateStatus); + ARecNo: Integer; ADispose: Boolean; AUpdateStatus: TUpdateStatus); var VRecordBuffer: TInstantRecordBuffer; begin @@ -1829,12 +1838,18 @@ usInserted: VRecordBuffer.RegisterAsInserted; usDeleted: - VRecordBuffer.RegisterAsDeleted(ARecNo, AutoApplyChanges, CanDispose); + VRecordBuffer.RegisterAsDeleted(ARecNo, AutoApplyChanges, ADispose); else ; end; end; +procedure TInstantContentBuffer.RegisterObjectUpdate(AObject: TObject; + AUpdateStatus: TUpdateStatus); +begin + RegisterObjectUpdate(AObject, 0, False, AUpdateStatus); +end; + procedure TInstantContentBuffer.ReleaseRecordBuffer(ARecordBuffer: TInstantRecordBuffer); begin if Assigned(FRecordBufferList) then @@ -1871,13 +1886,13 @@ else AExposer.InternalInsertObject(DeletedObjectRecNo, DeletedObjectInstance); // Friend class - if AutoApplyChanges and CanDispose then + if AutoApplyChanges and DeletedObjectWasDisposed then begin if AExposer is TInstantSelector then // TInstantQuery - TheObject.Store is enough DeletedObjectInstance.Store else - // TInstantParts - need to call Subject.Store + // TInstantParts or TInstantRefereces - need to call Subject.Store SubjectChanged := True; end; end; @@ -2401,7 +2416,7 @@ constructor TInstantCustomExposer.Create(AOwner: TComponent); begin inherited Create(AOwner); - FOptions := [eoAutoApply, eoDisposeReferences]; + FOptions := [eoAutoApply, eoAutoRemember]; BookmarkSize := SizeOf(TInstantBookmark); FIsOpen := False; FFieldOptions := [foThorough]; @@ -2639,7 +2654,7 @@ function TInstantCustomExposer.GetCanDispose: Boolean; begin - if not (eoDisposeReferences in FOptions) and InContent and (Subject is TInstantObject) then + if (eoNotDisposeReferences in FOptions) and InContent and (Subject is TInstantObject) then Result := not (TInstantObject(Subject).FindContainer(ContainerName) is TInstantReferences) else Result := True; @@ -2653,7 +2668,7 @@ function TInstantCustomExposer.GetContentBuffer: TInstantContentBuffer; begin if not Assigned(FContentBuffer) then - FContentBuffer := TInstantContentBuffer.Create(AutoApplyChanges, CanDispose); + FContentBuffer := TInstantContentBuffer.Create(AutoApplyChanges); Result := FContentBuffer; end; @@ -3199,7 +3214,7 @@ if InContent then begin if FSaveRevertBuffer then - ContentBuffer.RegisterAsDeleted(AObject, FRecNo); + ContentBuffer.RegisterAsDeleted(AObject, FRecNo, CanDispose); FContentChanged := True; end; IsInstantObject := AObject is TInstantObject; @@ -3343,6 +3358,8 @@ procedure TInstantCustomExposer.InternalOpen; begin + if eoAutoRemember in Options then + Remember; FRecNo := 0; InternalInitFieldDefs; if DefaultFields then @@ -3811,6 +3828,15 @@ FSaveRevertBuffer := True; end; +procedure TInstantCustomExposer.Remove; +begin + if InContent and (Subject is TInstantObject) and + (TInstantObject(Subject).FindContainer(ContainerName) is TInstantReferences) then + RemoveObject(CurrentObject) + else + Delete; +end; + function TInstantCustomExposer.RemoveObject(AObject: TObject): Integer; begin if AObject is TInstantObject then @@ -3822,7 +3848,7 @@ if InContent then begin if FSaveRevertBuffer then - ContentBuffer.RegisterAsDeleted(AObject, Succ(Result)); + ContentBuffer.RegisterAsDeleted(AObject, Succ(Result), False); FContentChanged := True; end; Refresh; |
|
From: <jcm...@us...> - 2006-03-15 02:44:49
|
Revision: 649 Author: jcmoraisjr Date: 2006-03-14 18:44:36 -0800 (Tue, 14 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=649&view=rev Log Message: ----------- - Declared RefByList (the TObjectList instance pointer) as protected; - Created public RefBy and RefByCount read-only properties; - Changed tests to use the new public properties; - Fixed some inconsistent linebreaks into TestCircularReferences unit; - Added new circular reference tests. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas trunk/Source/Tests/TestInstantCircularReferences.pas trunk/Source/Tests/TestInstantReference.pas Property Changed: ---------------- trunk/Source/Tests/TestInstantCircularReferences.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-03-15 00:32:32 UTC (rev 648) +++ trunk/Source/Core/InstantPersistence.pas 2006-03-15 02:44:36 UTC (rev 649) @@ -1229,7 +1229,9 @@ function GetObjects(Index: Integer): TInstantObject; function GetObjectStore: TInstantObjectStore; function GetPersistentId: string; - function GetReferencedBy: TObjectList; + function GetRefBy(Index: Integer): TInstantComplex; + function GetRefByCount: Integer; + function GetRefByList: TObjectList; function GetSavedState: TInstantObjectState; function GetState: TInstantObjectState; function GetUpdateCount: Integer; @@ -1298,6 +1300,7 @@ function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; property DefaultContainer: TInstantContainer read GetDefaultContainer; + property RefByList: TObjectList read GetRefByList; public constructor Clone(Source: TInstantObject; AConnector: TInstantConnector = nil); overload; virtual; @@ -1364,7 +1367,8 @@ property OwnerAttribute: TInstantComplex read FOwnerAttribute; property PersistentId: string read GetPersistentId; property RefCount: Integer read FRefCount; - property ReferencedBy: TObjectList read GetReferencedBy; + property RefBy[Index: Integer]: TInstantComplex read GetRefBy; + property RefByCount: Integer read GetRefByCount; property UpdateCount: Integer read GetUpdateCount; property OnAfterContentChange: TInstantContentChangeEvent read FOnAfterContentChange write FOnAfterContentChange; property OnAttributeChanged: TInstantAttributeChangeEvent read FOnAttributeChanged write FOnAttributeChanged; @@ -4478,7 +4482,7 @@ if HasInstance and FOwnsInstance then begin if Assigned(FOwner) then - FInstance.ReferencedBy.Remove(FOwner); + FInstance.RefByList.Remove(FOwner); FInstance.Free; end; FInstance := nil; @@ -4621,13 +4625,13 @@ begin FInstance.AddRef; if Assigned(FOwner) then - FInstance.ReferencedBy.Add(FOwner); + FInstance.RefByList.Add(FOwner); end else if not Value and OwnsInstance then begin FInstance.Release; if Assigned(FOwner) then - FInstance.ReferencedBy.Remove(FOwner); + FInstance.RefByList.Remove(FOwner); end; FOwnsInstance := Value; end; @@ -8324,19 +8328,18 @@ I: Integer; begin Result := True; - if Assigned(AOwner.FRefBy) then - for I := 0 to Pred(AOwner.FRefBy.Count) do - if AOwner.FRefBy[I] is TInstantComplex then - begin - CurrentItemOwner := TInstantComplex(AOwner.FRefBy[I]).Owner; - Result := TInstantComplex(AOwner.FRefBy[0]).Owner = CurrentItemOwner; - if not Result and Assigned(CurrentItemOwner) and - Assigned(CurrentItemOwner.FRefBy) and (CurrentItemOwner.FRefBy.Count = 1) then - Result := (CurrentItemOwner.RefCount = 1) or - ((CurrentItemOwner.RefCount = 2) and (CurrentItemOwner = Self)); - if not Result then - Exit; - end; + for I := 0 to Pred(AOwner.RefByCount) do + if AOwner.FRefBy[I] is TInstantComplex then + begin + CurrentItemOwner := TInstantComplex(AOwner.FRefBy[I]).Owner; + Result := TInstantComplex(AOwner.FRefBy[0]).Owner = CurrentItemOwner; + if not Result and Assigned(CurrentItemOwner) and + (CurrentItemOwner.RefByCount = 1) then + Result := (CurrentItemOwner.RefCount = 1) or + ((CurrentItemOwner.RefCount = 2) and (CurrentItemOwner = Self)); + if not Result then + Exit; + end; end; var @@ -8353,10 +8356,10 @@ if not Result and Assigned(ItemOwner.FRefBy) and CanUnassign(ItemOwner) then begin CheckedObjects.Add(ItemOwner); - for I := 0 to Pred(ItemOwner.FRefBy.Count) do + for I := 0 to Pred(ItemOwner.RefByCount) do if ItemOwner.FRefBy[I] is TInstantComplex then begin - Result := (ItemOwner.RefCount = ItemOwner.FRefBy.Count) and + Result := (ItemOwner.RefCount = ItemOwner.RefByCount) and IsInsideCircularReference(TInstantComplex(ItemOwner.FRefBy[I])); if Result then Exit; @@ -8369,8 +8372,8 @@ begin CheckedObjects := TObjectList.Create(False); try - if Assigned(FRefBy) and (FRefBy.Count = FRefCount-1) then - for I := Pred(FRefBy.Count) downto 0 do + if RefByCount = RefCount - 1 then + for I := Pred(RefByCount) downto 0 do if (FRefBy[I] is TInstantComplex) and IsInsideCircularReference(TInstantComplex(FRefBy[I])) then case TInstantComplex(FRefBy[I]).AttributeType of @@ -8515,8 +8518,21 @@ Result := State.PersistentId; end; -function TInstantObject.GetReferencedBy: TObjectList; +function TInstantObject.GetRefBy(Index: Integer): TInstantComplex; begin + Result := RefByList[Index] as TInstantComplex; +end; + +function TInstantObject.GetRefByCount: Integer; +begin + if Assigned(FRefBy) then + Result := FRefBy.Count + else + Result := 0; +end; + +function TInstantObject.GetRefByList: TObjectList; +begin if not Assigned(FRefBy) then FRefBy := TObjectList.Create(False); Result := FRefBy; Modified: trunk/Source/Tests/TestInstantCircularReferences.pas =================================================================== --- trunk/Source/Tests/TestInstantCircularReferences.pas 2006-03-15 00:32:32 UTC (rev 648) +++ trunk/Source/Tests/TestInstantCircularReferences.pas 2006-03-15 02:44:36 UTC (rev 649) @@ -1,776 +1,915 @@ -(* - * 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): +(* + * InstantObjects Test Suite + * TestInstantCircularReferences + *) + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 * - * - * ***** 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-+----+ - // Free order: E, B, A, C, F, D - procedure TestCircularReferences6; - // A -> <- B - // ^ ^ - // +-- C --+ - // Free order: A, B, C - procedure TestCircularReferences7; - 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; - vCompany2: TCompany; - vPerson2: TPerson; - vCategory: TCategory; -begin -// vPerson2 := nil; //E -// vProject1 := nil; //C - vCompany2 := 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; - - vCompany2 := TCompany.Create(FConn); // D - AssertNotNull(vCompany2); - vCompany2.Name := 'vCompany2'; - // D -> A - vCompany2.AddEmployee(vPerson); - // D -> B - vCompany2.AddSubsidiary(FOwner); - AssertNotNull(vCompany2); - AssertNotNull(vProject1); - // D -> C - vCompany2.AddProject(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', - 2, 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('vCompany2.RefCount 1', - 1, vCompany2.RefCount); - AssertEquals('vCompany2.ReferencedBy.Count 1', - 0, vCompany2.ReferencedBy.Count); - - vPerson2.Free; //E - FOwner.Free; //B - try - vPerson.Free; //A - vProject1.Free; //C - - AssertEquals('vPerson.RefCount 2', - 2, vPerson.RefCount); - AssertEquals('vPerson.ReferencedBy.Count 2', - 2, vPerson.ReferencedBy.Count); - - AssertEquals('FOwner.RefCount 2', - 2, FOwner.RefCount); - AssertEquals('FOwner.ReferencedBy.Count 2', - 2, FOwner.ReferencedBy.Count); - - AssertEquals('FOwner.EmployeeCount 2', - 1, vPerson.Employer.EmployeeCount); - - AssertEquals('FOwner.ProjectCount 2', - 1, FOwner.ProjectCount); - AssertEquals('vProject1.RefCount 2', - 2, vProject1.RefCount); - AssertEquals('vProject1.ReferencedBy.Count 2', - 2, vProject1.ReferencedBy.Count); - - AssertEquals('vPerson2.RefCount 2', - 1, vPerson2.RefCount); - AssertEquals('vPerson2.ReferencedBy.Count 2', - 1, vPerson2.ReferencedBy.Count); - - AssertEquals('vCategory.RefCount 2', - 2, vCategory.RefCount); - AssertEquals('vCategory.ReferencedBy.Count 2', - 1, vCategory.ReferencedBy.Count); - - AssertEquals('vCompany2.RefCount 2', - 1, vCompany2.RefCount); - AssertEquals('vCompany2.ReferencedBy.Count 2', - 0, vCompany2.ReferencedBy.Count); - finally - FOwner := nil; - end; - finally - vCategory.Free; //F - vCompany2.Free; //D - end; -end; - -// A -> <- B -// ^ ^ -// +-- C --+ -// Free order: A, B, C -procedure TestCircularReferences.TestCircularReferences7; -var - vPerson: TPerson; - vCompany2: TCompany; -begin - vCompany2 := nil; //C - - 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); - // B -> A - FOwner.AddEmployee(vPerson); - - vCompany2 := TCompany.Create(FConn); // C - AssertNotNull(vCompany2); - vCompany2.Name := 'vCompany2'; - // C -> A - vCompany2.AddEmployee(vPerson); - // C -> B - vCompany2.AddSubsidiary(FOwner); - AssertNotNull(vCompany2); - - 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('vCompany2.RefCount 1', - 1, vCompany2.RefCount); - AssertEquals('vCompany2.ReferencedBy.Count 1', - 0, vCompany2.ReferencedBy.Count); - finally - vPerson.Free; //A - FreeAndNil(FOwner); //B - vCompany2.Free; //C - end; -end; - - -initialization - // Register any test cases with the test runner -{$IFNDEF CURR_TESTS} - RegisterTests([TestCircularReferences]); -{$ENDIF} - -end. - \ No newline at end of file + * 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): + * Joao Morais + * + * ***** 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-+----+ + // Free order: E, B, A, C, F, D + procedure TestCircularReferences6; + // A -> <- B + // ^ ^ + // +-- C --+ + // Free order: A, B, C + procedure TestCircularReferences7; + // A -> B -> A + // | ^ + // +--> C ---+ + // Free order: A, B, C + procedure TestCircularReferences8; + // A -> A + procedure TestCircularReferences9; + 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.RefByCount 1', 1, FOwner.RefByCount); + AssertEquals('FOwner.EmployeeCount 1', 1, FOwner.EmployeeCount); + AssertEquals('FOwner.Employees[0].RefCount 1', + 1, FOwner.Employees[0].RefCount); + AssertEquals('FOwner.Employees[0].RefByCount 1', + 1, FOwner.Employees[0].RefByCount); + + 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.RefByCount 2', 1, FOwner.RefByCount); + + AssertEquals('FOwner.Employees[0].RefCount 2', + 1, FOwner.Employees[0].RefCount); + AssertEquals('FOwner.Employees[0].RefByCount 2', + 1, FOwner.Employees[0].RefByCount); + + AssertEquals('FOwner.Employees[0].Category.RefCount 1', + 1, FOwner.Employees[0].Category.RefCount); + AssertEquals('FOwner.Employees[0].Category.RefByCount 1', + 1, FOwner.Employees[0].Category.RefByCount); +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.RefByCount 1', 1, vPerson.RefByCount); + AssertEquals('vPerson.Projects[0].RefCount', 1, vPerson.Projects[0].RefCount); + AssertEquals('vPerson.Projects[0].RefByCount', + 1, vPerson.Projects[0].RefByCount); + AssertEquals('vPerson.Projects[0].Addresses[0].RefCount', + 1, vPerson.Projects[0].Addresses[0].RefCount); + AssertEquals('vPerson.Projects[0].Addresses[0].RefByCount', + 0, vPerson.Projects[0].Addresses[0].RefByCount); + finally + vPerson.Free; + end; +// AssertEquals('vPerson.RefCount 2', 1, vPerson.RefCount); +// AssertEquals('vPerson.RefByCount 2', 1, vPerson.RefByCount); +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.RefByCount 1', 1, vPerson.RefByCount); + + AssertEquals('vPerson.Projects[0].RefCount', + 1, vPerson.Projects[0].RefCount); + AssertEquals('vPerson.Projects[0].RefByCount', + 1, vPerson.Projects[0].RefByCount); + + AssertEquals('vPerson.Projects[0].SubProjects[0].RefCount', + 1, vPerson.Projects[0].SubProjects[0].RefCount); + AssertEquals('vPerson.Projects[0].SubProjects[0].RefByCount', + 0, vPerson.Projects[0].SubProjects[0].RefByCount); + + 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].RefByCount', + 0, vPerson.Projects[0].SubProjects[0].Addresses[0].RefByCount); + finally + vPerson.Free; + end; +// AssertEquals('vPerson.RefCount 2', 1, vPerson.RefCount); +// AssertEquals('vPerson.RefByCount 2', 1, vPerson.RefByCount); +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.RefByCount 1', 1, FOwner.RefByCount); + AssertEquals('FOwner.EmployeeCount 1', 1, FOwner.EmployeeCount); + AssertEquals('FOwner.Employees[0].RefCount 1', + 1, FOwner.Employees[0].RefCount); + AssertEquals('FOwner.Employees[0].RefByCount 1', + 1, FOwner.Employees[0].RefByCount); + + 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.RefByCount 1', 1, FOwner.RefByCount); + + AssertEquals('FOwner.EmployeeCount', 2, FOwner.EmployeeCount); + AssertEquals('FOwner.Employees[1].RefCount 1', + 1, FOwner.Employees[1].RefCount); + AssertEquals('FOwner.Employees[1].RefByCount 1', + 1, FOwner.Employees[1].RefByCount); + + 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.RefByCount 1', + 1, vPerson.RefByCount); + + AssertEquals('vPerson.Employer.RefCount 1', + 1, vPerson.Employer.RefCount); + AssertEquals('vPerson.Employer.RefByCount 1', + 1, vPerson.Employer.RefByCount); + + 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].RefByCount 1', + 1, vPerson.Employer.Projects[0].RefByCount); + AssertEquals('vPerson.Employer.Projects[1].RefCount 1', + 1, vPerson.Employer.Projects[1].RefCount); + AssertEquals('vPerson.Employer.Projects[1].RefByCount 1', + 1, vPerson.Employer.Projects[1].RefByCount); + + 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.RefByCount 1', + 1, vPerson.RefByCount); + + AssertEquals('vPerson.Employer.RefCount 1', + 1, vPerson.Employer.RefCount); + AssertEquals('vPerson.Employer.RefByCount 1', + 1, vPerson.Employer.RefByCount); + + 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].RefByCount 1', + 1, vPerson.Employer.Projects[0].RefByCount); + AssertEquals('vPerson.Employer.Projects[1].RefCount 1', + 1, vPerson.Employer.Projects[1].RefCount); + AssertEquals('vPerson.Employer.Projects[1].RefByCount 1', + 1, vPerson.Employer.Projects[1].RefByCount); + + AssertEquals('vPerson.Employer.Projects[1].Manager.RefCount 1', + 1, vPerson.Employer.Projects[1].Manager.RefCount); + AssertEquals('vPerson.Employer.Projects[1].Manager.RefByCount 1', + 1, vPerson.Employer.Projects[1].Manager.RefByCount); + + 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; + vCompany2: TCompany; + vPerson2: TPerson; + vCategory: TCategory; +begin +// vPerson2 := nil; //E +// vProject1 := nil; //C + vCompany2 := 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; + + vCompany2 := TCompany.Create(FConn); // D + AssertNotNull(vCompany2); + vCompany2.Name := 'vCompany2'; + // D -> A + vCompany2.AddEmployee(vPerson); + // D -> B + vCompany2.AddSubsidiary(FOwner); + AssertNotNull(vCompany2); + AssertNotNull(vProject1); + // D -> C + vCompany2.AddProject(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.RefByCount 1', + 2, vPerson.RefByCount); + + AssertEquals('FOwner.RefCount 1', + 3, FOwner.RefCount); + AssertEquals('FOwner.RefByCount 1', + 2, FOwner.RefByCount); + + AssertEquals('FOwner.EmployeeCount 1', + 1, vPerson.Employer.EmployeeCount); + + AssertEquals('FOwner.ProjectCount 1', + 1, FOwner.ProjectCount); + AssertEquals('vProject1.RefCount 1', + 3, vProject1.RefCount); + AssertEquals('vProject1.RefByCount 1', + 2, vProject1.RefByCount); + + AssertEquals('vPerson2.RefCount 1', + 2, vPerson2.RefCount); + AssertEquals('vPerson2.RefByCount 1', + 1, vPerson2.RefByCount); + + AssertEquals('vCategory.RefCount 1', + 2, vCategory.RefCount); + AssertEquals('vCategory.RefByCount 1', + 1, vCategory.RefByCount); + + AssertEquals('vCompany2.RefCount 1', + 1, vCompany2.RefCount); + AssertEquals('vCompany2.RefByCount 1', + 0, vCompany2.RefByCount); + + vPerson2.Free; //E + FOwner.Free; //B + try + vPerson.Free; //A + vProject1.Free; //C + + AssertEquals('vPerson.RefCount 2', + 2, vPerson.RefCount); + AssertEquals('vPerson.RefByCount 2', + 2, vPerson.RefByCount); + + AssertEquals('FOwner.RefCount 2', + 2, FOwner.RefCount); + AssertEquals('FOwner.RefByCount 2', + 2, FOwner.RefByCount); + + AssertEquals('FOwner.EmployeeCount 2', + 1, vPerson.Employer.EmployeeCount); + + AssertEquals('FOwner.ProjectCount 2', + 1, FOwner.ProjectCount); + AssertEquals('vProject1.RefCount 2', + 2, vProject1.RefCount); + AssertEquals('vProject1.RefByCount 2', + 2, vProject1.RefByCount); + + AssertEquals('vPerson2.RefCount 2', + 1, vPerson2.RefCount); + AssertEquals('vPerson2.RefByCount 2', + 1, vPerson2.RefByCount); + + AssertEquals('vCategory.RefCount 2', + 2, vCategory.RefCount); + AssertEquals('vCategory.RefByCount 2', + 1, vCategory.RefByCount); + + AssertEquals('vCompany2.RefCount 2', + 1, vCompany2.RefCount); + AssertEquals('vCompany2.RefByCount 2', + 0, vCompany2.RefByCount); + finally + FOwner := nil; + end; + finally + vCategory.Free; //F + vCompany2.Free; //D + end; +end; + +// A -> <- B +// ^ ^ +// +-- C --+ +// Free order: A, B, C +procedure TestCircularReferences.TestCircularReferences7; +var + vPerson: TPerson; + vCompany2: TCompany; +begin + vCompany2 := nil; //C + + 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); + // B -> A + FOwner.AddEmployee(vPerson); + + vCompany2 := TCompany.Create(FConn); // C + AssertNotNull(vCompany2); + vCompany2.Name := 'vCompany2'; + // C -> A + vCompany2.AddEmployee(vPerson); + // C -> B + vCompany2.AddSubsidiary(FOwner); + AssertNotNull(vCompany2); + + AssertEquals('vPerson.RefCount 1', + 3, vPerson.RefCount); + AssertEquals('vPerson.RefByCount 1', + 2, vPerson.RefByCount); + + AssertEquals('FOwner.RefCount 1', + 3, FOwner.RefCount); + AssertEquals('FOwner.RefByCount 1', + 2, FOwner.RefByCount); + + AssertEquals('FOwner.EmployeeCount 1', + 1, vPerson.Employer.EmployeeCount); + + AssertEquals('vCompany2.RefCount 1', + 1, vCompany2.RefCount); + AssertEquals('vCompany2.RefByCount 1', + 0, vCompany2.RefByCount); + + finally + vPerson.Free; //A + FreeAndNil(FOwner); //B + vCompany2.Free; //C + end; +end; + +// A -> B -> A +// | ^ +// +--> C ---+ +// Free order: A, B, C +procedure TestCircularReferences.TestCircularReferences8; +var + vPerson1: TPerson; + vPerson2: TPerson; +begin + vPerson2 := nil; // C + + FOwner.Name := 'Employer'; // A + + vPerson1 := TPerson.Create(FConn); // B + try + vPerson1.Name := 'vPerson1'; + // A -> B + FOwner.AddEmployee(vPerson1); + + vPerson2 := TPerson.Create(FConn); + vPerson2.Name := 'vPerson2'; + // A -> C + FOwner.AddEmployee(vPerson2); + + // B -> A + vPerson1.Employer := FOwner; + + // C -> A + vPerson2.Employer := FOwner; + + AssertEquals('FOwner.RefCount 1', + 3, FOwner.RefCount); + AssertEquals('FOwner.RefByCount 1', + 2, FOwner.RefByCount); + + AssertEquals('vPerson1.RefCount 1', + 2, vPerson1.RefCount); + AssertEquals('vPerson1.RefByCount 1', + 1, vPerson1.RefByCount); + + AssertEquals('vPerson2.RefCount 1', + 2, vPerson2.RefCount); + AssertEquals('vPerson2.RefByCount 1', + 1, vPerson2.RefByCount); + + FOwner.Free; // A + try + AssertEquals('FOwner.RefCount 2', + 2, FOwner.RefCount); + + AssertEquals('vPerson1.RefCount 2', + 2, vPerson1.RefCount); + + AssertEquals('vPerson2.RefCount 2', + 2, vPerson2.RefCount); + + vPerson1.Free; // B + try + AssertEquals('FOwner.RefCount 3', + 2, FOwner.RefCount); + + AssertEquals('vPerson1.RefCount 3', + 1, vPerson1.RefCount); + + AssertEquals('vPerson2.RefCount 3', + 2, vPerson2.RefCount); + + // This shouldn't raise AV because objects will be checked just after + // being removed. If you have problem within this test, just + // uncomment the following Exit call: + + // Exit; + + vPerson2.Free; // C + + try + AssertEquals('FOwner.RefCount 4', + 0, FOwner.RefCount); + + AssertEquals('vPerson1.RefCount 4', + 0, vPerson1.RefCount); + + AssertEquals('vPerson2.RefCount 4', + 0, vPerson2.RefCount); + finally + vPerson2 := nil; + end; + + finally + vPerson1 := nil; + end; + + finally + FOwner := nil; + end; + + finally + FreeAndNil(FOwner); // A + vPerson1.Free; // B + vPerson2.Free; // C + end; +end; + +// A -> A +procedure TestCircularReferences.TestCircularReferences9; +begin + FOwner.AddSubsidiary(FOwner); + try + AssertEquals('FOwner.RefCount 1', + 2, FOwner.RefCount); + AssertEquals('FOwner.RefByCount 1', + 1, FOwner.RefByCount); + + // This shouldn't raise AV because objects will be checked just after + // being removed. If you have problem within this test, just + // uncomment the following Exit call: + + // Exit; + + FOwner.Free; + try + AssertEquals('FOwner.RefCount 2', + 0, FOwner.RefCount); + finally + FOwner := nil; + end; + + finally + FreeAndNil(FOwner); + end; +end; + +initialization + // Register any test cases with the test runner +{$IFNDEF CURR_TESTS} + RegisterTests([TestCircularReferences]); +{$ENDIF} + +end. + Property changes on: trunk/Source/Tests/TestInstantCircularReferences.pas ___________________________________________________________________ Name: svn:keywords + Author Date Id Revision Name: svn:eol-style + native Modified: trunk/Source/Tests/TestInstantReference.pas =================================================================== --- trunk/Source/Tests/TestInstantReference.pas 2006-03-15 00:32:32 UTC (rev 648) +++ trunk/Source/Tests/TestInstantReference.pas 2006-03-15 02:44:36 UTC (rev 649) @@ -96,15 +96,15 @@ vSource := TInstantReference.Create(FOwner, vAttrMetadata); try vCategory := TCategory.Create(FConn); - AssertEquals(0, vCategory.ReferencedBy.Count); + AssertEquals(0, vCategory.RefByCount); FInstantReference.Value := vCategory; - AssertEquals(1, vCategory.ReferencedBy.Count); + AssertEquals(1, vCategory.RefByCount); AssertTrue('Value HasVal', FInstantReference.HasValue); AssertTrue('Value HasReference', FInstantReference.HasReference); AssertFalse('vSource HasVal', vSource.HasValue); vSource.Assign(FInstantReference); - AssertEquals(2, vCategory.ReferencedBy.Count); + AssertEquals(2, vCategory.RefByCount); AssertEquals(3, vCategory.RefCount); AssertTrue('Assign HasVal', vSource.HasValue); AssertTrue('Assign HasReference', vSource.HasReference); |
|
From: <sr...@us...> - 2006-03-15 00:32:44
|
Revision: 648 Author: srmitch Date: 2006-03-14 16:32:32 -0800 (Tue, 14 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=648&view=rev Log Message: ----------- Update to unit tests: 1. Added Subsidiaries References attribute to TCompany in TestModel.pas 2. Fixed up TestCircularReferences6 test in TestInstantCircularReferences.pas. 3. Added TestCircularReferences7 test in TestInstantCircularReferences.pas. Modified Paths: -------------- trunk/Source/Tests/TestIO.mdr trunk/Source/Tests/TestIO.mdx trunk/Source/Tests/TestInstantCircularReferences.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-03-13 21:42:42 UTC (rev 647) +++ trunk/Source/Tests/TestIO.mdx 2006-03-15 00:32:32 UTC (rev 648) @@ -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>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 +<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><TInstantAttributeMetadata><Name>Subsidiaries</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></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/TestInstantCircularReferences.pas =================================================================== --- trunk/Source/Tests/TestInstantCircularReferences.pas 2006-03-13 21:42:42 UTC (rev 647) +++ trunk/Source/Tests/TestInstantCircularReferences.pas 2006-03-15 00:32:32 UTC (rev 648) @@ -77,7 +77,13 @@ // A -> B -> C -> A // ^ ^ ^ // +--D-+----+ + // Free order: E, B, A, C, F, D procedure TestCircularReferences6; + // A -> <- B + // ^ ^ + // +-- C --+ + // Free order: A, B, C + procedure TestCircularReferences7; end; implementation @@ -563,13 +569,13 @@ var vPerson: TPerson; vProject1: TProject; - vProject2: TProject; + vCompany2: TCompany; vPerson2: TPerson; vCategory: TCategory; begin - vPerson2 := nil; //E - vProject1 := nil; //C - vProject2 := nil; //D +// vPerson2 := nil; //E +// vProject1 := nil; //C + vCompany2 := nil; //D vCategory := nil; //F FOwner.Name := 'Owner'; // B @@ -598,80 +604,172 @@ // C -> A vProject1.Manager := vPerson; - AssertNotNull(vProject1); - vProject2 := TProject.Create(FConn); // D - AssertNotNull(vProject2); - vProject2.Name := 'vProject2'; + vCompany2 := TCompany.Create(FConn); // D + AssertNotNull(vCompany2); + vCompany2.Name := 'vCompany2'; // D -> A - vProject2.AddParticipant(vPerson); + vCompany2.AddEmployee(vPerson); // D -> B - vProject2.Manager := FOwner; - AssertNotNull(vProject2); + vCompany2.AddSubsidiary(FOwner); + AssertNotNull(vCompany2); AssertNotNull(vProject1); -// // D -> C -// // If the following line is uncommented <-------------- -// // an AV will be raised at runtime <-------------- -// vProject2.AddSubProject(vProject1); + // D -> C + vCompany2.AddProject(vProject1); -// vCategory := TCategory.Create(FConn); // F -// AssertNotNull(vCategory); -// vCategory.Name := 'vCategory'; -// // E -> F -// vPerson2.Category := vCategory; + 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); + 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', + 2, 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('vCompany2.RefCount 1', + 1, vCompany2.RefCount); + AssertEquals('vCompany2.ReferencedBy.Count 1', + 0, vCompany2.ReferencedBy.Count); + + vPerson2.Free; //E + FOwner.Free; //B + try + vPerson.Free; //A + vProject1.Free; //C + + AssertEquals('vPerson.RefCount 2', + 2, vPerson.RefCount); + AssertEquals('vPerson.ReferencedBy.Count 2', + 2, vPerson.ReferencedBy.Count); + + AssertEquals('FOwner.RefCount 2', + 2, FOwner.RefCount); + AssertEquals('FOwner.ReferencedBy.Count 2', + 2, FOwner.ReferencedBy.Count); + + AssertEquals('FOwner.EmployeeCount 2', + 1, vPerson.Employer.EmployeeCount); + + AssertEquals('FOwner.ProjectCount 2', + 1, FOwner.ProjectCount); + AssertEquals('vProject1.RefCount 2', + 2, vProject1.RefCount); + AssertEquals('vProject1.ReferencedBy.Count 2', + 2, vProject1.ReferencedBy.Count); + + AssertEquals('vPerson2.RefCount 2', + 1, vPerson2.RefCount); + AssertEquals('vPerson2.ReferencedBy.Count 2', + 1, vPerson2.ReferencedBy.Count); + + AssertEquals('vCategory.RefCount 2', + 2, vCategory.RefCount); + AssertEquals('vCategory.ReferencedBy.Count 2', + 1, vCategory.ReferencedBy.Count); + + AssertEquals('vCompany2.RefCount 2', + 1, vCompany2.RefCount); + AssertEquals('vCompany2.ReferencedBy.Count 2', + 0, vCompany2.ReferencedBy.Count); + finally + FOwner := nil; + end; finally - vPerson2.Free; //E - FreeAndNil(FOwner); //B - vPerson.Free; //A - vProject1.Free; //C vCategory.Free; //F - vProject2.Free; //D + vCompany2.Free; //D end; end; +// A -> <- B +// ^ ^ +// +-- C --+ +// Free order: A, B, C +procedure TestCircularReferences.TestCircularReferences7; +var + vPerson: TPerson; + vCompany2: TCompany; +begin + vCompany2 := nil; //C + 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); + // B -> A + FOwner.AddEmployee(vPerson); + + vCompany2 := TCompany.Create(FConn); // C + AssertNotNull(vCompany2); + vCompany2.Name := 'vCompany2'; + // C -> A + vCompany2.AddEmployee(vPerson); + // C -> B + vCompany2.AddSubsidiary(FOwner); + AssertNotNull(vCompany2); + + 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('vCompany2.RefCount 1', + 1, vCompany2.RefCount); + AssertEquals('vCompany2.ReferencedBy.Count 1', + 0, vCompany2.ReferencedBy.Count); + finally + vPerson.Free; //A + FreeAndNil(FOwner); //B + vCompany2.Free; //C + end; +end; + + initialization // Register any test cases with the test runner {$IFNDEF CURR_TESTS} RegisterTests([TestCircularReferences]); -{$ELSE} - RegisterTests([TestCircularReferences]); {$ENDIF} end. Modified: trunk/Source/Tests/TestModel.pas =================================================================== --- trunk/Source/Tests/TestModel.pas 2006-03-13 21:42:42 UTC (rev 647) +++ trunk/Source/Tests/TestModel.pas 2006-03-15 00:32:32 UTC (rev 648) @@ -282,23 +282,36 @@ TCompany = class(TContact) {IOMETADATA stored; Employees: References(TPerson); - NoOfBranches: Integer; } + NoOfBranches: Integer; + Subsidiaries: References(TCompany); } _Employees: TInstantReferences; _NoOfBranches: TInstantInteger; + _Subsidiaries: TInstantReferences; private function GetEmployeeCount: Integer; function GetEmployees(Index: Integer): TPerson; function GetNoOfBranches: Integer; + function GetSubsidiaries(Index: Integer): TCompany; + function GetSubsidiaryCount: Integer; procedure SetNoOfBranches(Value: Integer); + procedure SetSubsidiaries(Index: Integer; Value: TCompany); public function AddEmployee(Employee: TPerson): Integer; + function AddSubsidiary(Subsidiary: TCompany): Integer; procedure ClearEmployees; + procedure ClearSubsidiaries; procedure DeleteEmployee(Index: Integer); + procedure DeleteSubsidiary(Index: Integer); function IndexOfEmployee(Employee: TPerson): Integer; + function IndexOfSubsidiary(Subsidiary: TCompany): Integer; procedure InsertEmployee(Index: Integer; Employee: TPerson); + procedure InsertSubsidiary(Index: Integer; Subsidiary: TCompany); function RemoveEmployee(Employee: TPerson): Integer; + function RemoveSubsidiary(Subsidiary: TCompany): Integer; property EmployeeCount: Integer read GetEmployeeCount; property Employees[Index: Integer]: TPerson read GetEmployees; + property Subsidiaries[Index: Integer]: TCompany read GetSubsidiaries write SetSubsidiaries; + property SubsidiaryCount: Integer read GetSubsidiaryCount; published property NoOfBranches: Integer read GetNoOfBranches write SetNoOfBranches; end; @@ -878,11 +891,21 @@ { TContact } +function TCompany.RemoveSubsidiary(Subsidiary: TCompany): Integer; +begin + Result := _Subsidiaries.Remove(Subsidiary); +end; + procedure TCompany.SetNoOfBranches(Value: Integer); begin _NoOfBranches.Value := Value; end; +procedure TCompany.SetSubsidiaries(Index: Integer; Value: TCompany); +begin + _Subsidiaries[Index] := Value; +end; + function TContact.AddExternalPart(ExternalPart: TExternalPhones): Integer; begin Result := _ExternalPhones.Add(ExternalPart); @@ -1157,16 +1180,31 @@ Result := _Employees.Add(Employee) end; +function TCompany.AddSubsidiary(Subsidiary: TCompany): Integer; +begin + Result := _Subsidiaries.Add(Subsidiary); +end; + procedure TCompany.ClearEmployees; begin _Employees.Clear; end; +procedure TCompany.ClearSubsidiaries; +begin + _Subsidiaries.Clear; +end; + procedure TCompany.DeleteEmployee(Index: Integer); begin _Employees.Delete(Index); end; +procedure TCompany.DeleteSubsidiary(Index: Integer); +begin + _Subsidiaries.Delete(Index); +end; + function TCompany.GetEmployeeCount: Integer; begin Result := _Employees.Count @@ -1182,16 +1220,36 @@ Result := _NoOfBranches.Value; end; +function TCompany.GetSubsidiaries(Index: Integer): TCompany; +begin + Result := _Subsidiaries[Index] as TCompany; +end; + +function TCompany.GetSubsidiaryCount: Integer; +begin + Result := _Subsidiaries.Count; +end; + function TCompany.IndexOfEmployee(Employee: TPerson): Integer; begin Result := _Employees.IndexOf(Employee); end; +function TCompany.IndexOfSubsidiary(Subsidiary: TCompany): Integer; +begin + Result := _Subsidiaries.IndexOf(Subsidiary); +end; + procedure TCompany.InsertEmployee(Index: Integer; Employee: TPerson); begin _Employees.Insert(Index, Employee); end; +procedure TCompany.InsertSubsidiary(Index: Integer; Subsidiary: TCompany); +begin + _Subsidiaries.Insert(Index, Subsidiary); +end; + function TCompany.RemoveEmployee(Employee: TPerson): Integer; begin Result := _Employees.Remove(Employee); |
|
From: <sr...@us...> - 2006-03-13 21:43:03
|
Revision: 647 Author: srmitch Date: 2006-03-13 13:42:42 -0800 (Mon, 13 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=647&view=rev Log Message: ----------- Update to NexusDB Broker. The modifications mainly apply to the connection dialog of the Remote server version. Modifications to the Embedded version were due to resource string renaming and some extra connection dialog button hints. Main changes: 1. The default Servername 'NexusDB@localhost' has been removed. The default is now an empty string; 2. There is no longer an initial delay when launching the connection dialog as there is no checking of available NexusDB servers until requested via the 'Load Servers' button; 3. The 'Load Servers' speed button has been enlarged and has a caption to make its function more obvious; 4. There is more user feedback in the entry combo boxes to indicate current status. Popup hints are also available on the speed buttons; 5. A bug fix for enablement of the OK button when using alias as path entries. Modified Paths: -------------- trunk/Source/Brokers/NexusDb/InstantNexusDB.pas trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.dfm trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.pas trunk/Source/Brokers/NexusDb/InstantNexusDBConsts.pas trunk/Source/Brokers/NexusDb/InstantNexusDBEmbeddedConnectionDefEdit.dfm trunk/Source/Brokers/NexusDb/InstantNexusDBEmbeddedConnectionDefEdit.pas Modified: trunk/Source/Brokers/NexusDb/InstantNexusDB.pas =================================================================== --- trunk/Source/Brokers/NexusDb/InstantNexusDB.pas 2006-03-12 21:47:50 UTC (rev 646) +++ trunk/Source/Brokers/NexusDb/InstantNexusDB.pas 2006-03-13 21:42:42 UTC (rev 647) @@ -44,7 +44,7 @@ Windows, {$ENDIF} Classes, DB, InstantPersistence, InstantCommand, - nxllTransport, nxsdServerEngine, nxdb, nxsdDataDictionary; + nxptBasePooledTransport, nxsdServerEngine, nxdb, nxsdDataDictionary type TNexusDBTable = class(TnxTable) @@ -55,7 +55,8 @@ procedure SetRecNo(Value: Integer); override; end; - TInstantNexusDBProtocolType = (ptTCPIP, ptNamedPipes); + TInstantNexusDBProtocolType = (ptTCPIP, ptNamedPipes + {$IFNDEF NX1}, ptSharedMemory{$ENDIF}); TInstantNexusDBBaseConnectionDef = class(TInstantRelationalConnectionDef) private @@ -83,10 +84,10 @@ FServerName: string; protected class function CreateServerEngine(aOwner: TComponent; const aServerName: - string; aTransport: TnxBaseTransport): TnxBaseServerEngine; + string; aTransport: TnxBasePooledTransport): TnxBaseServerEngine; class function CreateTransport(aOwner: TComponent; aProtocolType: TInstantNexusDBProtocolType; const aServerName: string; aPort: Integer): - TnxBaseTransport; + TnxBasePooledTransport; procedure InitConnector(Connector: TInstantConnector); override; public constructor Create(Collection: TCollection); override; @@ -177,7 +178,9 @@ protected function GetDelimiters: string; override; function GetQuote: Char; override; +{$IFDEF NX1} function IncludeOrderFields: Boolean; override; +{$ENDIF} end; TInstantNexusDBQuery = class(TInstantSQLQuery) @@ -209,6 +212,10 @@ nxdbBase, nxtwWinsockTransport, nxtnNamedPipeTransport, +{$IFNDEF NX1} + nxpvPlatformImplementation, + nxtmSharedMemoryTransport, +{$ENDIF} nxreRemoteServerEngine, InstantNexusDBCatalog; @@ -279,14 +286,13 @@ constructor TInstantNexusDBConnectionDef.Create(Collection: TCollection); begin inherited; - FServerName := 'NexusDB@localhost'; FPort := 16000; FProtocolType := ptTCPIP; end; { SQL Based ------------------------------------------------------------------ } -{ TInstantNexusDBSQLConnectionDef } +{ TInstantNexusDBConnectionDef } class function TInstantNexusDBConnectionDef.ConnectionTypeName: string; begin @@ -300,7 +306,7 @@ end; class function TInstantNexusDBConnectionDef.CreateServerEngine(aOwner: - TComponent; const aServerName: string; aTransport: TnxBaseTransport): + TComponent; const aServerName: string; aTransport: TnxBasePooledTransport): TnxBaseServerEngine; begin Result := TnxRemoteServerEngine.Create(aOwner); @@ -315,40 +321,27 @@ end; end; -class function TInstantNexusDBConnectionDef.CreateTransport(aOwner: - TComponent; aProtocolType: TInstantNexusDBProtocolType; const aServerName: - string; aPort: Integer): TnxBaseTransport; +class function TInstantNexusDBConnectionDef.CreateTransport(aOwner: TComponent; + aProtocolType: TInstantNexusDBProtocolType; const aServerName: string; + aPort: Integer): TnxBasePooledTransport; begin case aProtocolType of - ptTCPIP: - begin - Result := TnxWinsockTransport.Create(aOwner); - with TnxWinsockTransport(Result) do - try - ServerName := aServerName; - Port := aPort; - Active := True; - except - if Assigned(Result) then - FreeAndNil(Result); - raise; - end; - end; + ptTCPIP : Result := TnxWinsockTransport.Create(aOwner); + ptNamedPipes : Result := TnxNamedPipeTransport.Create(aOwner); + {$IFNDEF NX1} + ptSharedMemory: Result := TnxSharedMemoryTransport.Create(aOwner); + {$ENDIF} + end; - ptNamedPipes: - begin - Result := TnxNamedPipeTransport.Create(aOwner); - with TnxNamedPipeTransport(Result) do - try - ServerName := aServerName; - Port := aPort; - Active := True; - except - if Assigned(Result) then - FreeAndNil(Result); - raise; - end; - end; + with Result do + try + ServerName := aServerName; + Port := aPort; + Active := True; + except + if Assigned(Result) then + FreeAndNil(Result); + raise; end; end; @@ -369,7 +362,7 @@ TInstantConnector); var SavedCursor: TCursor; - Transport: TnxBaseTransport; + Transport: TnxBasePooledTransport; ServerEngine: TnxBaseServerEngine; Session: TnxSession; Database: TnxDatabase; @@ -413,7 +406,7 @@ TInstantNexusDBProtocolType; const aServerName: string; aPort: Integer; aList: TStrings); var - Transport: TnxBaseTransport; + Transport: TnxBasePooledTransport; ServerEngine: TnxBaseServerEngine; Session: TnxSession; begin @@ -439,7 +432,7 @@ class procedure TInstantNexusDBConnectionDef.LoadServerList(aProtocolType: TInstantNexusDBProtocolType; aPort: Integer; aList: TStrings); var - Transport: TnxBaseTransport; + Transport: TnxBasePooledTransport; begin Transport := CreateTransport(nil, aProtocolType, '', aPort); try @@ -450,7 +443,7 @@ end; end; -{ TInstantNexusDBSQLConnector } +{ TInstantNexusDBConnector } procedure TInstantNexusDBConnector.SetSession(Value: TnxSession); begin @@ -693,7 +686,7 @@ Database.Close; end; -{ TInstantNexusDBSQLBroker } +{ TInstantNexusDBBroker } function TInstantNexusDBBroker.GetConnector: TInstantNexusDBConnector; begin @@ -842,10 +835,12 @@ Result := ''''; end; +{$IFDEF NX1} function TInstantNexusDBTranslator.IncludeOrderFields: Boolean; begin Result := True; end; +{$ENDIF} { TInstantNexusDBSQLQuery } Modified: trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.dfm =================================================================== --- trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.dfm 2006-03-12 21:47:50 UTC (rev 646) +++ trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.dfm 2006-03-13 21:42:42 UTC (rev 647) @@ -1,9 +1,9 @@ object InstantNexusDBConnectionDefEditForm: TInstantNexusDBConnectionDefEditForm - Left = 360 - Top = 384 + Left = 246 + Top = 288 BorderStyle = bsDialog Caption = 'NexusDB Connection' - ClientHeight = 340 + ClientHeight = 368 ClientWidth = 506 Color = clBtnFace Font.Charset = DEFAULT_CHARSET @@ -18,7 +18,7 @@ TextHeight = 13 object BottomBevel: TBevel Left = 0 - Top = 303 + Top = 331 Width = 506 Height = 2 Align = alBottom @@ -28,21 +28,22 @@ Left = 0 Top = 0 Width = 506 - Height = 303 + Height = 331 Align = alClient BevelOuter = bvNone BorderWidth = 4 TabOrder = 0 object AliasesLabel: TLabel Left = 8 - Top = 222 + Top = 255 Width = 36 Height = 13 Caption = '&Aliases:' + FocusControl = AliasesCbx end object PathLabel: TLabel Left = 8 - Top = 250 + Top = 283 Width = 25 Height = 13 Caption = '&Path:' @@ -50,7 +51,7 @@ end object ServerLabel: TLabel Left = 8 - Top = 108 + Top = 141 Width = 34 Height = 13 Caption = '&Server:' @@ -58,16 +59,16 @@ end object PortLabel: TLabel Left = 8 - Top = 80 + Top = 113 Width = 70 Height = 13 - Caption = 'Transport Port:' + Caption = 'Transport P&ort:' FocusControl = PortEdit end object NexusDBLogo: TImage - Left = 344 + Left = 348 Top = 8 - Width = 153 + Width = 149 Height = 81 Center = True Picture.Data = { @@ -1149,11 +1150,11 @@ C3D4CBC3D4CBC3D4CBC3F5F3F1FFFFFFE172} end object LoadServersButton: TSpeedButton - Left = 312 - Top = 108 - Width = 23 + Left = 348 + Top = 141 + Width = 149 Height = 21 - Flat = True + Caption = '&Load Servers' Glyph.Data = { 36060000424D3606000000000000360400002800000020000000100000000100 0800000000000002000000000000000000000001000000000000000000000000 @@ -1206,11 +1207,14 @@ FD07F609090909EDFDFDFDFDFDFDFDFDFD08F6F6F6F6F607FDFDFDFDFDFDFDFD FDFDEDED0909FDFDFDFDFDFDFDFDFDFDFDFD07070808FDFDFDFD} NumGlyphs = 2 + ParentShowHint = False + ShowHint = True + Spacing = 8 OnClick = LoadServersButtonClick end object LoadAliasesButton: TSpeedButton Left = 312 - Top = 220 + Top = 253 Width = 23 Height = 21 Flat = True @@ -1266,11 +1270,13 @@ FD07F609090909EDFDFDFDFDFDFDFDFDFD08F6F6F6F6F607FDFDFDFDFDFDFDFD FDFDEDED0909FDFDFDFDFDFDFDFDFDFDFDFD07070808FDFDFDFD} NumGlyphs = 2 + ParentShowHint = False + ShowHint = True OnClick = LoadAliasesButtonClick end object BrowseButton: TSpeedButton Left = 312 - Top = 268 + Top = 301 Width = 23 Height = 21 Flat = True @@ -1326,11 +1332,13 @@ FD07F609090909EDFDFDFDFDFDFDFDFDFD08F6F6F6F6F607FDFDFDFDFDFDFDFD FDFDEDED0909FDFDFDFDFDFDFDFDFDFDFDFD07070808FDFDFDFD} NumGlyphs = 2 + ParentShowHint = False + ShowHint = True OnClick = BrowseButtonClick end object StreamFormatLabel: TLabel Left = 348 - Top = 140 + Top = 173 Width = 56 Height = 13 Caption = 'Blob &format:' @@ -1338,7 +1346,7 @@ end object DatabaseRadGrp: TRadioGroup Left = 8 - Top = 138 + Top = 171 Width = 329 Height = 73 Caption = '&Database Access Type' @@ -1347,18 +1355,19 @@ 'Alias' 'Path (NOTE: This is a path on the server!)') TabOrder = 4 + TabStop = True end object ServersCbx: TComboBox Left = 96 - Top = 108 - Width = 217 + Top = 141 + Width = 241 Height = 21 ItemHeight = 13 TabOrder = 3 end object PathEdit: TEdit Left = 8 - Top = 268 + Top = 301 Width = 305 Height = 21 TabOrder = 6 @@ -1367,17 +1376,19 @@ Left = 8 Top = 8 Width = 329 - Height = 65 - Caption = 'Transport Type' + Height = 81 + Caption = '&Transport Type' ItemIndex = 0 Items.Strings = ( 'TCP/IP' - 'Named Pipes (Windows NT and higher only)') + 'Named Pipes (Windows NT and higher only)' + 'Shared Memory') TabOrder = 0 + TabStop = True end object PortEdit: TEdit Left = 96 - Top = 80 + Top = 113 Width = 49 Height = 21 TabOrder = 1 @@ -1385,7 +1396,7 @@ end object PortUpDown: TUpDown Left = 145 - Top = 80 + Top = 113 Width = 16 Height = 21 Associate = PortEdit @@ -1393,11 +1404,13 @@ Max = 32767 Position = 16000 TabOrder = 2 + TabStop = True Thousands = False + Wrap = False end object AliasesCbx: TComboBox Left = 96 - Top = 220 + Top = 253 Width = 217 Height = 21 ItemHeight = 13 @@ -1405,7 +1418,7 @@ end object StreamFormatComboBox: TComboBox Left = 348 - Top = 156 + Top = 189 Width = 149 Height = 21 Style = csDropDownList @@ -1415,17 +1428,17 @@ end object IDGroupBox: TGroupBox Left = 348 - Top = 188 + Top = 221 Width = 149 Height = 103 - Caption = 'Object ID' + Caption = 'Object &ID' TabOrder = 8 object lblIdDataType: TLabel Left = 13 Top = 24 Width = 53 Height = 13 - Caption = 'Data Type:' + Caption = 'Data T&ype:' FocusControl = IdDataTypeComboBox end object lblIdSize: TLabel @@ -1433,8 +1446,8 @@ Top = 72 Width = 23 Height = 13 - Caption = 'Size:' - FocusControl = IdDataTypeComboBox + Caption = 'Si&ze:' + FocusControl = IdSizeEdit end object IdDataTypeComboBox: TComboBox Left = 13 @@ -1456,15 +1469,12 @@ end object BottomPanel: TPanel Left = 0 - Top = 305 + Top = 333 Width = 506 Height = 35 Align = alBottom BevelOuter = bvNone TabOrder = 1 - DesignSize = ( - 506 - 35) object OkButton: TButton Left = 348 Top = 6 Modified: trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.pas =================================================================== --- trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.pas 2006-03-12 21:47:50 UTC (rev 646) +++ trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.pas 2006-03-13 21:42:42 UTC (rev 647) @@ -135,14 +135,14 @@ begin inherited; LoadServersButton.Enabled := TransportTypeRadGrp.Enabled; - AliasesCbx.Enabled := not AliasIsPath; + AliasesCbx.Enabled := not AliasIsPath and ServersCbx.Enabled; LoadAliasesButton.Enabled := AliasesCbx.Enabled; - PathEdit.Enabled := AliasIsPath; + PathEdit.Enabled := AliasIsPath and ServersCbx.Enabled; BrowseButton.Enabled := PathEdit.Enabled; OkButton.Enabled := - (not AliasIsPath or (AliasIsPath and DirectoryExists(Alias))) and - (ServerName > '') and - (Alias > ''); + (ServerName <> '') and + ((not AliasIsPath and (Alias <> '')) or + (AliasIsPath and DirectoryExists(Alias))); end; type @@ -267,6 +267,9 @@ var SavedCursor: TCursor; begin + if ServerName = '' then + Exit; + try SavedCursor := Screen.Cursor; try @@ -295,22 +298,28 @@ Self.ProtocolType := ProtocolType; Self.Port := Port; - Self.LoadServers(ServersCbx.Items); + Self.ServerName := ServerName; if ServerName <> '' then begin - Self.ServerName := ServerName; + ServersCbx.Items.Add(ServerName); + ServersCbx.ItemIndex := ServersCbx.Items.IndexOf(ServerName); + Self.LoadAliases(AliasesCbx.Items); Self.AliasIsPath := AliasIsPath; Self.Alias := Alias; + end + else + begin + ServersCbx.Text := SNone; + ServersCbx.Enabled := False; + AliasesCbx.Text := SNone; end; - // Begin SRM - 14 Mar 2005 StreamFormatComboBox.ItemIndex := Ord(ConnectionDef.BlobStreamFormat); IdDataTypeComboBox.ItemIndex := Ord(ConnectionDef.IdDataType); IdSizeEdit.Text := IntToStr(ConnectionDef.IdSize); - // End SRM - 14 Mar 2005 end; finally Screen.Cursor := SavedCursor; @@ -328,29 +337,55 @@ Alias := Self.Alias; AliasIsPath := Self.AliasIsPath; - // Begin SRM - 14 Mar 2005 ConnectionDef.BlobStreamFormat := TInstantStreamFormat(StreamFormatComboBox.ItemIndex); ConnectionDef.IdDataType := TInstantDataType(IdDataTypeComboBox.ItemIndex); ConnectionDef.IdSize := StrToInt(IdSizeEdit.Text); - // End SRM - 14 Mar 2005 end; end; procedure TInstantNexusDBConnectionDefEditForm.LoadServersButtonClick( Sender: TObject); begin + ServersCbx.Clear; + ServersCbx.Text := SLoadingServers; + ServersCbx.Refresh; + LoadServers(ServersCbx.Items); - with ServersCbx, Items do - ItemIndex := IndexOf(ServerName); + + AliasesCbx.Clear; + AliasesCbx.Text := SNone; + AliasesCbx.Refresh; + + ServersCbx.Enabled := True; + if (ServerName <> '') then + ServersCbx.ItemIndex := ServersCbx.Items.IndexOf(ServerName); + + if (ServersCbx.Items.Count > 0) and (ServersCbx.ItemIndex < 0) then + ServersCbx.Text := SSelectServerFromList + else + begin + ServersCbx.Text := SNone; + ServersCbx.Enabled := False; + end; end; procedure TInstantNexusDBConnectionDefEditForm.LoadAliasesButtonClick( Sender: TObject); begin + AliasesCbx.Clear; + AliasesCbx.Text := SLoadingAliases; + AliasesCbx.Refresh; + LoadAliases(AliasesCbx.Items); - with AliasesCbx, Items do - ItemIndex := IndexOf(Alias); + + if (Alias <> '') then + AliasesCbx.ItemIndex := AliasesCbx.Items.IndexOf(Alias); + + if (AliasesCbx.Items.Count > 0) and (AliasesCbx.ItemIndex < 0) then + AliasesCbx.Text := SSelectAliasFromList + else + AliasesCbx.Text := SNone; end; procedure TInstantNexusDBConnectionDefEditForm.BrowseButtonClick( @@ -359,18 +394,24 @@ AliasDir: string; begin AliasDir := Alias; - if SelectDirectory(SSelectAnAliasPathPlease, '', AliasDir) then + if SelectDirectory(SSelectAnAliasPath, '', AliasDir) then Alias := AliasDir; end; procedure TInstantNexusDBConnectionDefEditForm.FormCreate(Sender: TObject); begin - // Begin SRM - 14 Mar 2005 + LoadServersButton.Hint := SLoadAvailableNexusDBServers; + LoadAliasesButton.Hint := SLoadAvailableAliases; + BrowseButton.Hint := SSelectAnAliasPath; + AssignInstantStreamFormat(StreamFormatComboBox.Items); AssignInstantDataTypeStrings(IdDataTypeComboBox.Items); IdDataTypeComboBox.ItemIndex := Ord(dtString); IdSizeEdit.Text := IntToStr(InstantDefaultFieldSize); - // End SRM - 14 Mar 2005 + + {$IFDEF NX1} + TransportTypeRadGrp.Items.Delete(Pred(TransportTypeRadGrp.Items.Count)); + {$ENDIF} end; end. Modified: trunk/Source/Brokers/NexusDb/InstantNexusDBConsts.pas =================================================================== --- trunk/Source/Brokers/NexusDb/InstantNexusDBConsts.pas 2006-03-12 21:47:50 UTC (rev 646) +++ trunk/Source/Brokers/NexusDb/InstantNexusDBConsts.pas 2006-03-13 21:42:42 UTC (rev 647) @@ -24,8 +24,8 @@ * the Initial Developer. All Rights Reserved. * * Contributor(s): + * Steven Mitchell * - * * ***** END LICENSE BLOCK ***** *) unit InstantNexusDBConsts; @@ -40,7 +40,14 @@ interface resourcestring - SSelectAnAliasPathPlease = 'Select an alias path please ...'; + SLoadAvailableAliases = 'Load available aliases'; + SLoadAvailableNexusDBServers = 'Load available NexusDB servers'; + SLoadingAliases = 'Loading Aliases ...'; + SLoadingServers = 'Loading Servers ...'; + SNone = '[None]'; + SSelectAliasFromList = '[Select an alias from the list]'; + SSelectAnAliasPath = 'Select an alias path'; + SSelectServerFromList = '[Select a server from the list]'; implementation Modified: trunk/Source/Brokers/NexusDb/InstantNexusDBEmbeddedConnectionDefEdit.dfm =================================================================== --- trunk/Source/Brokers/NexusDb/InstantNexusDBEmbeddedConnectionDefEdit.dfm 2006-03-12 21:47:50 UTC (rev 646) +++ trunk/Source/Brokers/NexusDb/InstantNexusDBEmbeddedConnectionDefEdit.dfm 2006-03-13 21:42:42 UTC (rev 647) @@ -1,6 +1,6 @@ object InstantNexusDBEmbeddedConnectionDefEditForm: TInstantNexusDBEmbeddedConnectionDefEditForm - Left = 1633 - Top = 436 + Left = 475 + Top = 389 BorderStyle = bsDialog Caption = 'NexusDB Embedded Connection' ClientHeight = 275 Modified: trunk/Source/Brokers/NexusDb/InstantNexusDBEmbeddedConnectionDefEdit.pas =================================================================== --- trunk/Source/Brokers/NexusDb/InstantNexusDBEmbeddedConnectionDefEdit.pas 2006-03-12 21:47:50 UTC (rev 646) +++ trunk/Source/Brokers/NexusDb/InstantNexusDBEmbeddedConnectionDefEdit.pas 2006-03-13 21:42:42 UTC (rev 647) @@ -191,11 +191,9 @@ Self.AliasIsPath := AliasIsPath; Self.Alias := Alias; - // Begin SRM - 14 Mar 2005 StreamFormatComboBox.ItemIndex := Ord(ConnectionDef.BlobStreamFormat); IdDataTypeComboBox.ItemIndex := Ord(ConnectionDef.IdDataType); IdSizeEdit.Text := IntToStr(ConnectionDef.IdSize); - // End SRM - 14 Mar 2005 end; finally Screen.Cursor := SavedCursor; @@ -210,12 +208,10 @@ Alias := Self.Alias; AliasIsPath := Self.AliasIsPath; - // Begin SRM - 14 Mar 2005 ConnectionDef.BlobStreamFormat := TInstantStreamFormat(StreamFormatComboBox.ItemIndex); ConnectionDef.IdDataType := TInstantDataType(IdDataTypeComboBox.ItemIndex); ConnectionDef.IdSize := StrToInt(IdSizeEdit.Text); - // End SRM - 14 Mar 2005 end; end; @@ -233,19 +229,20 @@ AliasDir: string; begin AliasDir := Alias; - if SelectDirectory(SSelectAnAliasPathPlease, '', AliasDir) then + if SelectDirectory(SSelectAnAliasPath, '', AliasDir) then Alias := AliasDir; end; procedure TInstantNexusDBEmbeddedConnectionDefEditForm.FormCreate(Sender: TObject); begin - // Begin SRM - 14 Mar 2005 + LoadAliasesButton.Hint := SLoadAvailableAliases; + BrowseButton.Hint := SSelectAnAliasPath; + AssignInstantStreamFormat(StreamFormatComboBox.Items); AssignInstantDataTypeStrings(IdDataTypeComboBox.Items); IdDataTypeComboBox.ItemIndex := Ord(dtString); IdSizeEdit.Text := IntToStr(InstantDefaultFieldSize); - // End SRM - 14 Mar 2005 end; end. |
|
From: <sr...@us...> - 2006-03-12 21:48:09
|
Revision: 646 Author: srmitch Date: 2006-03-12 13:47:50 -0800 (Sun, 12 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=646&view=rev Log Message: ----------- Added back MinimalModel.pas that was mistakenly deleted from test suite. Added Paths: ----------- trunk/Source/Tests/MinimalModel.pas Added: trunk/Source/Tests/MinimalModel.pas =================================================================== --- trunk/Source/Tests/MinimalModel.pas (rev 0) +++ trunk/Source/Tests/MinimalModel.pas 2006-03-12 21:47:50 UTC (rev 646) @@ -0,0 +1,111 @@ +(* + * 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. |
|
From: <jcm...@us...> - 2006-03-12 20:17:51
|
Revision: 645 Author: jcmoraisjr Date: 2006-03-12 12:17:39 -0800 (Sun, 12 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=645&view=rev Log Message: ----------- Fixed bug [1446833] - Currency fields receives odd values. Modified Paths: -------------- trunk/Source/Core/InstantPresentation.pas Modified: trunk/Source/Core/InstantPresentation.pas =================================================================== --- trunk/Source/Core/InstantPresentation.pas 2006-03-11 09:13:45 UTC (rev 644) +++ trunk/Source/Core/InstantPresentation.pas 2006-03-12 20:17:39 UTC (rev 645) @@ -3917,6 +3917,7 @@ ftBCD: begin Move(Buffer^, Bcd, SizeOf(Bcd)); + C := 0; BCDToCurr(Bcd,C); Value := C; end; |
|
From: <sr...@us...> - 2006-03-11 09:13:58
|
Revision: 644 Author: srmitch Date: 2006-03-11 01:13:45 -0800 (Sat, 11 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=644&view=rev Log Message: ----------- Changes related to D5 bugs and compatibility: 1. Fixed bugs [SF #1447789] in InstantRtti.pas related to compilation and handling of Boolean type in private unit function AccessProperty; 2. Bug fix [SF #1447794] for ObjectFoundry - Added Windows unit to Interface uses clause in OPFExpert.pas so that ObjectFoundry can be built in D5. Also removed Windows unit from Implementation uses clause as it's not needed. Modified Paths: -------------- trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.dfm trunk/Source/Core/InstantRtti.pas trunk/Source/ObjectFoundry/OFExpert.pas Modified: trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.dfm =================================================================== --- trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.dfm 2006-03-10 10:56:53 UTC (rev 643) +++ trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.dfm 2006-03-11 09:13:45 UTC (rev 644) @@ -1,6 +1,6 @@ object InstantNexusDBConnectionDefEditForm: TInstantNexusDBConnectionDefEditForm - Left = 1622 - Top = 49 + Left = 360 + Top = 384 BorderStyle = bsDialog Caption = 'NexusDB Connection' ClientHeight = 340 Modified: trunk/Source/Core/InstantRtti.pas =================================================================== --- trunk/Source/Core/InstantRtti.pas 2006-03-10 10:56:53 UTC (rev 643) +++ trunk/Source/Core/InstantRtti.pas 2006-03-11 09:13:45 UTC (rev 644) @@ -125,10 +125,15 @@ begin {$IFDEF D6+} if VarIsStr(Value) and (VarToStr(Value) = '') then + Value := 0; {$ELSE} - if Value = '' then + case VarType(Value) of + varString : if VarToStr(Value) = '' then + Value := 0; + varBoolean: if (VarToStr(Value) <> '0') then + Value := 1; + end; {$ENDIF} - Value := 0; SetPropValue(AObject, PropInfo^.Name, Value); end; tkSet: Modified: trunk/Source/ObjectFoundry/OFExpert.pas =================================================================== --- trunk/Source/ObjectFoundry/OFExpert.pas 2006-03-10 10:56:53 UTC (rev 643) +++ trunk/Source/ObjectFoundry/OFExpert.pas 2006-03-11 09:13:45 UTC (rev 644) @@ -33,7 +33,11 @@ interface uses - Classes, MMIOAPI, OFOptions, SysUtils, MMToolsAPI, OFDefs; + Classes, + {$IFDEF VER130} + Windows, // Need in D5 for definition of THandle + {$ENDIF} + MMIOAPI, OFOptions, SysUtils, MMToolsAPI, OFDefs; type TObjectFoundryExpert = class(TInterfacedObject, IUnknown, IMMExpert, IInstantObjectsExpert) @@ -87,7 +91,7 @@ implementation uses - Contnrs, Windows, OFClasses, OFUtils, OFCritic, InstantAttributeEditor, + Contnrs, OFClasses, OFUtils, OFCritic, InstantAttributeEditor, InstantPersistence, InstantCode, Forms, Controls, Menus, MMEngineDefs, OFClassRegWizard, InstantDesignUtils; |
|
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] |
|
From: <jcm...@us...> - 2006-03-10 00:40:59
|
Revision: 641 Author: jcmoraisjr Date: 2006-03-09 16:40:50 -0800 (Thu, 09 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=641&view=rev Log Message: ----------- Added compiler directive to the IBX's AutoStopAction property, due to problems with IBX 5.x. Modified Paths: -------------- trunk/Source/Brokers/IBX/InstantIBX.pas Modified: trunk/Source/Brokers/IBX/InstantIBX.pas =================================================================== --- trunk/Source/Brokers/IBX/InstantIBX.pas 2006-03-09 12:44:27 UTC (rev 640) +++ trunk/Source/Brokers/IBX/InstantIBX.pas 2006-03-10 00:40:50 UTC (rev 641) @@ -244,7 +244,10 @@ try FTransaction.DefaultDatabase := Connection; FTransaction.Params.Add('read_committed'); + {$IFDEF D6+} + // AutoStopAction property from IBX 5.x is broken FTransaction.AutoStopAction := saCommit; + {$ENDIF} except FreeAndNil(FTransaction); raise; |
|
From: <jcm...@us...> - 2006-02-28 17:59:41
|
Revision: 638 Author: jcmoraisjr Date: 2006-02-28 09:59:30 -0800 (Tue, 28 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=638&view=rev Log Message: ----------- Fixed bug # 1439091 - Exposer.AddObject duplicating object (sorted lists) Modified Paths: -------------- trunk/Source/Core/InstantPresentation.pas Modified: trunk/Source/Core/InstantPresentation.pas =================================================================== --- trunk/Source/Core/InstantPresentation.pas 2006-02-28 13:37:37 UTC (rev 637) +++ trunk/Source/Core/InstantPresentation.pas 2006-02-28 17:59:30 UTC (rev 638) @@ -1001,8 +1001,6 @@ function TInstantAccessor.AddObject(AObject: TObject): Integer; begin Result := InternalAddObject(AObject); - if Altered then - Result := AddToView(AObject); ChangedData; end; @@ -1307,8 +1305,6 @@ AObject: TObject): Integer; begin Result := InternalInsertObject(Index, AObject); - if Altered then - Result := InsertInView(Index, AObject); ChangedData; end; @@ -1453,8 +1449,6 @@ function TInstantAccessor.RemoveObject(AObject: TObject): Integer; begin Result := InternalRemoveObject(AObject); - if Altered then - Result := RemoveFromView(AObject); ChangedData; end; |
