Menu
▾
▴
instantobjects-cvscommit
|
From: <na...@us...> - 2006-02-13 07:10:20
|
Revision: 584 Author: nandod Date: 2006-02-12 23:09:19 -0800 (Sun, 12 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=584&view=rev Log Message: ----------- unsupported column types no longer stop the build/evolution process. Modified Paths: -------------- trunk/Source/Brokers/BDE/InstantBDECatalog.pas trunk/Source/Brokers/ZeosDBO/InstantZeosDBO.pas trunk/Source/Brokers/ZeosDBO/InstantZeosDBOCatalog.pas trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas trunk/Source/Core/InstantConsts.pas trunk/Source/Core/InstantCustomDBEvolverFormUnit.pas trunk/Source/Core/InstantDBBuild.pas trunk/Source/Core/InstantDBEvolution.pas trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Brokers/BDE/InstantBDECatalog.pas =================================================================== --- trunk/Source/Brokers/BDE/InstantBDECatalog.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Brokers/BDE/InstantBDECatalog.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -23,7 +23,7 @@ * Portions created by the Initial Developer are Copyright (C) 2005 * the Initial Developer. All Rights Reserved. * - * Contributor(s): + * Contributor(s): Nando Dessena * * ***** END LICENSE BLOCK ***** *) @@ -48,7 +48,8 @@ procedure AddFieldMetadatas(TableMetadata: TInstantTableMetadata); procedure AddIndexMetadatas(TableMetadata: TInstantTableMetadata); procedure AddTableMetadatas(TableMetadatas: TInstantTableMetadatas); - function ColumnTypeToDataType(const ColumnType: TFieldType): TInstantDataType; + function ColumnTypeToDataType(const ColumnType: TFieldType; + out DataType: TInstantDataType): Boolean; public procedure InitTableMetadatas(ATableMetadatas: TInstantTableMetadatas); override; @@ -65,6 +66,7 @@ vTable: TTable; FieldMetadata: TInstantFieldMetadata; i: Integer; + FieldDataType: TInstantDataType; begin vTable := TTable.Create(nil); try @@ -73,17 +75,24 @@ vTable.FieldDefs.Update; for i := 0 to Pred(vTable.FieldDefs.Count) do begin - FieldMetadata := TableMetadata.FieldMetadatas.Add; - FieldMetadata.Name := Trim(vTable.FieldDefs[i].Name); - FieldMetadata.DataType := ColumnTypeToDataType(vTable.FieldDefs[i].DataType); - FieldMetadata.Options := []; - if vTable.FieldDefs[i].Required then - FieldMetadata.Options := FieldMetadata.Options + [foRequired]; - if TableMetadata.IndexMetadatas.IsFieldIndexed(FieldMetadata) then - FieldMetadata.Options := FieldMetadata.Options + [foIndexed]; - { TODO : support ExternalTableName? } - if FieldMetadata.DataType in [dtString, dtMemo] then - FieldMetadata.Size := vTable.FieldDefs[i].Size; + if ColumnTypeToDataType(vTable.FieldDefs[i].DataType, FieldDataType) then + begin + FieldMetadata := TableMetadata.FieldMetadatas.Add; + FieldMetadata.Name := vTable.FieldDefs[i].Name; + FieldMetadata.DataType := FieldDataType; + FieldMetadata.Options := []; + if vTable.FieldDefs[i].Required then + FieldMetadata.Options := FieldMetadata.Options + [foRequired]; + if TableMetadata.IndexMetadatas.IsFieldIndexed(FieldMetadata) then + FieldMetadata.Options := FieldMetadata.Options + [foIndexed]; + { TODO : support ExternalTableName? } + if FieldMetadata.DataType in [dtString, dtMemo] then + FieldMetadata.Size := vTable.FieldDefs[i].Size; + end + else + DoWarning(Format(SUnsupportedColumnSkipped, [ + TableMetadata.Name, vTable.FieldDefs[i].Name, + GetEnumName(TypeInfo(TFieldType), Ord(vTable.FieldDefs[i].DataType))])); end; finally vTable.Free; @@ -109,10 +118,10 @@ begin IndexMetadata := TableMetadata.IndexMetadatas.Add; if ixPrimary in vTable.IndexDefs[i].Options then - IndexMetadata.Name := Trim(vTable.IndexDefs[i].Name) + IndexMetadata.Name := vTable.IndexDefs[i].Name else IndexMetadata.Name := ChangeFileExt(vTable.TableName, '') - + Trim(vTable.IndexDefs[i].Name); + + vTable.IndexDefs[i].Name; IndexMetadata.Fields := vTable.IndexDefs[i].Fields; IndexMetadata.Options := vTable.IndexDefs[i].Options; end; @@ -136,7 +145,7 @@ Session.GetTableNames(vDatabaseName, '*.*', true, false, vTables); for i := 0 to Pred(vTables.Count) do begin - vTableName := ExtractFileName(Trim(vTables.Strings[i])); + vTableName := ExtractFileName(vTables.Strings[i]); TableMetadata := TableMetadatas.Add; TableMetadata.Name := vTableName; // Call AddIndexMetadatas first, so that AddFieldMetadatas can see what @@ -150,26 +159,26 @@ end; end; -function TInstantBDECatalog.ColumnTypeToDataType(const ColumnType: TFieldType): - TInstantDataType; +function TInstantBDECatalog.ColumnTypeToDataType(const ColumnType: TFieldType; + out DataType: TInstantDataType): Boolean; begin + Result := True; case ColumnType of - ftString: Result := dtString; + ftString: DataType := dtString; ftSmallint, - ftInteger: Result := dtInteger; - ftBoolean: Result := dtBoolean; - ftFloat: Result := dtFloat; - ftCurrency: Result := dtCurrency; + ftInteger: DataType := dtInteger; + ftBoolean: DataType := dtBoolean; + ftFloat: DataType := dtFloat; + ftCurrency: DataType := dtCurrency; ftDate, ftTime, - ftDateTime: Result := dtDateTime; - ftAutoInc: Result := dtInteger; + ftDateTime: DataType := dtDateTime; + ftAutoInc: DataType := dtInteger; ftBlob, - ftGraphic: Result := dtBlob; - ftMemo: Result := dtMemo; + ftGraphic: DataType := dtBlob; + ftMemo: DataType := dtMemo; else - raise Exception.CreateFmt(SUnsupportedColumnType, - [GetEnumName(TypeInfo(TFieldType), Ord(ColumnType))]); + Result := False; end; end; Modified: trunk/Source/Brokers/ZeosDBO/InstantZeosDBO.pas =================================================================== --- trunk/Source/Brokers/ZeosDBO/InstantZeosDBO.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Brokers/ZeosDBO/InstantZeosDBO.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -1148,7 +1148,7 @@ if not Assigned(FOldTableMetadata) then begin //Force to read the table from database - FScheme := Broker.ReadDatabaseScheme; + FScheme := Broker.ReadDatabaseScheme(nil); FieldMetadata := nil; case CommandType of Modified: trunk/Source/Brokers/ZeosDBO/InstantZeosDBOCatalog.pas =================================================================== --- trunk/Source/Brokers/ZeosDBO/InstantZeosDBOCatalog.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Brokers/ZeosDBO/InstantZeosDBOCatalog.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -49,7 +49,8 @@ procedure AddIndexMetadatas(TableMetadata: TInstantTableMetadata); procedure AddTableMetadatas(TableMetadatas: TInstantTableMetadatas); function ColumnTypeToDataType(const ColumnType: TZSQLType; - out AlternateDataTypes: TInstantDataTypes): TInstantDataType; + out DataType: TInstantDataType; + out AlternateDataTypes: TInstantDataTypes): Boolean; function GetBroker: TInstantZeosDBOBroker; function GetConnector: TInstantZeosDBOConnector; public @@ -70,7 +71,8 @@ var Fields: IZResultSet; FieldMetadata: TInstantFieldMetadata; - AlternateDatatypes: TInstantDataTypes; + FieldDataType: TInstantDataType; + FieldAlternateDataTypes: TInstantDataTypes; begin with Connector.Connection do Fields := DbcConnection.GetMetadata.GetColumns(Catalog, '', @@ -79,24 +81,30 @@ Fields.BeforeFirst; while Fields.Next do begin - FieldMetadata := TableMetadata.FieldMetadatas.Add; - FieldMetadata.Name := Fields.GetStringByName('COLUMN_NAME'); - FieldMetadata.DataType := - ColumnTypeToDataType(TZSQLType(Fields.GetShortByName('DATA_TYPE')), - AlternateDataTypes); - FieldMetadata.AlternateDataTypes := AlternateDataTypes; - FieldMetadata.Options := []; - if not Fields.GetBooleanByName('IS_NULLABLE') then - FieldMetadata.Options := FieldMetadata.Options + [foRequired]; - if TableMetadata.IndexMetadatas.IsFieldIndexed(FieldMetadata) then - FieldMetadata.Options := FieldMetadata.Options + [foIndexed]; - // work around bug in GetColumns for all drivers where - // CHAR_OCTET_LENGTH is not assigned - if (FieldMetadata.DataType in [dtString, dtMemo]) and - (Fields.GetIntByName('CHAR_OCTET_LENGTH') > 0) then - FieldMetadata.Size := Fields.GetIntByName('CHAR_OCTET_LENGTH') + if ColumnTypeToDataType(TZSQLType(Fields.GetShortByName('DATA_TYPE')), + FieldDataType, FieldAlternateDataTypes) then + begin + FieldMetadata := TableMetadata.FieldMetadatas.Add; + FieldMetadata.Name := Fields.GetStringByName('COLUMN_NAME'); + FieldMetadata.DataType := FieldDataType; + FieldMetadata.AlternateDataTypes := FieldAlternateDataTypes; + FieldMetadata.Options := []; + if not Fields.GetBooleanByName('IS_NULLABLE') then + FieldMetadata.Options := FieldMetadata.Options + [foRequired]; + if TableMetadata.IndexMetadatas.IsFieldIndexed(FieldMetadata) then + FieldMetadata.Options := FieldMetadata.Options + [foIndexed]; + // work around bug in GetColumns for all drivers where + // CHAR_OCTET_LENGTH is not assigned + if (FieldMetadata.DataType in [dtString, dtMemo]) and + (Fields.GetIntByName('CHAR_OCTET_LENGTH') > 0) then + FieldMetadata.Size := Fields.GetIntByName('CHAR_OCTET_LENGTH') + else + FieldMetadata.Size := Fields.GetIntByName('COLUMN_SIZE'); + end else - FieldMetadata.Size := Fields.GetIntByName('COLUMN_SIZE'); + DoWarning(Format(SUnsupportedColumnSkipped, [ + TableMetadata.Name, Fields.GetStringByName('COLUMN_NAME'), + GetEnumName(TypeInfo(TZSQLType), Fields.GetShortByName('DATA_TYPE'))])); end; end; @@ -191,39 +199,40 @@ end; end; -function TInstantZeosDBOCatalog.ColumnTypeToDataType(const ColumnType: - TZSQLType; out AlternateDataTypes: TInstantDataTypes): TInstantDataType; +function TInstantZeosDBOCatalog.ColumnTypeToDataType(const ColumnType: TZSQLType; + out DataType: TInstantDataType; + out AlternateDataTypes: TInstantDataTypes): Boolean; begin + Result := True; AlternateDataTypes := []; case ColumnType of stString, - stUnicodeString: Result := dtString; - stBoolean: Result := dtBoolean; + stUnicodeString: DataType := dtString; + stBoolean: DataType := dtBoolean; stShort: begin - Result := dtBoolean; + DataType := dtBoolean; Include(AlternateDataTypes, dtInteger); end; stByte, stInteger, - stLong: Result := dtInteger; + stLong: DataType := dtInteger; stFloat, stDouble: begin - Result := dtFloat; + DataType := dtFloat; Include(AlternateDataTypes, dtCurrency); end; - stBigDecimal: Result := dtCurrency; + stBigDecimal: DataType := dtCurrency; stDate, stTime, - stTimeStamp: Result := dtDateTime; + stTimeStamp: DataType := dtDateTime; stBytes, - stBinaryStream: Result := dtBlob; + stBinaryStream: DataType := dtBlob; stAsciiStream, - stUnicodeStream: Result := dtMemo; + stUnicodeStream: DataType := dtMemo; else - raise EInstantError.CreateFmt(SUnsupportedColumnType, - [GetEnumName(TypeInfo(TZSQLType), Ord(ColumnType))]); + Result := False; end; end; Modified: trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas =================================================================== --- trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -49,7 +49,8 @@ procedure AddIndexMetadatas(TableMetadata: TInstantTableMetadata); procedure AddTableMetadatas(TableMetadatas: TInstantTableMetadatas); function ColumnTypeToDataType(const ColumnType: string; - const ColumnSubType, FieldScale: Integer): TInstantDataType; + const ColumnSubType, FieldScale: Integer; + out DataType: TInstantDataType): Boolean; function GetSelectFieldsSQL(const ATableName: string): string; function GetSelectIndexesSQL(const ATableName: string): string; function GetSelectIndexFieldsSQL(const AIndexName: string): string; @@ -90,7 +91,7 @@ try while not IndexFields.Eof do begin - IndexFieldList.Add(Trim(IndexFields.FieldByName('COLUMN_NAME').AsString)); + IndexFieldList.Add(IndexFields.FieldByName('COLUMN_NAME').AsString); IndexFields.Next; end; finally @@ -114,7 +115,7 @@ while not Indexes.Eof do begin IndexMetadata := TableMetadata.IndexMetadatas.Add; - IndexMetadata.Name := Trim(Indexes.FieldByName('INDEX_NAME').AsString); + IndexMetadata.Name := Indexes.FieldByName('INDEX_NAME').AsString; IndexMetadata.Fields := GetIndexFields(IndexMetadata.Name); IndexMetadata.Options := []; @@ -141,6 +142,7 @@ var Fields: TDataSet; FieldMetadata: TInstantFieldMetadata; + FieldDataType: TInstantDataType; begin Fields := Broker.AcquireDataSet(GetSelectFieldsSQL(TableMetadata.Name)); try @@ -148,18 +150,25 @@ try while not Fields.Eof do begin - FieldMetadata := TableMetadata.FieldMetadatas.Add; - FieldMetadata.Name := Trim(Fields.FieldByName('COLUMN_NAME').AsString); - FieldMetadata.DataType := ColumnTypeToDataType( - Trim(Fields.FieldByName('COLUMN_TYPENAME').AsString), + if ColumnTypeToDataType( + Fields.FieldByName('COLUMN_TYPENAME').AsString, Fields.FieldByName('COLUMN_SUBTYPE').AsInteger, - Fields.FieldByName('COLUMN_SCALE').AsInteger); - FieldMetadata.Options := []; - if Fields.FieldByName('COLUMN_NULLABLE').AsInteger <> 1 then - FieldMetadata.Options := FieldMetadata.Options + [foRequired]; - if TableMetadata.IndexMetadatas.IsFieldIndexed(FieldMetadata) then - FieldMetadata.Options := FieldMetadata.Options + [foIndexed]; - FieldMetadata.Size := Fields.FieldByName('COLUMN_LENGTH').AsInteger; + Fields.FieldByName('COLUMN_SCALE').AsInteger, FieldDataType) then + begin + FieldMetadata := TableMetadata.FieldMetadatas.Add; + FieldMetadata.Name := Fields.FieldByName('COLUMN_NAME').AsString; + FieldMetadata.DataType := FieldDataType; + FieldMetadata.Options := []; + if Fields.FieldByName('COLUMN_NULLABLE').AsInteger <> 1 then + FieldMetadata.Options := FieldMetadata.Options + [foRequired]; + if TableMetadata.IndexMetadatas.IsFieldIndexed(FieldMetadata) then + FieldMetadata.Options := FieldMetadata.Options + [foIndexed]; + FieldMetadata.Size := Fields.FieldByName('COLUMN_LENGTH').AsInteger; + end + else + DoWarning(Format(SUnsupportedColumnSkipped, [ + TableMetadata.Name, Fields.FieldByName('COLUMN_NAME').AsString, + Fields.FieldByName('COLUMN_TYPENAME').AsString])); Fields.Next; end; finally @@ -183,7 +192,7 @@ while not Tables.Eof do begin TableMetadata := TableMetadatas.Add; - TableMetadata.Name := Trim(Tables.FieldByName('TABLE_NAME').AsString); + TableMetadata.Name := Tables.FieldByName('TABLE_NAME').AsString; // Call AddIndexMetadatas first, so that AddFieldMetadatas can see what // indexes are defined to correctly set the foIndexed option. AddIndexMetadatas(TableMetadata); @@ -199,26 +208,28 @@ end; function TInstantMSSqlCatalog.ColumnTypeToDataType(const ColumnType: string; - const ColumnSubType, FieldScale: Integer): TInstantDataType; + const ColumnSubType, FieldScale: Integer; + out DataType: TInstantDataType): Boolean; begin + Result := True; if SameText(ColumnType, 'int') then - Result := dtInteger + DataType := dtInteger else if SameText(ColumnType, 'float') then - Result := dtFloat + DataType := dtFloat else if SameText(ColumnType, 'money') then - Result := dtCurrency + DataType := dtCurrency else if SameText(ColumnType, 'bit') then - Result := dtBoolean + DataType := dtBoolean else if SameText(ColumnType, 'varchar') then - Result := dtString + DataType := dtString else if SameText(ColumnType, 'text') then - Result := dtMemo + DataType := dtMemo else if SameText(ColumnType, 'datetime') then - Result := dtDateTime + DataType := dtDateTime else if SameText(ColumnType, 'image') then - Result := dtBlob + DataType := dtBlob else - raise Exception.CreateFmt(SUnsupportedColumnType, [ColumnType]); + Result := False; end; function TInstantMSSqlCatalog.GetSelectFieldsSQL( @@ -304,7 +315,7 @@ 'SELECT ' + ' name AS TABLE_NAME ' + 'FROM sysobjects ' + - 'WHERE type = ''U'' ' + + 'WHERE type = ''U'' and OBJECTPROPERTY(id, N''IsMSShipped'') <> 1' + 'ORDER BY name'; end; Modified: trunk/Source/Core/InstantConsts.pas =================================================================== --- trunk/Source/Core/InstantConsts.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Core/InstantConsts.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -180,7 +180,7 @@ SUnexpectedToken = 'Unexpected token ''%s''. Expected token ''%s'''; SUnknownAttributeClass = 'Unknown attribute class for attribute %s(''%s'')'; SUnspecifiedCommand = 'Command is not specified'; - SUnsupportedColumnType = 'ColumnType %s not supported'; + SUnsupportedColumnSkipped = 'Skipped column %s.%s. Unsupported type %s.'; SUnsupportedDataType = 'Unsupported datatype: %s'; SUnsupportedGraphicClass = 'Unsupported graphic class'; SUnsupportedGraphicStream = 'Unsupported graphic stream format'; Modified: trunk/Source/Core/InstantCustomDBEvolverFormUnit.pas =================================================================== --- trunk/Source/Core/InstantCustomDBEvolverFormUnit.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Core/InstantCustomDBEvolverFormUnit.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -104,6 +104,7 @@ var RaiseError: Boolean); virtual; procedure CustomDBEvolverBeforeCommandSequenceExecute(Sender: TObject); virtual; procedure CustomDBEvolverAfterCommandSequenceExecute(Sender: TObject); virtual; + procedure CustomDBEvolverWarning(const Sender: TObject; const AWarningText: string); virtual; procedure BeforeBuildCommandSequence; virtual; public // Assign a connector before calling the Execute method, otherwise the @@ -222,6 +223,7 @@ OldScreenCursor := Screen.Cursor; Screen.Cursor := crHourglass; try + EvolutionLogMemo.Lines.Clear; BeforeBuildCommandSequence; GetCustomDBEvolver.BuildCommandSequence; SequenceToScreen; @@ -323,6 +325,7 @@ GetCustomDBEvolver.BeforeCommandSequenceExecute := CustomDBEvolverBeforeCommandSequenceExecute; GetCustomDBEvolver.AfterCommandSequenceExecute := CustomDBEvolverAfterCommandSequenceExecute; GetCustomDBEvolver.OnCommandExecuteError := CustomDBEvolverCommandExecuteError; + GetCustomDBEvolver.OnWarning := CustomDBEvolverWarning; end; procedure TInstantCustomDBEvolverForm.BeforeBuildCommandSequence; @@ -334,4 +337,10 @@ Close; end; +procedure TInstantCustomDBEvolverForm.CustomDBEvolverWarning( + const Sender: TObject; const AWarningText: string); +begin + Log('Warning: ' + AWarningText); +end; + end. Modified: trunk/Source/Core/InstantDBBuild.pas =================================================================== --- trunk/Source/Core/InstantDBBuild.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Core/InstantDBBuild.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -58,6 +58,7 @@ private FConnector: TInstantConnector; FCommandSequence: TInstantDBBuildCommandSequence; + FOnWarning: TInstantWarningEvent; function GetAfterCommandExecute: TInstantDBBuildCommandNotifyEvent; function GetAfterCommandSequenceExecute: TNotifyEvent; function GetBeforeCommandExecute: TInstantDBBuildCommandNotifyEvent; @@ -71,6 +72,7 @@ function GetCommandExecuteError: TInstantDBBuildCommandErrorEvent; procedure SetCommandExecuteError( const Value: TInstantDBBuildCommandErrorEvent); + procedure DoWarning(const WarningText: string); protected function GetConnector: TInstantConnector; virtual; procedure InternalBuildCommandSequence; virtual; abstract; @@ -95,6 +97,8 @@ // data definition, not a very commonly available feature). property OnCommandExecuteError: TInstantDBBuildCommandErrorEvent read GetCommandExecuteError write SetCommandExecuteError; + procedure SourceSchemeWarningHandler(const Sender: TObject; + const AWarningText: string); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -112,6 +116,7 @@ // Reference to a Connector that points to the target database for // evolution. Default is InstantDefaultConnector. property Connector: TInstantConnector read GetConnector write SetConnector; + property OnWarning: TInstantWarningEvent read FOnWarning write FOnWarning; end; // Base class for database builders and evolvers. Abstract. @@ -483,6 +488,18 @@ end; end; +procedure TInstantCustomDBBuilder.SourceSchemeWarningHandler( + const Sender: TObject; const AWarningText: string); +begin + DoWarning(AWarningText); +end; + +procedure TInstantCustomDBBuilder.DoWarning(const WarningText: string); +begin + if Assigned(FOnWarning) then + FOnWarning(Self, WarningText); +end; + { TInstantCustomDBEvolver } function TInstantCustomDBEvolver.GetTargetModel: TInstantModel; @@ -636,7 +653,7 @@ procedure TInstantDBBuilder.InternalBuildCommandSequence; begin CommandSequence.Clear; - CommandSequence.SourceScheme := Connector.Broker.ReadDatabaseScheme; + CommandSequence.SourceScheme := Connector.Broker.ReadDatabaseScheme(SourceSchemeWarningHandler); CommandSequence.TargetScheme := Connector.CreateScheme(TargetModel); GenerateCommandSequence(CommandSequence); end; Modified: trunk/Source/Core/InstantDBEvolution.pas =================================================================== --- trunk/Source/Core/InstantDBEvolution.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Core/InstantDBEvolution.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -64,7 +64,7 @@ procedure TInstantDBEvolver.InternalBuildCommandSequence; begin CommandSequence.Clear; - CommandSequence.SourceScheme := Connector.Broker.ReadDatabaseScheme; + CommandSequence.SourceScheme := Connector.Broker.ReadDatabaseScheme(SourceSchemeWarningHandler); CommandSequence.TargetScheme := Connector.CreateScheme(TargetModel); GenerateSchemeDiff(CommandSequence); end; Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -53,6 +53,9 @@ Classes, Contnrs, SysUtils, DB, InstantClasses, InstantCommand, InstantConsts; type + TInstantWarningEvent = procedure (const Sender: TObject; + const AWarningText: string) of object; + TInstantMetadatas = class; TInstantMetadata = class(TInstantCollectionItem) @@ -407,8 +410,10 @@ TInstantCatalog = class private FScheme: TInstantScheme; + FOnWarning: TInstantWarningEvent; protected function GetFeatures: TInstantCatalogFeatures; virtual; + procedure DoWarning(const WarningText: string); public // Creates an instance and binds it to the specified TInstantScheme object. constructor Create(const AScheme: TInstantScheme); @@ -423,6 +428,10 @@ // says that the catalog support everything; derived classes might not // support all features. property Features: TInstantCatalogFeatures read GetFeatures; + // Triggered when the catalog has something to report about its activity, + // typically during InitTableMetadatas, which is not a fatal error. + property OnWarning: TInstantWarningEvent + read FOnWarning write FOnWarning; end; // A TInstantCatalog that gathers its info from a TInstantModel. @@ -444,6 +453,7 @@ TInstantScheme = class(TInstantStreamable) private + FOnWarning: TInstantWarningEvent; FCatalog: TInstantCatalog; FTableMetadataCollection: TInstantTableMetadatas; FBlobStreamFormat: TInstantStreamFormat; @@ -453,7 +463,10 @@ function GetTableMetadatas(Index: Integer): TInstantTableMetadata; function GetTableMetadataCount: Integer; procedure SetCatalog(const Value: TInstantCatalog); + procedure CatalogWarningEventHandler(const Sender: TObject; + const AWarningText: string); protected + procedure DoWarning(const AWarningText: string); function AttributeTypeToDataType( AttributeType: TInstantAttributeType): TInstantDataType; virtual; property TableMetadataCollection: TInstantTableMetadatas read GetTableMetadataCollection; @@ -467,6 +480,9 @@ property BlobStreamFormat: TInstantStreamFormat read FBlobStreamFormat write FBlobStreamFormat default sfBinary; property IdDataType: TInstantDataType read FIdDataType write FIdDataType default dtString; property IdSize: Integer read FIdSize write FIdSize default InstantDefaultFieldSize; + // Triggered when the scheme has something to report about its activity, + // typically during database building/evolution, which is not a fatal error. + property OnWarning: TInstantWarningEvent read FOnWarning write FOnWarning; end; TInstantAttributeMap = class(TInstantNamedList) @@ -1737,8 +1753,9 @@ // database scheme (which may differ from the model-derived scheme). // If the broker doesn't have a catalog, calling this method will raise // an exception. Call IsCatalogSupported if you need to know in advance - // whether you can safely call ReadDatabaseSchema or not. - function ReadDatabaseScheme: TInstantScheme; virtual; + // whether you can safely call ReadDatabaseScheme or not. + function ReadDatabaseScheme( + const AWarningEventHandler: TInstantWarningEvent): TInstantScheme; virtual; // Returns True if the broker supports creating a valid catalog. If this // method returns False, it means that calling CreateCatalog will yield nil, // and calling ReadDatabaseSchema will raise an exception. @@ -4107,6 +4124,12 @@ Result := InstantAttributeTypeToDataType(AttributeType, BlobStreamFormat); end; +procedure TInstantScheme.CatalogWarningEventHandler(const Sender: TObject; + const AWarningText: string); +begin + DoWarning(AWarningText); +end; + constructor TInstantScheme.Create; begin inherited Create; @@ -4122,6 +4145,12 @@ inherited; end; +procedure TInstantScheme.DoWarning(const AWarningText: string); +begin + if Assigned(FOnWarning) then + FOnWarning(Self, AWarningText); +end; + function TInstantScheme.FindTableMetadata( const AName: string): TInstantTableMetadata; begin @@ -4151,7 +4180,10 @@ FreeAndNil(FCatalog); FCatalog := Value; if Assigned(FCatalog) then + begin + FCatalog.OnWarning := CatalogWarningEventHandler; FCatalog.InitTableMetadatas(TableMetadataCollection); + end; end; { TInstantAttributeMap } @@ -10219,10 +10251,12 @@ Result := TInstantQuery.Create(Connector); end; -function TInstantBroker.ReadDatabaseScheme: TInstantScheme; +function TInstantBroker.ReadDatabaseScheme( + const AWarningEventHandler: TInstantWarningEvent): TInstantScheme; begin Result := TInstantScheme.Create; try + Result.OnWarning := AWarningEventHandler; Result.Catalog := CreateCatalog(Result); if Result.Catalog = nil then raise Exception.CreateFmt(SUndefinedCatalog, [ClassName]); @@ -15500,6 +15534,12 @@ FScheme := AScheme; end; +procedure TInstantCatalog.DoWarning(const WarningText: string); +begin + if Assigned(FOnWarning) then + FOnWarning(Self, WarningText); +end; + function TInstantCatalog.GetFeatures: TInstantCatalogFeatures; begin Result := [cfReadTableInfo, cfReadColumnInfo, cfReadIndexInfo]; |
|
From: <sr...@us...> - 2006-02-25 00:10:40
|
Revision: 626 Author: srmitch Date: 2006-02-24 16:10:30 -0800 (Fri, 24 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=626&view=rev Log Message: ----------- Fixes for bugs: #1430106 - TInstantBlobAttribute.Assign doesn't work properly because LoadDataFromStream doesn't clear stream. #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". Always inside TInstantBlob.AssignToPicture procedure (InstantPersistence unit). Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas trunk/Source/Core/InstantPresentation.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-23 18:33:19 UTC (rev 625) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-25 00:10:30 UTC (rev 626) @@ -3120,7 +3120,7 @@ else if (p[0] = #$47) and (p[1] = #$49) and (p[2] = #$46) then Result := gffGif; finally AStream.Position := 0; - end; + end; finally Freemem( p ); end; @@ -5790,8 +5790,7 @@ begin if not Assigned(AStream) then Exit; - Stream.Clear; - Stream.CopyFrom(AStream, 0); + Stream.LoadFromStream(AStream); Changed; end; @@ -5825,7 +5824,7 @@ procedure TInstantBlob.SaveDataToStream(AStream: TStream); begin if Assigned(AStream) then - AStream.CopyFrom(Stream, 0); + Stream.SaveToStream(AStream); end; procedure TInstantBlob.SetAsString(const AValue: string); Modified: trunk/Source/Core/InstantPresentation.pas =================================================================== --- trunk/Source/Core/InstantPresentation.pas 2006-02-23 18:33:19 UTC (rev 625) +++ trunk/Source/Core/InstantPresentation.pas 2006-02-25 00:10:30 UTC (rev 626) @@ -2145,6 +2145,8 @@ case AttributeMetadata.AttributeType of atBlob: Result := ftBlob; + atGraphic: + Result := ftGraphic; atMemo: Result := ftMemo; else |
|
From: <jcm...@us...> - 2006-02-26 17:15:25
|
Revision: 631 Author: jcmoraisjr Date: 2006-02-26 09:15:10 -0800 (Sun, 26 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=631&view=rev Log Message: ----------- Fixed bug # 1436858 (Exposer.AutoDispose disposing referenced object) (ps: it was previously - and erroneously - marked as fixed) Modified Paths: -------------- trunk/Demos/PrimerCross/COMPANYEDITACTIONIMAGES.BMP trunk/Demos/PrimerCross/CompanyEdit.dfm trunk/Demos/PrimerCross/CompanyEdit.pas trunk/Demos/PrimerCross/PrimerImages.res trunk/Source/Core/InstantPresentation.pas Property Changed: ---------------- trunk/Demos/PrimerCross/CompanyEdit.dfm Modified: trunk/Demos/PrimerCross/COMPANYEDITACTIONIMAGES.BMP =================================================================== (Binary files differ) Modified: trunk/Demos/PrimerCross/CompanyEdit.dfm =================================================================== (Binary files differ) Property changes on: trunk/Demos/PrimerCross/CompanyEdit.dfm ___________________________________________________________________ Name: svn:mime-type - application/octet-stream Name: svn:keywords + Author Date Id Revision Name: svn:eol-style + native Modified: trunk/Demos/PrimerCross/CompanyEdit.pas =================================================================== --- trunk/Demos/PrimerCross/CompanyEdit.pas 2006-02-26 14:25:36 UTC (rev 630) +++ trunk/Demos/PrimerCross/CompanyEdit.pas 2006-02-26 17:15:10 UTC (rev 631) @@ -20,8 +20,6 @@ Actions: TActionList; ActionImages: TImageList; EmployeeButtonPanel: TPanel; - EmployeeDeleteAction: TAction; - EmployeeDeleteButton: TBitBtn; EmployeeDeleteItem: TMenuItem; EmployeeEditAction: TAction; EmployeeEditButton: TBitBtn; @@ -44,7 +42,6 @@ procedure ActionsUpdate(Action: TBasicAction; var Handled: Boolean); procedure EmployeeNewActionExecute(Sender: TObject); procedure EmployeeEditActionExecute(Sender: TObject); - procedure EmployeeDeleteActionExecute(Sender: TObject); procedure EmployeeLookupActionExecute(Sender: TObject); procedure EmployeeRemoveActionExecute(Sender: TObject); procedure EmployeeExposerCompare(Sender, AObject1, AObject2: TObject; @@ -74,21 +71,11 @@ begin Employee := EmployeeExposer.CurrentObject as TPerson; EmployeeEditAction.Enabled := Assigned(Employee); - EmployeeDeleteAction.Enabled := Assigned(Employee); EmployeeRemoveAction.Enabled := Assigned(Employee); Handled := True; end; -procedure TCompanyEditForm.EmployeeDeleteActionExecute(Sender: TObject); -var - Employee: TPerson; -begin - Employee := EmployeeExposer.CurrentObject as TPerson; - if Confirm(Format('Delete "%s"?', [Employee.Name])) then - EmployeeExposer.Delete; -end; - procedure TCompanyEditForm.EmployeeEditActionExecute(Sender: TObject); var Employee: TPerson; @@ -177,7 +164,6 @@ EmployeeLookupButton.Action := EmployeeLookupAction; EmployeeEditButton.Action := EmployeeEditAction; EmployeeRemoveButton.Action := EmployeeRemoveAction; - EmployeeDeleteButton.Action := EmployeeDeleteAction; end; initialization Modified: trunk/Demos/PrimerCross/PrimerImages.res =================================================================== (Binary files differ) Modified: trunk/Source/Core/InstantPresentation.pas =================================================================== --- trunk/Source/Core/InstantPresentation.pas 2006-02-26 14:25:36 UTC (rev 630) +++ trunk/Source/Core/InstantPresentation.pas 2006-02-26 17:15:10 UTC (rev 631) @@ -222,7 +222,7 @@ public constructor Create(AObject: TObject; AOwner: TInstantContentBuffer = nil); destructor Destroy; override; - procedure RegisterAsDeleted(ARecNo: Integer; AAutoApplyChanges: Boolean); + procedure RegisterAsDeleted(ARecNo: Integer; AAutoApplyChanges, ACanDispose: Boolean); procedure RegisterAsInserted; procedure RegisterAsModified; procedure RegisterField(AField: TField); @@ -241,6 +241,7 @@ TInstantContentBuffer = class(TObject) private FAutoApplyChanges: Boolean; + FCanDispose: Boolean; FRecordBufferList: TList; procedure FreeRecordBufferList; function GetRecordBuffer(AIndex: Integer): TInstantRecordBuffer; @@ -251,11 +252,12 @@ function FindRecordBufferIndex(AObject: TObject): Integer; procedure RegisterObjectUpdate(AObject: TObject; ARecNo: Integer; AUpdateStatus: TUpdateStatus); 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: Boolean); + constructor Create(AAutoApplyChanges, ACanDispose: Boolean); destructor Destroy; override; procedure AddRecordBuffer(ARecordBuffer: TInstantRecordBuffer); procedure DisposeDeletedObjects; @@ -317,6 +319,7 @@ procedure ClearRecord(Buffer: PChar); function DataFieldsSize: Integer; function GetAutoApplyChanges: Boolean; + function GetCanDispose: Boolean; function GetContentBuffer: TInstantContentBuffer; function GetCurrentBuffer: PChar; function GetDesignClass: TInstantCodeClass; @@ -461,6 +464,7 @@ procedure DoBeforeRefresh; override; property Accessor: TInstantAccessor read GetAccessor; property AutoApplyChanges: Boolean read GetAutoApplyChanges; + property CanDispose: Boolean read GetCanDispose; property ContainerName: string read FContainerName write SetContainerName; property ContentBuffer: TInstantContentBuffer read GetContentBuffer; property CurrentBuffer: PChar read GetCurrentBuffer; @@ -1637,7 +1641,7 @@ end; procedure TInstantRecordBuffer.RegisterAsDeleted(ARecNo: Integer; - AAutoApplyChanges: Boolean); + AAutoApplyChanges, ACanDispose: Boolean); begin if UpdateStatus = usModified then // Roll back changes, so RevertDeleted will restore the original object @@ -1646,7 +1650,7 @@ begin FDeletedObjectBM.RecNo := ARecNo; FDeletedObjectBM.Instance.Free; - if AAutoApplyChanges then + if AAutoApplyChanges and ACanDispose then FDeletedObjectBM.Instance := Subject.Clone else begin @@ -1715,10 +1719,11 @@ RecordBufferList.Add(ARecordBuffer); end; -constructor TInstantContentBuffer.Create(AAutoApplyChanges: Boolean); +constructor TInstantContentBuffer.Create(AAutoApplyChanges, ACanDispose: Boolean); begin inherited Create; FAutoApplyChanges := AAutoApplyChanges; + FCanDispose := ACanDispose; end; destructor TInstantContentBuffer.Destroy; @@ -1731,7 +1736,7 @@ var I: Integer; begin - if not AutoApplyChanges then + if not AutoApplyChanges and CanDispose then for I := 0 to Pred(RecordBufferCount) do if RecordBuffer[I].UpdateStatus = usDeleted then with RecordBuffer[I].FDeletedObjectBM.Instance do @@ -1830,7 +1835,7 @@ usInserted: VRecordBuffer.RegisterAsInserted; usDeleted: - VRecordBuffer.RegisterAsDeleted(ARecNo, AutoApplyChanges); + VRecordBuffer.RegisterAsDeleted(ARecNo, AutoApplyChanges, CanDispose); else ; end; @@ -1872,13 +1877,13 @@ else AExposer.InternalInsertObject(DeletedObjectRecNo, DeletedObjectInstance); // Friend class - if AutoApplyChanges then + if AutoApplyChanges and CanDispose then begin if AExposer is TInstantSelector then // TInstantQuery - TheObject.Store is enough DeletedObjectInstance.Store else - // TInstantParts or TInstantReferences - need to call Subject.Store + // TInstantParts - need to call Subject.Store SubjectChanged := True; end; end; @@ -2257,7 +2262,7 @@ procedure TInstantCustomExposer.AutoDispose(AObject: TObject); begin - if AutoApplyChanges and (AObject is TInstantObject) then + if AutoApplyChanges and (AObject is TInstantObject) and CanDispose then with TInstantObject(AObject) do if CanDispose then Dispose; @@ -2638,6 +2643,14 @@ Result := GetRecInfo(Buffer).BookmarkFlag; end; +function TInstantCustomExposer.GetCanDispose: Boolean; +begin + if InContent and (Subject is TInstantObject) then + Result := not (TInstantObject(Subject).FindContainer(ContainerName) is TInstantReferences) + else + Result := True; +end; + function TInstantCustomExposer.GetCanModify: Boolean; begin Result := inherited GetCanModify and HasSubject and not ReadOnly; @@ -2646,7 +2659,7 @@ function TInstantCustomExposer.GetContentBuffer: TInstantContentBuffer; begin if not Assigned(FContentBuffer) then - FContentBuffer := TInstantContentBuffer.Create(AutoApplyChanges); + FContentBuffer := TInstantContentBuffer.Create(AutoApplyChanges, CanDispose); Result := FContentBuffer; 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: <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: <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: <na...@us...> - 2006-04-25 08:12:42
|
Revision: 669 Author: nandod Date: 2006-04-25 01:12:33 -0700 (Tue, 25 Apr 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=669&view=rev Log Message: ----------- * [ 1475982 ] Rebuilding a Firebird database creates disabled PKs * some small refactorings and reformatting Modified Paths: -------------- trunk/Source/Core/InstantDBBuild.pas trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantDBBuild.pas =================================================================== --- trunk/Source/Core/InstantDBBuild.pas 2006-04-24 23:01:01 UTC (rev 668) +++ trunk/Source/Core/InstantDBBuild.pas 2006-04-25 08:12:33 UTC (rev 669) @@ -198,7 +198,6 @@ procedure DoCommandExecuteError(const ACommand: TInstantDBBuildCommand; const Error: Exception; var RaiseError: Boolean); procedure DoExecute; - procedure DoExecuteInTransaction; function GetCount: Integer; function GetItem(const Index: Integer): TInstantDBBuildCommand; procedure SetSourceScheme(const Value: TInstantScheme); @@ -270,6 +269,9 @@ // beginning of the overridden version, just returns '', or raises an // exception if Index is not in the allowed range. function GetSQLStatement(const Index: Integer): string; virtual; + // Executes the Nth statement. Handles transactions internally. + procedure ExecuteSQLStatement(const Index: Integer); + // Executes all statements. procedure InternalExecute; override; public property Connector: TInstantRelationalConnector read GetConnector; @@ -362,15 +364,25 @@ property NewIndexMetadata: TInstantIndexMetadata read GetNewIndexMetadata; end; + // Alters a field using a sequence of 6 instructions: + // 1. adds a temporary new field of the new type. + // 2. copies the values from the old field to the new field. + // 3. drops the old field. + // 4. adds a field with the old name and the new type. + // 5. copies back the values from the new temp field to the field with + // the old name. + // 6. drops the temp field. + // This class should be used for those database that don't support the + // SQL ALTER TABLE ALTER COLUMN statement. TInstantDBBuildAlterFieldGenericSQLCommand = class( - TInstantDBBuildAlterFieldSQLCommand) + TInstantDBBuildAlterFieldSQLCommand) private - FTmpFieldMD: TInstantFieldMetadata; + FTempFieldMetadata: TInstantFieldMetadata; protected function GetDescription: string; override; function GetSQLStatement(const Index: Integer): string; override; function GetSQLStatementCount: Integer; override; - procedure InternalExecute; override; + function InternalExecuteHandleError(const E: Exception): Boolean; override; public destructor Destroy; override; end; @@ -720,17 +732,26 @@ procedure TInstantDBBuildCommandSequence.DoExecute; var - i: Integer; + I: Integer; CurrentCommand: TInstantDBBuildCommand; RaiseError: Boolean; begin - for i := 0 to FCommands.Count - 1 do + for I := 0 to FCommands.Count - 1 do begin - CurrentCommand := FCommands[i] as TInstantDBBuildCommand; + CurrentCommand := FCommands[I] as TInstantDBBuildCommand; DoBeforeCommandExecute(CurrentCommand); try if CurrentCommand.Enabled then - CurrentCommand.Execute; + begin + Connector.StartTransaction; + try + CurrentCommand.Execute; + Connector.CommitTransaction; + except + Connector.RollbackTransaction; + raise; + end; + end; except on E: Exception do begin @@ -744,37 +765,19 @@ end; end; -procedure TInstantDBBuildCommandSequence.DoExecuteInTransaction; -begin - Connector.StartTransaction; - try - DoExecute; - Connector.CommitTransaction; - except - Connector.RollbackTransaction; - raise; - end; -end; - procedure TInstantDBBuildCommandSequence.Execute; var - ConnState: Boolean; + LWasConnected: Boolean; begin - ConnState := Connector.Connected; - if not ConnState then + LWasConnected := Connector.Connected; + if not LWasConnected then Connector.Connect; - DoBeforeExecute; - try - if Connector.DDLTransactionSupported then - DoExecuteInTransaction - else - DoExecute; - + DoExecute; DoAfterExecute; finally - if not ConnState then + if not LWasConnected then Connector.Disconnect; end; end; @@ -857,6 +860,21 @@ { TInstantDBBuildSQLCommand } +procedure TInstantDBBuildSQLCommand.ExecuteSQLStatement(const Index: Integer); +begin + if Connector.DDLTransactionSupported then + Connector.StartTransaction; + try + Broker.Execute(GetSQLStatement(Index)); + if Connector.DDLTransactionSupported then + Connector.CommitTransaction; + except + if Connector.DDLTransactionSupported then + Connector.RollbackTransaction; + raise; + end; +end; + function TInstantDBBuildSQLCommand.GetBroker: TInstantSQLBroker; begin Result := Connector.Broker as TInstantSQLBroker; @@ -896,10 +914,10 @@ procedure TInstantDBBuildSQLCommand.InternalExecute; var - iStatement: Integer; + IStatement: Integer; begin - for iStatement := 0 to Pred(GetSQLStatementCount) do - Broker.Execute(GetSQLStatement(iStatement)); + for IStatement := 0 to Pred(GetSQLStatementCount) do + ExecuteSQLStatement(IStatement); end; { TInstantDBBuildAddTableSQLCommand } @@ -1036,20 +1054,20 @@ destructor TInstantDBBuildAlterFieldGenericSQLCommand.Destroy; begin - FTmpFieldMD.Free; + FTempFieldMetadata.Free; inherited; end; function TInstantDBBuildAlterFieldGenericSQLCommand.GetDescription: string; begin Result := Format('ALTER TABLE %s evolve column %s - multi-statement SQL.', - [NewFieldMetadata.TableMetadata.Name, NewFieldMetadata.Name]); + [NewFieldMetadata.TableMetadata.Name, NewFieldMetadata.Name]); end; -function TInstantDBBuildAlterFieldGenericSQLCommand.GetSQLStatement(const - Index: Integer): string; +function TInstantDBBuildAlterFieldGenericSQLCommand.GetSQLStatement( + const Index: Integer): string; - function CreateTmpFieldMetadata(FieldMetadata: TInstantFieldMetadata): + function CreateTempFieldMetadata(FieldMetadata: TInstantFieldMetadata): TInstantFieldMetadata; begin Result := TInstantFieldMetadata.Create(FieldMetadata.Collection); @@ -1059,43 +1077,30 @@ begin Result := inherited GetSQLStatement(Index); - - FTmpFieldMD := CreateTmpFieldMetadata(NewFieldMetadata); - + FTempFieldMetadata := CreateTempFieldMetadata(NewFieldMetadata); with Broker.Generator do case Index of - 0 : Result := GenerateAddFieldSQL(FTmpFieldMD); - - 1 : Result := GenerateUpdateFieldCopySQL(OldFieldMetadata, FTmpFieldMD); - - 2 : Result := GenerateDropFieldSQL(OldFieldMetadata); - - 3 : Result := GenerateAddFieldSQL(NewFieldMetadata); - - 4 : Result := GenerateUpdateFieldCopySQL(FTmpFieldMD, NewFieldMetadata); - - 5 : Result := GenerateDropFieldSQL(FTmpFieldMD); + 0: Result := GenerateAddFieldSQL(FTempFieldMetadata); + 1: Result := GenerateUpdateFieldCopySQL(OldFieldMetadata, FTempFieldMetadata); + 2: Result := GenerateDropFieldSQL(OldFieldMetadata); + 3: Result := GenerateAddFieldSQL(NewFieldMetadata); + 4: Result := GenerateUpdateFieldCopySQL(FTempFieldMetadata, NewFieldMetadata); + 5: Result := GenerateDropFieldSQL(FTempFieldMetadata); end; end; -function TInstantDBBuildAlterFieldGenericSQLCommand.GetSQLStatementCount: - Integer; +function TInstantDBBuildAlterFieldGenericSQLCommand.GetSQLStatementCount: Integer; begin Result := 6; end; -procedure TInstantDBBuildAlterFieldGenericSQLCommand.InternalExecute; -var - iStatement: Integer; +function TInstantDBBuildAlterFieldGenericSQLCommand.InternalExecuteHandleError( + const E: Exception): Boolean; begin - try - for iStatement := 0 to Pred(GetSQLStatementCount) do - Broker.Execute(GetSQLStatement(iStatement)); - except - if Assigned(FTmpFieldMD) then - Broker.Execute(Broker.Generator.GenerateDropFieldSQL(FTmpFieldMD)); - raise; - end; + // Try not to leave the temp field around. + if Assigned(FTempFieldMetadata) then + Broker.Execute(Broker.Generator.GenerateDropFieldSQL(FTempFieldMetadata)); + Result := False; end; end. Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-04-24 23:01:01 UTC (rev 668) +++ trunk/Source/Core/InstantPersistence.pas 2006-04-25 08:12:33 UTC (rev 669) @@ -1695,6 +1695,11 @@ procedure InternalExecute; virtual; abstract; // Computes and returns the step's description. function GetDescription: string; virtual; + // Called if an exception occurs in InternalExecute. It should do + // whatever is needed to handle the error and return True if the exception + // needs to be trapped, otherwise it's re-raised. The default implementation + // just returns False. + function InternalExecuteHandleError(const E: Exception): Boolean; virtual; public constructor Create(const ACommandType: TInstantDBBuildCommandType; const AConnector: TInstantConnector = nil); @@ -15469,7 +15474,13 @@ procedure TInstantDBBuildCommand.Execute; begin - InternalExecute; + try + InternalExecute; + except + on E: Exception do + if not InternalExecuteHandleError(E) then + raise; + end; end; function TInstantDBBuildCommand.GetConnector: TInstantConnector; @@ -15490,6 +15501,12 @@ Result := Result + ']'; end; +function TInstantDBBuildCommand.InternalExecuteHandleError( + const E: Exception): Boolean; +begin + Result := False; +end; + { TInstantBrokerCatalog } constructor TInstantBrokerCatalog.Create(const AScheme: TInstantScheme; @@ -15643,8 +15660,7 @@ procedure TInstantUnsupportedDBBuildCommand.InternalExecute; begin - raise EInstantDBBuildError.CreateFmt(SCannotBuildDB, - [Description]); + raise EInstantDBBuildError.CreateFmt(SCannotBuildDB, [Description]); end; { TInstantCatalog } |
|
From: <sr...@us...> - 2006-05-02 23:44:02
|
Revision: 673 Author: srmitch Date: 2006-05-02 16:43:48 -0700 (Tue, 02 May 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=673&view=rev Log Message: ----------- Fix for bug #1479652 in SF BT "Problem with PrimeCross demo and InstantReference.Reset". Unit tests were also updated. Bug Symptom(s): An InstantPart or InstantReference attribute Reset does not cause the change to the object to be stored. Bug Cause: InstantPart and InstantReference attributes do not signal a change after a Reset. Fix affects: <<InstantPersistence.pas>> procedure TInstantPart.Reset; procedure TInstantReference.Reset; <<TestInstantPart.pas>> <<TestInstantReference.pas>> Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas trunk/Source/Tests/TestInstantPart.pas trunk/Source/Tests/TestInstantReference.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-05-02 19:09:06 UTC (rev 672) +++ trunk/Source/Core/InstantPersistence.pas 2006-05-02 23:43:48 UTC (rev 673) @@ -6229,7 +6229,11 @@ procedure TInstantPart.Reset; begin - DestroyObject; + if not IsDefault then + begin + DestroyObject; + Changed; + end; end; procedure TInstantPart.SetOwnerContext(AObject: TInstantObject); @@ -6470,7 +6474,11 @@ procedure TInstantReference.Reset; begin - DestroyObjectReference; + if not IsDefault then + begin + DestroyObjectReference; + Changed; + end; end; function TInstantReference.RetrieveObject: TInstantObject; Modified: trunk/Source/Tests/TestInstantPart.pas =================================================================== --- trunk/Source/Tests/TestInstantPart.pas 2006-05-02 19:09:06 UTC (rev 672) +++ trunk/Source/Tests/TestInstantPart.pas 2006-05-02 23:43:48 UTC (rev 673) @@ -174,12 +174,16 @@ var vPart: TAddress; begin - AssertFalse(FInstantPart.IsChanged); + AssertFalse('Initial IsChanged', FInstantPart.IsChanged); vPart := TAddress.Create(FConn); + FInstantPart.Value := vPart; + AssertTrue('IsChanged False after Value assignment', FInstantPart.IsChanged); + + FInstantPart.Unchanged; + AssertFalse(FInstantPart.IsChanged); vPart.Changed; - FInstantPart.Value := vPart; - AssertTrue(FInstantPart.IsChanged); + AssertTrue('IsChanged False after part changed', FInstantPart.IsChanged); end; procedure TestTInstantEmbPart.TestIsDefault; @@ -245,6 +249,11 @@ vFirstObj: TInstantObject; vSecondObj: TInstantObject; begin + AssertTrue(FInstantPart.IsDefault); + AssertFalse(FInstantPart.IsChanged); + FInstantPart.Reset; + AssertFalse('IsChanged True after initial Reset', FInstantPart.IsChanged); + AssertFalse('HasValue 1', FInstantPart.HasValue); AssertNotNull('AssertNotNull', FInstantPart.Value); AssertTrue('HasValue 2', FInstantPart.HasValue); @@ -255,9 +264,15 @@ FInstantPart.Value := vSecondObj; AssertEquals('Value.Id', 'PartId', FInstantPart.Value.Id); AssertNotSame('AssertNotSame', vFirstObj, FInstantPart.Value); + AssertTrue('IsChanged False after second Value assignment', + FInstantPart.IsChanged); + FInstantPart.Unchanged; + AssertFalse(FInstantPart.IsChanged); + FInstantPart.Reset; AssertFalse('HasValue 3', FInstantPart.HasValue); + AssertTrue('IsChanged False after Reset', FInstantPart.IsChanged); end; procedure TestTInstantExtPart.SetUp; Modified: trunk/Source/Tests/TestInstantReference.pas =================================================================== --- trunk/Source/Tests/TestInstantReference.pas 2006-05-02 19:09:06 UTC (rev 672) +++ trunk/Source/Tests/TestInstantReference.pas 2006-05-02 23:43:48 UTC (rev 673) @@ -50,6 +50,7 @@ procedure TestAttach_DetachObject; procedure TestDestroyObject_HasReference_HasValue; procedure TestHasValue; + procedure TestIsChanged; procedure TestLoadObjectFromStream; procedure TestObjectClass_ObjectClassName_ObjectId; procedure TestReferenceObject_Class; @@ -73,6 +74,7 @@ FOwner := TContact.Create(FConn); FInstantReference := FOwner._Category; + FInstantReference.UnChanged; end; procedure TestTInstantReference.TearDown; @@ -171,6 +173,28 @@ AssertFalse(FInstantReference.HasValue); end; +procedure TestTInstantReference.TestIsChanged; +var + vObject: TCategory; +begin + AssertFalse('Initial IsChanged', FInstantReference.IsChanged); + + vObject := TCategory.Create(FConn); + try + AssertNotNull('Create object is nil', vObject); + FInstantReference.Value := vObject; + AssertTrue('IsChanged False after Value assignment', FInstantReference.IsChanged); + + FInstantReference.Unchanged; + AssertFalse(FInstantReference.IsChanged); + vObject.Changed; + AssertFalse('IsChanged True after referenced object changed', + FInstantReference.IsChanged); + finally + vObject.Free; + end; +end; + procedure TestTInstantReference.TestLoadObjectFromStream; var vObject: TCategory; @@ -270,6 +294,12 @@ begin AssertTrue('Initial HasRef', FInstantReference.HasReference); AssertFalse('Initial HasVal', FInstantReference.HasValue); + AssertFalse('Initial IsChanged', FInstantReference.IsChanged); + AssertFalse('Initial IsDefault', FInstantReference.IsDefault); + FInstantReference.Reset; + AssertTrue('IsDefault after Reset', FInstantReference.IsDefault); + AssertTrue('IsChanged True after initial Reset', + FInstantReference.IsChanged); vObj := TCategory.Create(FConn); try @@ -277,10 +307,13 @@ AssertTrue(FInstantReference.HasReference); AssertTrue(FInstantReference.HasValue); AssertSame(vObj, FInstantReference.Value); + AssertTrue('IsChanged 2 is False!', FInstantReference.IsChanged); + FInstantReference.UnChanged; FInstantReference.Reset; AssertFalse('Final HasRef', FInstantReference.HasReference); AssertFalse('Final HasVal', FInstantReference.HasValue); + AssertTrue('Final IsChanged', FInstantReference.IsChanged); finally vObj.Free; end; |
|
From: <sr...@us...> - 2006-07-22 05:32:55
|
Revision: 688 Author: srmitch Date: 2006-07-21 22:32:46 -0700 (Fri, 21 Jul 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=688&view=rev Log Message: ----------- - Update to throw a more useful EInstantAccessError rather than an AV when trying to access the members of an object that has been disposed before being fetched by an InstantQuery. Related to [bug# 1516101 ] "Problem disposing an TInstantObject with multiple queries". Modified Paths: -------------- trunk/Source/Core/InstantConsts.pas trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantConsts.pas =================================================================== --- trunk/Source/Core/InstantConsts.pas 2006-07-20 00:56:59 UTC (rev 687) +++ trunk/Source/Core/InstantConsts.pas 2006-07-22 05:32:46 UTC (rev 688) @@ -148,6 +148,7 @@ SObjectClassUndefined = 'ObjectClass undefined'; SObjectError = 'Error for object of class %s: "%s"'; SObjectIsOwned = 'Object %s(''%s'') is owned.'; + SObjectNotAvailable = 'Object is not available!'; SOwnershipRecursion = 'Ownership Recursion for object %s(''%s'')'; SPersistentObjectNotAllowed = 'Persistent object %s(''%s'') not allowed.'; SProtocolNotSupported = 'Protocol ''%s'' not supported'; Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-07-20 00:56:59 UTC (rev 687) +++ trunk/Source/Core/InstantPersistence.pas 2006-07-22 05:32:46 UTC (rev 688) @@ -10658,6 +10658,10 @@ function TInstantQuery.GetObjects(Index: Integer): TObject; begin Result := InternalGetObjects(Index); + if not Assigned(Result) then + raise EInstantAccessError.CreateFmt(SErrorRetrievingObject, + [ObjectClassName, 'Query.Object[' + IntToStr(Index) + ']', + SObjectNotAvailable]); end; function TInstantQuery.GetParams: TParams; |
|
From: <na...@us...> - 2008-02-27 09:03:34
|
Revision: 778
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=778&view=rev
Author: nandod
Date: 2008-02-27 01:03:37 -0800 (Wed, 27 Feb 2008)
Log Message:
-----------
+ New "usenull" attribute parameter to have a zero value stored as null in DBs that support it (especially useful for dates) (WIP - design time support still not finished).
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantCode.pas
trunk/Source/Core/InstantMetadata.pas
trunk/Source/Core/InstantPersistence.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2008-02-25 17:55:07 UTC (rev 777)
+++ trunk/Source/Core/InstantBrokers.pas 2008-02-27 09:03:37 UTC (rev 778)
@@ -417,9 +417,9 @@
FSelectExternalPartSQL: string;
FDeleteExternalSQL: string;
FInsertExternalSQL: string;
- procedure AddIntegerParam(Params: TParams; const ParamName: string;
- Value: Integer);
- procedure AddStringParam(Params: TParams; const ParamName, Value: string);
+ function AddIntegerParam(Params: TParams; const ParamName: string;
+ Value: Integer): TParam;
+ function AddStringParam(Params: TParams; const ParamName, Value: string): TParam;
// Adds an "Id" param, whose data type and size depends on connector
// settings.
procedure AddIdParam(Params: TParams; const ParamName, Value: string);
@@ -2391,57 +2391,81 @@
procedure TInstantNavigationalResolver.WriteBlob(Attribute: TInstantBlob);
begin
- with Attribute do
- FieldByName(Metadata.FieldName).AsString := Value;
+ with FieldByName(Attribute.Metadata.FieldName) do
+ if Attribute.IsNull then
+ Clear
+ else
+ AsString := Attribute.Value;
end;
procedure TInstantNavigationalResolver.WriteBoolean(Attribute: TInstantBoolean);
begin
- with Attribute do
- FieldByName(Metadata.FieldName).AsBoolean := Value;
+ with FieldByName(Attribute.Metadata.FieldName) do
+ if Attribute.IsNull then
+ Clear
+ else
+ AsBoolean := Attribute.Value;
end;
procedure TInstantNavigationalResolver.WriteCurrency(Attribute: TInstantCurrency);
begin
- with Attribute do
+ with FieldByName(Attribute.Metadata.FieldName) do
+ if Attribute.IsNull then
+ Clear
+ else
{$IFDEF FPC}
- FieldByName(Metadata.FieldName).AsFloat := Value;
+ AsFloat := Value;
{$ELSE}
- FieldByName(Metadata.FieldName).AsCurrency := Value;
+ AsCurrency := Value;
{$ENDIF}
end;
procedure TInstantNavigationalResolver.WriteDateTime(
Attribute: TInstantDateTime);
begin
- with Attribute do
- FieldByName(Metadata.FieldName).AsDateTime := Value;
+ with FieldByName(Attribute.Metadata.FieldName) do
+ if Attribute.IsNull then
+ Clear
+ else
+ AsDateTime := Attribute.Value;
end;
procedure TInstantNavigationalResolver.WriteDate(
Attribute: TInstantDate);
begin
- with Attribute do
- FieldByName(Metadata.FieldName).AsDateTime := Value;
+ with FieldByName(Attribute.Metadata.FieldName) do
+ if Attribute.IsNull then
+ Clear
+ else
+ AsDateTime := Attribute.Value;
end;
procedure TInstantNavigationalResolver.WriteTime(
Attribute: TInstantTime);
begin
- with Attribute do
- FieldByName(Metadata.FieldName).AsDateTime := Value;
+ with FieldByName(Attribute.Metadata.FieldName) do
+ if Attribute.IsNull then
+ Clear
+ else
+ AsDateTime := Attribute.Value;
end;
procedure TInstantNavigationalResolver.WriteFloat(Attribute: TInstantFloat);
begin
- with Attribute do
- FieldByName(Metadata.FieldName).AsFloat := Value;
+ with FieldByName(Attribute.Metadata.FieldName) do
+ if Attribute.IsNull then
+ Clear
+ else
+ AsFloat := Attribute.Value;
end;
procedure TInstantNavigationalResolver.WriteInteger(Attribute: TInstantInteger);
begin
- with Attribute do
- FieldByName(Metadata.FieldName).AsInteger := Value;
+ with FieldByName(Attribute.Metadata.FieldName) do
+ if Attribute.IsNull then
+ Clear
+ else
+ AsInteger := Attribute.Value;
end;
procedure TInstantNavigationalResolver.WriteMemo(Attribute: TInstantMemo);
@@ -2563,8 +2587,11 @@
procedure TInstantNavigationalResolver.WriteString(Attribute: TInstantString);
begin
- with Attribute do
- FieldByName(Metadata.FieldName).AsString := Value;
+ with FieldByName(Attribute.Metadata.FieldName) do
+ if Attribute.IsNull then
+ Clear
+ else
+ AsString := Attribute.Value;
end;
constructor TInstantSQLResolver.Create(ABroker: TInstantSQLBroker;
@@ -2602,60 +2629,102 @@
end;
procedure AddBlobAttributeParam;
+ var
+ LParam: TParam;
begin
- AddBlobParam(FieldName, (Attribute as TInstantBlob).Value);
+ LParam := AddParam(Params, FieldName, ftBlob);
+ if Attribute.IsNull then
+ LParam.Clear
+ else
+ LParam.AsBlob := (Attribute as TInstantBlob).Value;
end;
procedure AddBooleanAttributeParam;
+ var
+ LParam: TParam;
begin
- AddParam(Params, FieldName, ftBoolean).AsBoolean :=
- (Attribute as TInstantBoolean).Value;
+ LParam := AddParam(Params, FieldName, ftBoolean);
+ if Attribute.IsNull then
+ LParam.Clear
+ else
+ LParam.AsBoolean := (Attribute as TInstantBoolean).Value;
end;
procedure AddDateTimeAttributeParam;
+ var
+ LParam: TParam;
begin
- AddParam(Params, FieldName, ftDateTime).AsDateTime :=
- (Attribute as TInstantDateTime).Value;
+ LParam := AddParam(Params, FieldName, ftDateTime);
+ if Attribute.IsNull then
+ LParam.Clear
+ else
+ LParam.AsDateTime := (Attribute as TInstantDateTime).Value;
end;
procedure AddDateAttributeParam;
+ var
+ LParam: TParam;
begin
- AddParam(Params, FieldName, ftDate).AsDateTime :=
- (Attribute as TInstantDate).Value;
+ LParam := AddParam(Params, FieldName, ftDate);
+ if Attribute.IsNull then
+ LParam.Clear
+ else
+ LParam.AsDateTime := (Attribute as TInstantDate).Value;
end;
procedure AddTimeAttributeParam;
+ var
+ LParam: TParam;
begin
- AddParam(Params, FieldName, ftTime).AsDateTime :=
- (Attribute as TInstantTime).Value;
+ LParam := AddParam(Params, FieldName, ftTime);
+ if Attribute.IsNull then
+ LParam.Clear
+ else
+ LParam.AsDateTime := (Attribute as TInstantTime).Value;
end;
procedure AddFloatAttributeParam;
+ var
+ LParam: TParam;
begin
- AddParam(Params, FieldName, ftFloat).AsFloat :=
- (Attribute as TInstantFloat).Value;
+ LParam := AddParam(Params, FieldName, ftFloat);
+ if Attribute.IsNull then
+ LParam.Clear
+ else
+ LParam.AsFloat := (Attribute as TInstantFloat).Value;
end;
procedure AddCurrencyAttributeParam;
+ var
+ LParam: TParam;
begin
- AddParam(Params, FieldName, ftBCD).AsCurrency :=
- (Attribute as TInstantCurrency).Value;
+ LParam := AddParam(Params, FieldName, ftBCD);
+ if Attribute.IsNull then
+ LParam.Clear
+ else
+ LParam.AsCurrency := (Attribute as TInstantCurrency).Value;
end;
procedure AddIntegerAttributeParam;
+ var
+ LParam: TParam;
begin
- AddIntegerParam(Params, FieldName, (Attribute as TInstantInteger).Value);
+ LParam := AddIntegerParam(Params, FieldName, (Attribute as TInstantInteger).Value);
+ if Attribute.IsNull then
+ LParam.Clear;
end;
procedure AddMemoAttributeParam;
var
- Param: TParam;
+ LParam: TParam;
MemoAttrib: TInstantMemo;
begin
- Param := AddParam(Params, FieldName, ftMemo);
+ LParam := AddParam(Params, FieldName, ftMemo);
MemoAttrib := (Attribute as TInstantMemo);
- if MemoAttrib.Size <> 0 then
- Param.AsMemo := MemoAttrib.Value;
+ if (MemoAttrib.Size = 0) or Attribute.IsNull then
+ LParam.Clear
+ else
+ LParam.AsMemo := MemoAttrib.Value;
end;
procedure AddPartAttributeParam;
@@ -2728,8 +2797,12 @@
end;
procedure AddStringAttributeParam;
+ var
+ LParam: TParam;
begin
- AddStringParam(Params, FieldName, (Attribute as TInstantString).Value);
+ LParam := AddStringParam(Params, FieldName, (Attribute as TInstantString).Value);
+ if Attribute.IsNull then
+ LParam.Clear;
end;
begin
@@ -2810,10 +2883,11 @@
Param.Value := Value;
end;
-procedure TInstantSQLResolver.AddIntegerParam(Params: TParams;
- const ParamName: string; Value: Integer);
+function TInstantSQLResolver.AddIntegerParam(Params: TParams;
+ const ParamName: string; Value: Integer): TParam;
begin
- AddParam(Params, ParamName, ftInteger).AsInteger := Value;
+ Result := AddParam(Params, ParamName, ftInteger);
+ Result.AsInteger := Value;
end;
function TInstantSQLResolver.AddParam(Params: TParams;
@@ -2830,18 +2904,12 @@
AddIdParam(Params, PersistentIdParamName, APersistentId);
end;
-procedure TInstantSQLResolver.AddStringParam(Params: TParams;
- const ParamName, Value: string);
-var
- Param: TParam;
+function TInstantSQLResolver.AddStringParam(Params: TParams;
+ const ParamName, Value: string): TParam;
begin
- Param := AddParam(Params, ParamName, ftString);
+ Result := AddParam(Params, ParamName, ftString);
if Value <> '' then
- begin
- Param.AsString := Value;
- // Update the length string to avoid the MBCS Bug.
-// Param.Size := Length(Value);
- end;
+ Result.AsString := Value;
end;
procedure TInstantSQLResolver.CheckConflict(Info: PInstantOperationInfo;
Modified: trunk/Source/Core/InstantCode.pas
===================================================================
--- trunk/Source/Core/InstantCode.pas 2008-02-25 17:55:07 UTC (rev 777)
+++ trunk/Source/Core/InstantCode.pas 2008-02-27 09:03:37 UTC (rev 778)
@@ -625,6 +625,8 @@
procedure SetStorageKind(const Value: TInstantStorageKind);
function GetCanHaveStorageName: boolean;
function GetCanBeExternal: boolean;
+ function GetUseNull: Boolean;
+ procedure SetUseNull(const Value: Boolean);
protected
function GetIsDefault: Boolean; virtual;
function GetMethodName(MethodType: TInstantCodeContainerMethodType): string;
@@ -692,6 +694,7 @@
property IncludeRemoveMethod: Boolean read GetIncludeRemoveMethod
write SetIncludeRemoveMethod;
property IsDefault: Boolean read GetIsDefault write SetIsDefault;
+ property UseNull: Boolean read GetUseNull write SetUseNull;
property StorageKind: TInstantStorageKind read GetStorageKind
write SetStorageKind;
property IsIndexed: Boolean read GetIsIndexed write SetIsIndexed;
@@ -1548,6 +1551,7 @@
MetadataInfoID = 'IOMETADATA';
MetaKeyDefault = 'default';
+ MetaKeyUseNull = 'usenull';
MetaKeyExternal = 'external';
MetaKeyFormat = 'format';
MetaKeyIndex = 'index';
@@ -3949,6 +3953,11 @@
Result := FTailor;
end;
+function TInstantCodeAttribute.GetUseNull: Boolean;
+begin
+ Result := Metadata.UseNull;
+end;
+
function TInstantCodeAttribute.GetValueGetterCode: string;
begin
Result := Tailor.ValueGetterCode;
@@ -4002,6 +4011,8 @@
Metadata.StorageName := Reader.ReadStringValue
else if Token = MetaKeyDefault then
Metadata.DefaultValue := Reader.ReadStringValue
+ else if Token = MetaKeyUseNull then
+ Metadata.UseNull := True
else if Token = MetaKeyIndex then
IsIndexed := True
else if Token = MetaKeyRequired then
@@ -4055,6 +4066,8 @@
Writer.Write(' ' + MetaKeyIndex);
if IsRequired then
Writer.Write(' ' + MetaKeyRequired);
+ if Metadata.UseNull then
+ Writer.Write(' ' + MetaKeyUseNull);
if IsDefault then
Writer.Write(' ' + MetaKeyDefault);
Writer.Write(';');
@@ -4205,6 +4218,11 @@
Metadata.FieldName := Value;
end;
+procedure TInstantCodeAttribute.SetUseNull(const Value: Boolean);
+begin
+ Metadata.UseNull := Value;
+end;
+
procedure TInstantCodeAttribute.SetVisibility(
Value: TInstantCodeVisibility);
begin
Modified: trunk/Source/Core/InstantMetadata.pas
===================================================================
--- trunk/Source/Core/InstantMetadata.pas 2008-02-25 17:55:07 UTC (rev 777)
+++ trunk/Source/Core/InstantMetadata.pas 2008-02-27 09:03:37 UTC (rev 778)
@@ -434,6 +434,7 @@
private
FAttributeType: TInstantAttributeType;
FDefaultValue: string;
+ FUseNull: Boolean;
FDisplayWidth: Integer;
FEditMask: string;
FIsIndexed: Boolean;
@@ -497,6 +498,7 @@
write SetAttributeTypeName stored False;
property ClassMetadata: TInstantClassMetadata read GetClassMetadata;
property DefaultValue: string read FDefaultValue write FDefaultValue;
+ property UseNull: Boolean read FUseNull write FUseNull;
property DisplayWidth: Integer read FDisplayWidth write FDisplayWidth
default 0;
property EditMask: string read FEditMask write FEditMask;
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2008-02-25 17:55:07 UTC (rev 777)
+++ trunk/Source/Core/InstantPersistence.pas 2008-02-27 09:03:37 UTC (rev 778)
@@ -179,6 +179,7 @@
function GetDisplayText: string; virtual;
function GetIsChanged: Boolean; virtual;
function GetIsDefault: Boolean; virtual;
+ function GetIsNull: Boolean; virtual;
function GetIsMandatory: Boolean; virtual;
function GetOwner: TInstantObject; reintroduce; virtual;
procedure Initialize; override;
@@ -220,6 +221,7 @@
property IsIndexed: Boolean read GetIsIndexed;
property IsMandatory: Boolean read GetIsMandatory;
property IsRequired: Boolean read GetIsRequired;
+ property IsNull: Boolean read GetIsNull;
property Name: string read GetName;
property Metadata: TInstantAttributeMetadata read GetMetadata write SetMetadata;
property Owner: TInstantObject read GetOwner;
@@ -239,6 +241,7 @@
function GetAsDateTime: TDateTime; override;
function GetDisplayText: string; override;
function GetIsDefault: Boolean; override;
+ function GetIsNull: Boolean; override;
procedure SetAsBoolean(AValue: Boolean); override;
procedure SetAsDateTime(AValue: TDateTime); override;
end;
@@ -335,6 +338,7 @@
function GetAsString: string; override;
function GetAsVariant: Variant; override;
function GetIsDefault: Boolean; override;
+ function GetIsNull: Boolean; override;
function GetValue: Boolean; virtual;
procedure Initialize; override;
procedure ReadObject(Reader: TInstantReader); override;
@@ -393,6 +397,7 @@
function GetAsVariant: Variant; override;
function GetDisplayText: string; override;
function GetIsDefault: Boolean; override;
+ function GetIsNull: Boolean; override;
function GetValue: TDateTime; virtual;
procedure Initialize; override;
procedure ReadObject(Reader: TInstantReader); override;
@@ -507,6 +512,7 @@
function GetValue: TInstantObject; virtual; abstract;
procedure SetAsObject(AValue: TInstantObject); override;
procedure SetValue(AValue: TInstantObject); virtual;
+ function GetIsNull: Boolean; override;
public
function AttachObject(AObject: TInstantObject): Boolean; override;
function DetachObject(AObject: TInstantObject): Boolean; override;
@@ -2389,7 +2395,8 @@
//Result := CompareMem(@DefaultStr[1], @ValueStr[1], L);
Result := CompareStr(DefaultStr, ValueStr) = 0;
end;
- end else
+ end
+ else
Result := L = 0;
end;
@@ -2403,6 +2410,13 @@
Result := IsRequired or IsIndexed;
end;
+function TInstantAttribute.GetIsNull: Boolean;
+begin
+ Result := False;
+ if Assigned(Metadata) then
+ Result := Metadata.UseNull and (AsString = '');
+end;
+
function TInstantAttribute.GetIsRequired: Boolean;
begin
Result := Assigned(Metadata) and Metadata.IsRequired;
@@ -2568,12 +2582,20 @@
function TInstantNumeric.GetIsDefault: Boolean;
begin
- if Assigned(Metadata) and (Metadata.Defaultvalue <> '') then
+ if Assigned(Metadata) and (Metadata.DefaultValue <> '') then
Result := inherited GetIsDefault
else
Result := AsFloat = 0;
end;
+function TInstantNumeric.GetIsNull: Boolean;
+begin
+ if Assigned(Metadata) and (Metadata.UseNull) then
+ Result := AsFloat = 0
+ else
+ Result := inherited GetIsNull;
+end;
+
procedure TInstantNumeric.SetAsBoolean(AValue: Boolean);
begin
AsInteger := Integer(AValue);
@@ -3005,6 +3027,14 @@
Result := False;
end;
+function TInstantBoolean.GetIsNull: Boolean;
+begin
+ if Assigned(Metadata) and Metadata.UseNull then
+ Result := AsBoolean = False
+ else
+ Result := inherited GetIsNull;
+end;
+
function TInstantBoolean.GetValue: Boolean;
begin
Result := FValue;
@@ -3305,6 +3335,14 @@
Result := Value = DefaultValue;
end;
+function TInstantCustomDateTime.GetIsNull: Boolean;
+begin
+ if Assigned(Metadata) and Metadata.UseNull then
+ Result := AsDateTime = 0
+ else
+ Result := inherited GetIsNull;
+end;
+
function TInstantCustomDateTime.GetValue: TDateTime;
begin
Result := FValue;
@@ -3734,6 +3772,14 @@
Result := Value;
end;
+function TInstantElement.GetIsNull: Boolean;
+begin
+ if Assigned(Metadata) and Metadata.UseNull then
+ Result := not HasValue
+ else
+ Result := inherited GetIsNull;
+end;
+
function TInstantElement.HasValue: Boolean;
begin
Result := False;
|
|
From: <sr...@us...> - 2006-07-20 00:57:18
|
Revision: 687 Author: srmitch Date: 2006-07-19 17:56:59 -0700 (Wed, 19 Jul 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=687&view=rev Log Message: ----------- - Changes to enable the navigational brokers to use external storage of attributes. Refactored the code for handling the external linking tables into TInstantLinkResolver and descendant classes to allow for this. - Updated BDE broker to use new external storage of attributes feature. Still need to add index for parent class and id fields in the linking table for this to work. - Updated unit tests to include new InstantContainer AddReference method (see TestInstantParts.pas and TestInstantReferences.pas). Modified Paths: -------------- trunk/Source/Brokers/BDE/InstantBDE.pas trunk/Source/Core/InstantConsts.pas trunk/Source/Core/InstantPersistence.pas trunk/Source/Tests/TestInstantParts.pas trunk/Source/Tests/TestInstantReferences.pas trunk/Source/Tests/TestModel.pas Modified: trunk/Source/Brokers/BDE/InstantBDE.pas =================================================================== --- trunk/Source/Brokers/BDE/InstantBDE.pas 2006-07-18 07:46:13 UTC (rev 686) +++ trunk/Source/Brokers/BDE/InstantBDE.pas 2006-07-20 00:56:59 UTC (rev 687) @@ -112,11 +112,13 @@ function GetDataSet: TTable; protected function CreateDataSet: TDataSet; override; - function FormatTableName(const ATableName: string): string; virtual; + function CreateNavigationalLinkResolver(const ATableName: string): + TInstantNavigationalLinkResolver; override; function Locate(const AClassName, AObjectId: string): Boolean; override; function TranslateError(AObject: TInstantObject; E: Exception): Exception; override; public + function FormatTableName(const ATableName: string): string; virtual; property Broker: TInstantBDEBroker read GetBroker; property DataSet: TTable read GetDataSet; end; @@ -213,6 +215,24 @@ property IndexMetadata: TInstantIndexMetadata read GetIndexMetadata; end; +type + TInstantBDELinkResolver = class(TInstantNavigationalLinkResolver) + private + function GetBroker: TInstantBDEBroker; + function GetDataSet: TTable; + function GetResolver: TInstantBDEResolver; + protected + function CreateDataSet: TDataSet; override; + procedure SetDatasetParentRange(const AParentClass, AParentId: string); + override; + public + constructor Create(AResolver: TInstantNavigationalResolver; const ATableName: + string); + property Broker: TInstantBDEBroker read GetBroker; + property DataSet: TTable read GetDataSet; + property Resolver: TInstantBDEResolver read GetResolver; + end; + procedure Register; implementation @@ -504,13 +524,18 @@ end; end; -function TInstantBDEResolver.FormatTableName( - const ATableName: string): string; +function TInstantBDEResolver.CreateNavigationalLinkResolver(const ATableName: + string): TInstantNavigationalLinkResolver; begin + Result := TInstantBDELinkResolver.Create(Self, ATableName); +end; + +function TInstantBDEResolver.FormatTableName(const ATableName: string): string; +begin if Broker.Connector.DriverType = dtOracle then Result := UpperCase(ATableName) else - Result := TableName; + Result := ATableName; end; function TInstantBDEResolver.GetBroker: TInstantBDEBroker; @@ -523,14 +548,14 @@ Result := inherited DataSet as TTable; end; -function TInstantBDEResolver.Locate(const AClassName, - AObjectId: string): Boolean; +function TInstantBDEResolver.Locate(const AClassName, AObjectId: string): + Boolean; begin Result := DataSet.FindKey([AClassName, AObjectId]); end; function TInstantBDEResolver.TranslateError( - AObject: TInstantObject; E: Exception): Exception; + AObject: TInstantObject; E: Exception): Exception; var Error: TDBError; begin @@ -863,7 +888,51 @@ end; end; +constructor TInstantBDELinkResolver.Create(AResolver: + TInstantNavigationalResolver; const ATableName: string); +begin + inherited Create(AResolver, ATableName); +end; +function TInstantBDELinkResolver.CreateDataSet: TDataSet; +begin + Result:= TTable.Create(nil); + with TTable(Result) do + try + DatabaseName := Broker.Connector.Connection.DatabaseName; + TableName := Resolver.FormatTableName(Self.TableName); + IndexFieldNames := InstantParentClassFieldName + ';' + + InstantParentIdFieldName; + CacheBlobs := False; + UpdateMode := upWhereKeyOnly; + except + Result.Free; + raise; + end; +end; + +function TInstantBDELinkResolver.GetBroker: TInstantBDEBroker; +begin + Result := inherited Broker as TInstantBDEBroker; +end; + +function TInstantBDELinkResolver.GetDataSet: TTable; +begin + Result := inherited DataSet as TTable; +end; + +function TInstantBDELinkResolver.GetResolver: TInstantBDEResolver; +begin + Result := inherited Resolver as TInstantBDEResolver; +end; + +procedure TInstantBDELinkResolver.SetDatasetParentRange(const + AParentClass, AParentId: string); +begin + Dataset.SetRange([AParentClass, AParentId], [AParentClass, AParentId]); +end; + + initialization RegisterClass(TInstantBDEConnectionDef); TInstantBDEConnector.RegisterClass; Modified: trunk/Source/Core/InstantConsts.pas =================================================================== --- trunk/Source/Core/InstantConsts.pas 2006-07-18 07:46:13 UTC (rev 686) +++ trunk/Source/Core/InstantConsts.pas 2006-07-20 00:56:59 UTC (rev 687) @@ -182,6 +182,7 @@ SUnknownAttributeClass = 'Unknown attribute class for attribute %s(''%s'')'; SUnspecifiedCommand = 'Command is not specified'; SUnsupportedColumnSkipped = 'Skipped column %s.%s. Unsupported type %s.'; + SUnsupportedAttributeOperation = 'Unsupported operation (%s) for attribute %s(''%s''). Reason: %s.'; SUnsupportedDataType = 'Unsupported datatype: %s'; SUnsupportedGraphicClass = 'Unsupported graphic class'; SUnsupportedGraphicStream = 'Unsupported graphic stream format'; Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-07-18 07:46:13 UTC (rev 686) +++ trunk/Source/Core/InstantPersistence.pas 2006-07-20 00:56:59 UTC (rev 687) @@ -999,7 +999,7 @@ end; TInstantSortCompare = function(Holder, Obj1, Obj2: TInstantObject): Integer of object; - TInstantContentChangeType = (ctAdd, ctRemove, ctReplace, ctClear); + TInstantContentChangeType = (ctAdd, ctAddRef, ctRemove, ctReplace, ctClear); TInstantContainer = class(TInstantComplex) private @@ -1017,6 +1017,8 @@ function GetInstances(Index: Integer): TInstantObject; virtual; function GetIsDefault: Boolean; override; function InternalAdd(AObject: TInstantObject): Integer; virtual; abstract; + function InternalAddReference(const AObjectClassName, AObjectId: string): + Integer; virtual; abstract; procedure InternalClear; virtual; abstract; procedure InternalDelete(Index: Integer); virtual; abstract; function InternalGetItems(Index: Integer): TInstantObject; virtual; abstract; @@ -1030,6 +1032,7 @@ property Instances[Index: Integer]: TInstantObject read GetInstances; public function Add(AObject: TInstantObject): Integer; + function AddReference(const AObjectClassName, AObjectId: string): Integer; function AttachObject(AObject: TInstantObject): Boolean; override; procedure Clear; procedure Delete(Index: Integer); @@ -1072,6 +1075,8 @@ function GetIsChanged: Boolean; override; function GetInstances(Index: Integer): TInstantObject; override; function InternalAdd(AObject: TInstantObject): Integer; override; + function InternalAddReference(const AObjectClassName, AObjectId: string): + Integer; override; procedure InternalClear; override; procedure InternalDelete(Index: Integer); override; function InternalGetItems(Index: Integer): TInstantObject; override; @@ -1108,6 +1113,8 @@ function GetCount: Integer; override; function GetInstances(Index: Integer): TInstantObject; override; function InternalAdd(AObject: TInstantObject): Integer; override; + function InternalAddReference(const AObjectClassName, AObjectId: string): + Integer; override; procedure InternalClear; override; procedure InternalDelete(Index: Integer); override; function InternalGetItems(Index: Integer): TInstantObject; override; @@ -1362,6 +1369,7 @@ property ObjectClass: TInstantObjectClass read GetObjectClass; property ObjectCount: Integer read GetObjectCount; property Id: string read GetId write SetId; + property InUpdate: Boolean read FInUpdate write FInUpdate; property Objects[Index: Integer]: TInstantObject read GetObjects write SetObjects; property Owner: TInstantObject read FOwner; property OwnerAttribute: TInstantComplex read FOwnerAttribute; @@ -1980,6 +1988,9 @@ end; TInstantCustomResolver = class; + TInstantLinkResolver = class; + TInstantNavigationalLinkResolver = class; + TInstantSQLLinkResolver = class; TInstantBrokerOperation = procedure(AObject: TInstantObject; const AObjectId: string; Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction = caFail; Info: PInstantOperationInfo = nil) of object; @@ -2150,6 +2161,7 @@ private FDataSet: TDataSet; FFreeDataSet: Boolean; + FNavigationalLinkResolvers: TObjectList; FTableName: string; function CheckConflict(AObject: TInstantObject; const AObjectId: string; ConflictAction: TInstantConflictAction): Boolean; @@ -2159,6 +2171,9 @@ procedure FreeDataSet; function GetBroker: TInstantNavigationalBroker; function GetDataSet: TDataSet; + function GetNavigationalLinkResolvers: TObjectList; + function GetObjectClassName: string; + function GetObjectId: string; procedure PerformOperation(AObject: TInstantObject; Map: TInstantAttributeMap; Operation: TInstantNavigationalResolverOperation); procedure ReadAttribute(AObject: TInstantObject; @@ -2185,17 +2200,24 @@ procedure ClearString(Attribute: TInstantString); virtual; procedure Close; virtual; function CreateDataSet: TDataSet; virtual; abstract; + function CreateNavigationalLinkResolver(const ATableName: string): + TInstantNavigationalLinkResolver; virtual; abstract; function CreateLocateVarArray(const AObjectClassName, AObjectId: string): Variant; procedure Delete; virtual; procedure Edit; virtual; + function GetLinkDatasetResolver(const ATableName: string): + TInstantNavigationalLinkResolver; function FieldHasObjects(Field: TField): Boolean; virtual; + function FindLinkDatasetResolver(const ATableName: string): + TInstantNavigationalLinkResolver; procedure InternalDisposeMap(AObject: TInstantObject; Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo); override; procedure InternalRetrieveMap(AObject: TInstantObject; const AObjectId: string; Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo); override; procedure InternalStoreMap(AObject: TInstantObject; Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo); override; - function Locate(const AObjectClassName, AObjectId: string): Boolean; virtual; abstract; + function Locate(const AObjectClassName, AObjectId: string): Boolean; virtual; + abstract; procedure Open; virtual; procedure Post; virtual; procedure ReadBlob(Attribute: TInstantBlob); virtual; @@ -2226,11 +2248,15 @@ procedure WriteReferences(Attribute: TInstantReferences); virtual; procedure WriteString(Attribute: TInstantString); virtual; property DataSet: TDataset read GetDataSet write SetDataSet; + property NavigationalLinkResolvers: TObjectList read + GetNavigationalLinkResolvers; public constructor Create(ABroker: TInstantNavigationalBroker; const ATableName: string); destructor Destroy; override; property Broker: TInstantNavigationalBroker read GetBroker; + property ObjectClassName: string read GetObjectClassName; + property ObjectId: string read GetObjectId; property TableName: string read FTableName; end; @@ -2636,6 +2662,7 @@ procedure Exchange(Index1, Index2: Integer); function IndexOf(Item: TInstantObject; NeedInstance: Boolean = False): Integer; function IndexOfInstance(Item: TInstantObject): Integer; + function IndexOfReference(AObjectReference: TInstantObjectReference): Integer; procedure Insert(Index: Integer; Item: TInstantObject); procedure Move(CurIndex, NewIndex: Integer); function Remove(Item: TInstantObject): Integer; @@ -2646,6 +2673,103 @@ property RefItems[Index: Integer]: TInstantObjectReference read GetRefItems; end; + // TInstantLinkResolver class defines common interface for handling + // access to container attributes with external storage + TInstantLinkResolver = class(TInstantStreamable) + private + FResolver: TInstantCustomResolver; + function GetBroker: TInstantCustomRelationalBroker; + function GetResolver: TInstantCustomResolver; + protected + procedure InternalStoreAttributeObjects(Attribute: TInstantContainer); virtual; + procedure InternalClearAttributeLinkRecords; virtual; + procedure InternalDisposeDeletedAttributeObjects(Attribute: TInstantContainer); + virtual; + procedure InternalReadAttributeObjects(Attribute: TInstantContainer; const + AObjectId: string); virtual; + public + constructor Create(AResolver: TInstantCustomResolver); + procedure StoreAttributeObjects(Attribute: TInstantContainer); + procedure ClearAttributeLinkRecords; + procedure DisposeDeletedAttributeObjects(Attribute: TInstantContainer); + procedure ReadAttributeObjects(Attribute: TInstantContainer; const AObjectId: + string); + property Broker: TInstantCustomRelationalBroker read GetBroker; + property Resolver: TInstantCustomResolver read GetResolver; + end; + + // TInstantNavigationalLinkResolver is an abstract class that + // defines the interface for handling access to container attributes + // with external storage for navigational brokers. + // Each navigational broker needs to provide a concrete class descendent. + // See the BDE broker as an example. + TInstantNavigationalLinkResolver = class(TInstantLinkResolver) + private + FDataSet: TDataSet; + FFreeDataSet: Boolean; + FTableName: string; + function FieldByName(const FieldName: string): TField; + procedure FreeDataSet; + function GetBroker: TInstantNavigationalBroker; + function GetDataSet: TDataSet; + function GetResolver: TInstantNavigationalResolver; + procedure SetDataSet(Value: TDataset); + protected + procedure Append; virtual; + procedure Cancel; virtual; + procedure Close; virtual; + function CreateDataSet: TDataSet; virtual; abstract; + procedure Delete; virtual; + procedure Edit; virtual; + function Eof: Boolean; virtual; + procedure First; virtual; + procedure InternalStoreAttributeObjects(Attribute: TInstantContainer); override; + procedure InternalClearAttributeLinkRecords; override; + procedure InternalDisposeDeletedAttributeObjects(Attribute: TInstantContainer); + override; + procedure InternalReadAttributeObjects(Attribute: TInstantContainer; const + AObjectId: string); override; + procedure Next; virtual; + procedure Open; virtual; + procedure Post; virtual; + procedure SetDatasetParentRange(const AParentClass, AParentId: string); + virtual; abstract; + property DataSet: TDataset read GetDataSet write SetDataSet; + public + constructor Create(AResolver: TInstantNavigationalResolver; const ATableName: + string); + destructor Destroy; override; + property Broker: TInstantNavigationalBroker read GetBroker; + property Resolver: TInstantNavigationalResolver read GetResolver; + property TableName: string read FTableName; + end; + + // TInstantSQLLinkResolver class defines interface for handling + // access to container attributes with external storage for + // SQL brokers. Due to the generic nature of SQL this class is used + // directly and no descendant classes are needed for SQL brokers. + TInstantSQLLinkResolver = class(TInstantLinkResolver) + private + FAttributeOwner: TInstantObject; + FTableName: string; + function GetBroker: TInstantSQLBroker; + function GetResolver: TInstantSQLResolver; + property TableName: string read FTableName; + protected + procedure InternalStoreAttributeObjects(Attribute: TInstantContainer); override; + procedure InternalClearAttributeLinkRecords; override; + procedure InternalDisposeDeletedAttributeObjects(Attribute: TInstantContainer); + override; + procedure InternalReadAttributeObjects(Attribute: TInstantContainer; const + AObjectId: string); override; + public + constructor Create(AResolver: TInstantSQLResolver; const ATableName: string; + AObject: TInstantObject); + property AttributeOwner: TInstantObject read FAttributeOwner; + property Broker: TInstantSQLBroker read GetBroker; + property Resolver: TInstantSQLResolver read GetResolver; + end; + procedure AssignInstantStreamFormat(Strings: TStrings); function InstantAttributeTypeToDataType(AttributeType: TInstantAttributeType; BlobStreamFormat: TInstantStreamFormat = sfBinary): TInstantDataType; @@ -6560,6 +6684,21 @@ AfterContentChange(ctAdd, Result, AObject); end; +function TInstantContainer.AddReference(const AObjectClassName, AObjectId: + string): Integer; +begin + if Assigned(Metadata) and (Metadata.StorageKind = skEmbedded) then + raise EInstantError.CreateFmt(SUnsupportedAttributeOperation, + ['AddReference', ClassName, Name, 'StorageKind = skEmbedded']); + if RequiredClassName <> AObjectClassName then + raise EInstantValidationError.CreateFmt(SInvalidObjectClass, + [AObjectClassName, ClassName, Name, RequiredClass.ClassName]); + + BeforeContentChange(ctAddRef, -1, nil); + Result := InternalAddReference(AObjectClassName, AObjectId); + AfterContentChange(ctAddRef, Result, nil); +end; + procedure TInstantContainer.AfterContentChange( ChangeType: TInstantContentChangeType; Index: Integer; AObject: TInstantObject); @@ -6993,6 +7132,25 @@ end; end; +function TInstantParts.InternalAddReference(const AObjectClassName, AObjectId: + string): Integer; +var + Ref: TInstantObjectReference; +begin + Result := -1; + + if Metadata.StorageKind = skExternal then + begin + Ref := CreateObjectReference(nil); + try + Ref.ReferenceObject(AObjectClassName, AObjectId); + Result := ObjectReferenceList.Add(Ref); + except + Ref.Free; + end; + end; +end; + procedure TInstantParts.InternalClear; var I: Integer; @@ -7296,6 +7454,25 @@ Result := ObjectReferenceList.Add(AObject); end; +function TInstantReferences.InternalAddReference(const AObjectClassName, + AObjectId: string): Integer; +var + Ref: TInstantObjectReference; +begin + Result := -1; + + if Metadata.StorageKind = skExternal then + begin + Ref := ObjectReferenceList.Add; + try + Ref.ReferenceObject(AObjectClassName, AObjectId); + Result := ObjectReferenceList.IndexOfReference(Ref); + except + Ref.Free; + end; + end; +end; + procedure TInstantReferences.InternalClear; begin ObjectReferenceList.Clear; @@ -8388,7 +8565,7 @@ if Result then Exit; end; - end; + end; end; var @@ -10161,7 +10338,7 @@ if not (Assigned(AObject) and AObject.Metadata.IsStored) then Exit; CheckBroker(Broker); - AObject.FInUpdate := True; + AObject.InUpdate := True; try try if Broker.StoreObject(AObject, ConflictAction) then @@ -10186,7 +10363,7 @@ [AObject.ClassName, AObject.Id, E.Message], E); end; finally - AObject.FInUpdate := False; + AObject.InUpdate := False; end; end; @@ -11739,7 +11916,7 @@ // Remove references from the BusyList for objects destroyed // when the query was closed. RemoveRefsOfDeletedObjectsFromList; - + Open; // Refresh objects in the BusyList that were not destroyed @@ -12059,10 +12236,23 @@ procedure TInstantNavigationalResolver.ClearPart(Attribute: TInstantPart); begin + if Attribute.Metadata.StorageKind = skExternal then + Attribute.Value.ObjectStore.DisposeObject(Attribute.Value, caIgnore); end; procedure TInstantNavigationalResolver.ClearParts(Attribute: TInstantParts); +var + I: Integer; + LinkDatasetResolver: TInstantNavigationalLinkResolver; begin + if Attribute.Metadata.StorageKind = skExternal then + begin + for I := 0 to Pred(Attribute.Count) do + Attribute.Items[I].ObjectStore.DisposeObject(Attribute.Items[I], caIgnore); + LinkDatasetResolver := + GetLinkDatasetResolver(Attribute.Metadata.ExternalStorageName); + LinkDatasetResolver.ClearAttributeLinkRecords; + end; end; procedure TInstantNavigationalResolver.ClearReference( @@ -12072,7 +12262,15 @@ procedure TInstantNavigationalResolver.ClearReferences( Attribute: TInstantReferences); +var + LinkDatasetResolver: TInstantNavigationalLinkResolver; begin + if Attribute.Metadata.StorageKind = skExternal then + begin + LinkDatasetResolver := + GetLinkDatasetResolver(Attribute.Metadata.ExternalStorageName); + LinkDatasetResolver.ClearAttributeLinkRecords; + end; end; procedure TInstantNavigationalResolver.ClearString(Attribute: TInstantString); @@ -12105,15 +12303,31 @@ destructor TInstantNavigationalResolver.Destroy; begin + FreeAndNil(FNavigationalLinkResolvers); FreeDataSet; inherited; end; +procedure TInstantNavigationalResolver.ClearEnum(Attribute: TInstantEnum); +begin +end; + procedure TInstantNavigationalResolver.Edit; begin DataSet.Edit; end; +function TInstantNavigationalResolver.GetLinkDatasetResolver(const ATableName: + string): TInstantNavigationalLinkResolver; +begin + Result := FindLinkDatasetResolver(ATableName); + if not Assigned(Result) then + begin + Result := CreateNavigationalLinkResolver(ATableName); + NavigationalLinkResolvers.Add(Result); + end; +end; + function TInstantNavigationalResolver.FieldByName( const FieldName: string): TField; begin @@ -12125,6 +12339,20 @@ Result := Length(Field.AsString) > 1; end; +function TInstantNavigationalResolver.FindLinkDatasetResolver(const ATableName: + string): TInstantNavigationalLinkResolver; +var + I: Integer; +begin + for I := 0 to Pred(NavigationalLinkResolvers.Count) do + begin + Result := NavigationalLinkResolvers[I] as TInstantNavigationalLinkResolver; + if SameText(ATableName, Result.TableName) then + Exit; + end; + Result := nil; +end; + procedure TInstantNavigationalResolver.FreeDataSet; begin if FFreeDataSet then @@ -12151,6 +12379,23 @@ Result := FDataSet; end; +function TInstantNavigationalResolver.GetNavigationalLinkResolvers: TObjectList; +begin + if not Assigned(FNavigationalLinkResolvers) then + FNavigationalLinkResolvers := TObjectList.Create; + Result := FNavigationalLinkResolvers; +end; + +function TInstantNavigationalResolver.GetObjectClassName: string; +begin + Result := FieldByName(InstantClassFieldName).AsString; +end; + +function TInstantNavigationalResolver.GetObjectId: string; +begin + Result := FieldByName(InstantIdFieldName).AsString; +end; + procedure TInstantNavigationalResolver.InternalDisposeMap( AObject: TInstantObject; Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo); @@ -12388,17 +12633,38 @@ var Field: TField; Stream: TInstantStringStream; + PartClassName: string; + ObjID: string; begin with Attribute do begin - Field := FieldByName(Metadata.FieldName); - if not FieldHasObjects(Field) then - Exit; - Stream := TInstantStringStream.Create(Field.AsString); - try - LoadObjectFromStream(Stream); - finally - Stream.Free; + if Metadata.StorageKind = skExternal then + begin + // Must clear Value first to avoid leak for Refresh operation + // as OldValue = NewValue. + Value := nil; + PartClassName := FieldByName(Metadata.FieldName + + InstantClassFieldName).AsString; + ObjID := FieldByName(Metadata.FieldName + InstantIdFieldName).AsString; + // PartClassName and ObjID will be empty if the attribute was + // added to a class with existing instances in the database. + if (PartClassName = '') and (ObjID = '') then + Attribute.Reset + else + Value := InstantFindClass(PartClassName).Retrieve( + ObjID, False, False, Connector); + end + else + begin + Field := FieldByName(Metadata.FieldName); + if not FieldHasObjects(Field) then + Exit; + Stream := TInstantStringStream.Create(Field.AsString); + try + LoadObjectFromStream(Stream); + finally + Stream.Free; + end; end; end; end; @@ -12407,17 +12673,28 @@ var Field: TField; Stream: TInstantStringStream; + LinkDatasetResolver: TInstantNavigationalLinkResolver; begin with Attribute do begin - Field := FieldByName(Metadata.FieldName); - if not FieldHasObjects(Field) then - Exit; - Stream := TInstantStringStream.Create(Field.AsString); - try - LoadObjectsFromStream(Stream); - finally - Stream.Free; + if Metadata.StorageKind = skExternal then + begin + Clear; + LinkDatasetResolver := + GetLinkDatasetResolver(Metadata.ExternalStorageName); + LinkDatasetResolver.ReadAttributeObjects(Attribute, ObjectId); + end + else + begin + Field := FieldByName(Metadata.FieldName); + if not FieldHasObjects(Field) then + Exit; + Stream := TInstantStringStream.Create(Field.AsString); + try + LoadObjectsFromStream(Stream); + finally + Stream.Free; + end; end; end; end; @@ -12440,17 +12717,28 @@ var Field: TField; Stream: TInstantStringStream; + LinkDatasetResolver: TInstantNavigationalLinkResolver; begin with Attribute do begin - Field := FieldByName(Metadata.FieldName); - if not FieldHasObjects(Field) then - Exit; - Stream := TInstantStringStream.Create(Field.AsString); - try - LoadReferencesFromStream(Stream); - finally - Stream.Free; + if Metadata.StorageKind = skExternal then + begin + Clear; + LinkDatasetResolver := + GetLinkDatasetResolver(Metadata.ExternalStorageName); + LinkDatasetResolver.ReadAttributeObjects(Attribute, ObjectId); + end + else + begin + Field := FieldByName(Metadata.FieldName); + if not FieldHasObjects(Field) then + Exit; + Stream := TInstantStringStream.Create(Field.AsString); + try + LoadReferencesFromStream(Stream); + finally + Stream.Free; + end; end; end; end; @@ -12502,6 +12790,8 @@ with AttributeMetadata do begin Attribute := AObject.AttributeByName(Name); + if not Attribute.IsChanged then + Exit; case AttributeType of atInteger: WriteInteger(Attribute as TInstantInteger); @@ -12586,13 +12876,25 @@ begin with Attribute do begin - Field := FieldByName(Metadata.FieldName); - Stream := TInstantStringStream.Create(''); - try - SaveObjectToStream(Stream); - Field.AsString := Stream.DataString; - finally - Stream.Free; + if Metadata.StorageKind = skExternal then + begin + Value.CheckId; + FieldByName(Metadata.FieldName + InstantClassFieldName).AsString := + Value.ClassName; + FieldByName(Metadata.FieldName + InstantIdFieldName).AsString := + Value.Id; + Value.ObjectStore.StoreObject(Value, caIgnore); + end + else + begin + Field := FieldByName(Metadata.FieldName); + Stream := TInstantStringStream.Create(''); + try + SaveObjectToStream(Stream); + Field.AsString := Stream.DataString; + finally + Stream.Free; + end; end; end; end; @@ -12601,16 +12903,33 @@ var Field: TField; Stream: TInstantStringStream; + LinkDatasetResolver: TInstantNavigationalLinkResolver; begin with Attribute do begin - Field := FieldByName(Metadata.FieldName); - Stream := TInstantStringStream.Create(''); - try - Attribute.SaveObjectsToStream(Stream); - Field.AsString := Stream.DataString; - finally - Stream.Free; + if Metadata.StorageKind = skExternal then + begin + LinkDatasetResolver := + GetLinkDatasetResolver(Metadata.ExternalStorageName); + LinkDatasetResolver.Open; + try + LinkDatasetResolver.DisposeDeletedAttributeObjects(Attribute); + LinkDatasetResolver.ClearAttributeLinkRecords; + LinkDatasetResolver.StoreAttributeObjects(Attribute); + finally + LinkDatasetResolver.Close; + end; + end + else + begin + Field := FieldByName(Metadata.FieldName); + Stream := TInstantStringStream.Create(''); + try + SaveObjectsToStream(Stream); + Field.AsString := Stream.DataString; + finally + Stream.Free; + end; end; end; end; @@ -12631,16 +12950,32 @@ var Field: TField; Stream: TInstantStringStream; + LinkDatasetResolver: TInstantNavigationalLinkResolver; begin with Attribute do begin - Field := FieldByName(Metadata.FieldName); - Stream := TInstantStringStream.Create(''); - try - SaveReferencesToStream(Stream); - Field.AsString := Stream.DataString; - finally - Stream.Free; + if Metadata.StorageKind = skExternal then + begin + LinkDatasetResolver := + GetLinkDatasetResolver(Metadata.ExternalStorageName); + LinkDatasetResolver.Open; + try + LinkDatasetResolver.ClearAttributeLinkRecords; + LinkDatasetResolver.StoreAttributeObjects(Attribute); + finally + LinkDatasetResolver.Close; + end; + end + else + begin + Field := FieldByName(Metadata.FieldName); + Stream := TInstantStringStream.Create(''); + try + SaveReferencesToStream(Stream); + Field.AsString := Stream.DataString; + finally + Stream.Free; + end; end; end; end; @@ -12793,7 +13128,7 @@ I: Integer; begin for I := 0 to Pred(ObjectRowCount) do - if (ObjectRows[I]^.Instance is TInstantObject) then + if ObjectFetched(I) and (ObjectRows[I]^.Instance is TInstantObject) then List.Add(TInstantObject(ObjectRows[I]^.Instance)); end; @@ -13967,143 +14302,83 @@ for i := 0 to Pred(Map.Count) do begin AttributeMetadata := Map[i]; - if Map[i].AttributeType = atPart then + if (AttributeMetadata.AttributeType = atPart) and + (AttributeMetadata.StorageKind = skExternal) then begin - if Map[i].StorageKind = skExternal then - begin - // Dispose object - SelectParams := TParams.Create; + // Dispose object + SelectParams := TParams.Create; + try + SelectStatement := Format(SelectExternalPartSQL, + [AttributeMetadata.FieldName + InstantClassFieldName, + AttributeMetadata.FieldName + InstantIdFieldName, + AttributeMetadata.ClassMetadata.TableName]); + AddStringParam(SelectParams, InstantClassFieldName, AObject.ClassName); + AddIdParam(SelectParams, InstantIdFieldName, AObject.Id); + DataSet := Broker.AcquireDataSet(SelectStatement, SelectParams); try - SelectStatement := Format(SelectExternalPartSQL, - [AttributeMetadata.FieldName + InstantClassFieldName, - AttributeMetadata.FieldName + InstantIdFieldName, - AttributeMetadata.ClassMetadata.TableName]); - AddStringParam(SelectParams, InstantClassFieldName, AObject.ClassName); - AddIdParam(SelectParams, InstantIdFieldName, AObject.Id); - DataSet := Broker.AcquireDataSet(SelectStatement, SelectParams); + DataSet.Open; try - DataSet.Open; - try - if not DataSet.IsEmpty then - begin - PartObject := AttributeMetadata.ObjectClass.Retrieve( - DataSet.Fields[1].AsString, False, False, AObject.Connector); - try - if Assigned(PartObject) then - PartObject.ObjectStore.DisposeObject(PartObject, caIgnore); - finally - PartObject.Free; - end; + if not DataSet.IsEmpty then + begin + PartObject := AttributeMetadata.ObjectClass.Retrieve( + DataSet.Fields[1].AsString, False, False, AObject.Connector); + try + if Assigned(PartObject) then + PartObject.ObjectStore.DisposeObject(PartObject, caIgnore); + finally + PartObject.Free; end; - finally - DataSet.Close; end; finally - Broker.ReleaseDataSet(DataSet); + DataSet.Close; end; finally - SelectParams.Free; + Broker.ReleaseDataSet(DataSet); end; - + finally + SelectParams.Free; end; end; end; end; - procedure DeleteExternalPartsMap; + procedure DeleteAllExternalLinks(Index: Integer); var - i: Integer; - PartObject: TInstantObject; - SelectParams, DeleteParams: TParams; - SelectStatement, DeleteStatement: string; - AttributeMetadata: TInstantAttributeMetadata; - DataSet: TDataSet; + LinkResolver: TInstantSQLLinkResolver; begin - for i := 0 to Pred(Map.Count) do - begin - AttributeMetadata := Map[i]; - if Map[i].AttributeType = atParts then - begin - if Map[i].StorageKind = skExternal then - begin - // dispose all objects - SelectParams := TParams.Create; - try - SelectStatement := Format(SelectExternalSQL, [AttributeMetadata.ExternalStorageName]); - AddIdParam(SelectParams, InstantParentIdFieldName, AObject.Id); - AddStringParam(SelectParams, InstantParentClassFieldName, AObject.ClassName); - AddStringParam(SelectParams, InstantChildClassFieldName, AttributeMetadata.ObjectClassName); - DataSet := Broker.AcquireDataSet(SelectStatement, SelectParams); - try - DataSet.Open; - try - while not DataSet.Eof do - begin - PartObject := AttributeMetadata.ObjectClass.Retrieve( - DataSet.Fields[1].AsString, False, False, AObject.Connector); - try - if Assigned(PartObject) then - PartObject.ObjectStore.DisposeObject(PartObject, caIgnore); - finally - PartObject.Free; - end; - DataSet.Next; - end; - finally - DataSet.Close; - end; - finally - Broker.ReleaseDataSet(DataSet); - end; - finally - SelectParams.Free; - end; - - // Delete all links - DeleteParams := TParams.Create; - try - DeleteStatement := Format(DeleteExternalSQL, - [AttributeMetadata.ExternalStorageName, - InstantParentClassFieldName, - InstantParentIdFieldName]); - AddStringParam(DeleteParams, InstantParentClassFieldName, AObject.ClassName); - AddIdParam(DeleteParams, InstantParentIdFieldName, AObject.Id); - Broker.Execute(DeleteStatement, DeleteParams); - finally - DeleteParams.Free; - end; - end; - end; + LinkResolver := TInstantSQLLinkResolver.Create(Self, + Map[Index].ExternalStorageName, AObject); + try + LinkResolver.ClearAttributeLinkRecords; + finally + LinkResolver.Free; end; end; - procedure DeleteExternalReferencesMap; + procedure DeleteExternalContainerMaps; var i: Integer; - DeleteParams: TParams; - DeleteStatement: string; + j: Integer; AttributeMetadata: TInstantAttributeMetadata; + Attribute: TInstantContainer; begin for i := 0 to Pred(Map.Count) do begin AttributeMetadata := Map[i]; - if AttributeMetadata.AttributeType = atReferences then + if (AttributeMetadata.AttributeType in [atParts, atReferences]) and + (AttributeMetadata.StorageKind = skExternal) then begin - if AttributeMetadata.StorageKind = skExternal then + if AttributeMetadata.AttributeType = atParts then begin - // Delete all links - DeleteParams := TParams.Create; - try - DeleteStatement := Format(DeleteExternalSQL, - [AttributeMetadata.ExternalStorageName, - InstantParentClassFieldName]); - AddStringParam(DeleteParams, InstantParentClassFieldName, AObject.ClassName); - AddIdParam(DeleteParams, InstantParentIdFieldName, AObject.Id); - Broker.Execute(DeleteStatement, DeleteParams); - finally - DeleteParams.Free; - end; + // Dispose all contained objects + Attribute := TInstantContainer(AObject.AttributeByName( + AttributeMetadata.Name)); + for j := 0 to Pred(Attribute.Count) do + Attribute.Items[j].ObjectStore.DisposeObject( + Attribute.Items[j], caIgnore); end; + + DeleteAllExternalLinks(i); end; end; end; @@ -14112,8 +14387,7 @@ if not Assigned(Info) then Info := @AInfo; DeleteExternalPartMap; - DeleteExternalPartsMap; - DeleteExternalReferencesMap; + DeleteExternalContainerMaps; Params := TParams.Create; try AddBaseParams(Params, AObject.ClassName, AObject.PersistentId); @@ -14277,173 +14551,38 @@ end; end; - procedure UpdateExternalPartsMap; + procedure UpdateExternalContainerMaps; var - i, ii: Integer; - PartObject: TInstantObject; - PartsAttribute: TInstantParts; + I: Integer; AttributeMetadata: TInstantAttributeMetadata; - SelectParams, DeleteParams, InsertParams: TParams; - SelectStatement, DeleteStatement, InsertStatement: string; - DataSet: TDataSet; + LinkResolver: TInstantSQLLinkResolver; + Attribute: TInstantContainer; begin - for i := 0 to Pred(Map.Count) do + for I := 0 to Pred(Map.Count) do begin - AttributeMetadata := Map[i]; - if AttributeMetadata.AttributeType = atParts then + AttributeMetadata := Map[I]; + if AttributeMetadata.AttributeType in [atParts, atReferences] then begin - PartsAttribute := TInstantParts(AObject.AttributeByName(AttributeMetadata.Name)); - if PartsAttribute.IsChanged then + Attribute := TInstantContainer(AObject.AttributeByName( + AttributeMetadata.Name)); + if Attribute.IsChanged and + (AttributeMetadata.StorageKind = skExternal) then begin - if Map[i].StorageKind = skExternal then - begin - // Make sure that all the items are in memory because they will be - // accessed later, after the database records have been deleted. - for ii := 0 to Pred(PartsAttribute.Count) do - PartsAttribute.Items[ii]; - // Delete all objects - SelectParams := TParams.Create; - try - SelectStatement := Format(SelectExternalSQL, [AttributeMetadata.ExternalStorageName]); - AddIdParam(SelectParams, InstantParentIdFieldName, AObject.Id); - AddStringParam(SelectParams, InstantParentClassFieldName, AObject.ClassName); - AddStringParam(SelectParams, InstantChildClassFieldName, AttributeMetadata.ObjectClassName); - DataSet := Broker.AcquireDataSet(SelectStatement, SelectParams); - try - DataSet.Open; - try - while not DataSet.Eof do - begin - PartObject := AttributeMetadata.ObjectClass.Retrieve( - DataSet.Fields[1].AsString, False, False, AObject.Connector); - try - if Assigned(PartObject) and - (PartsAttribute.IndexOf(PartObject) = -1) then - PartObject.ObjectStore.DisposeObject(PartObject, caIgnore); - finally - PartObject.Free; - end; - DataSet.Next; - end; - finally - DataSet.Close; - end; - finally - Broker.ReleaseDataSet(DataSet); - end; - finally - SelectParams.Free; - end; - - // Delete all links - DeleteParams := TParams.Create; - try - DeleteStatement := Format(DeleteExternalSQL, - [AttributeMetadata.ExternalStorageName, - InstantParentClassFieldName]); - AddStringParam(DeleteParams, InstantParentClassFieldName, AObject.ClassName); - AddIdParam(DeleteParams, InstantParentIdFieldName, AObject.Id); - Broker.Execute(DeleteStatement, DeleteParams); - finally - DeleteParams.Free; - end; - - // Store all objects and links - for ii := 0 to Pred(PartsAttribute.Count) do - begin - // Store object - PartObject := PartsAttribute.Items[ii]; - PartObject.CheckId; - PartObject.ObjectStore.StoreObject(PartObject, caIgnore); - - // Insert link - InsertParams := TParams.Create; - try - InsertStatement := Format(InsertExternalSQL, - [AttributeMetadata.ExternalStorageName]); - AddIdParam(InsertParams, InstantIdFieldName, AObject.GenerateId); - AddStringParam(InsertParams, InstantParentClassFieldName, AObject.ClassName); - AddIdParam(InsertParams, InstantParentIdFieldName, AObject.Id); - AddStringParam(InsertParams, InstantChildClassFieldName, - PartsAttribute.Items[ii].ClassName); - AddIdParam(InsertParams, InstantChildIdFieldName, - PartsAttribute.Items[ii].Id); - AddIntegerParam(InsertParams, InstantSequenceNoFieldName, Succ(ii)); - Broker.Execute(InsertStatement, InsertParams); - finally - InsertParams.Free; - end; - end; + LinkResolver := TInstantSQLLinkResolver.Create(Self, + AttributeMetadata.ExternalStorageName, AObject); + try + if AttributeMetadata.AttributeType = atParts then + LinkResolver.DisposeDeletedAttributeObjects(Attribute); + LinkResolver.ClearAttributeLinkRecords; + LinkResolver.StoreAttributeObjects(Attribute); + finally + LinkResolver.Free; end; end; end; end; end; - procedure UpdateExternalReferencesMap; - var - i, ii: integer; - AttributeMetadata: TInstantAttributeMetadata; - ReferenceObject: TInstantObject; - ReferencesAttribute: TInstantReferences; - DeleteParams, InsertParams: TParams; - DeleteStatement, InsertStatement: string; - begin - for i := 0 to Pred(Map.Count) do - begin - AttributeMetadata := Map[i]; - if AttributeMetadata.AttributeType = atReferences then - begin - ReferencesAttribute := TInstantReferences(AObject.AttributeByName(AttributeMetadata.Name)); - if ReferencesAttribute.IsChanged then - begin - if AttributeMetadata.StorageKind = skExternal then - begin - // Delete all links - DeleteParams := TParams.Create; - try - DeleteStatement := Format(DeleteExternalSQL, - [AttributeMetadata.ExternalStorageName, - InstantParentClassFieldName, - InstantParentIdFieldName]); - AddStringParam(DeleteParams, InstantParentClassFieldName, AObject.ClassName); - AddIdParam(DeleteParams, InstantParentIdFieldName, AObject.Id); - Broker.Execute(DeleteStatement, DeleteParams); - finally - DeleteParams.Free; - end; - // Store all links - for ii := 0 to Pred(ReferencesAttribute.Count) do - begin - ReferenceObject := ReferencesAttribute.Items[ii]; - if ReferenceObject.FInUpdate then // prevent recursion - Continue; - ReferenceObject.CheckId; - ReferenceObject.ObjectStore.StoreObject(ReferenceObject, caIgnore); - - InsertParams := TParams.Create; - try - InsertStatement := Format(InsertExternalSQL, - [AttributeMetadata.ExternalStorageName]); - AddIdParam(InsertParams, InstantIdFieldName, AObject.GenerateId); - AddStringParam(InsertParams, InstantParentClassFieldName, AObject.ClassName); - AddIdParam(InsertParams, InstantParentIdFieldName, AObject.Id); - AddStringParam(InsertParams, InstantChildClassFieldName, - ReferencesAttribute.Items[ii].ClassName); - AddIdParam(InsertParams, InstantChildIdFieldName, - ReferencesAttribute.Items[ii].Id); - AddIntegerParam(InsertParams, InstantSequenceNoFieldName, Succ(ii)); - Broker.Execute(InsertStatement, InsertParams); - finally - InsertParams.Free; - end; - end; - end; - end; - end; - end; - end; - begin if not Assigned(Info) then Info := @AInfo; @@ -14470,8 +14609,7 @@ if Map.IsRootMap then Broker.SetObjectUpdateCount(AObject, NewUpdateCount); - UpdateExternalPartsMap; - UpdateExternalReferencesMap; + UpdateExternalContainerMaps; finally Params.Free; end; @@ -14565,49 +14703,22 @@ procedure ReadPartsAttribute; var - //PartObject: TInstantObject; - Statement: string; - Params: TParams; Stream: TInstantStringStream; - RefObject:TInstantObjectReference; + LinkResolver: TInstantSQLLinkResolver; begin if AttributeMetadata.StorageKind = skExternal then begin with (Attribute as TInstantParts) do begin Clear; - Params := TParams.Create; + LinkResolver := TInstantSQLLinkResolver.Create(Self, + AttributeMetadata.ExternalStorageName, AObject); try - Statement := Format(SelectExternalSQL, [AttributeMetadata.ExternalStorageName]); - AddIdParam(Params, InstantParentIdFieldName, AObjectId); - AddStringParam(Params, InstantParentClassFieldName, AObject.ClassName); - AddStringParam(Params, InstantChildClassFieldName, AttributeMetadata.ObjectClassName); - DataSet := Broker.AcquireDataSet(Statement, Params); - try - DataSet.Open; - try - while not DataSet.Eof do - begin - RefObject := TInstantObjectReference.Create(nil, True); - RefObject.ReferenceObject(DataSet.Fields[0].AsString, DataSet.Fields[1].AsString); - (Attribute as TInstantParts).ObjectReferenceList.Add(RefObject); - {PartObject := AttributeMetadata.ObjectClass.Retrieve(Fields[1].AsString, False, False, AObject.Connector); - if Assigned(PartObject) then - Add(PartObject) - else - PartObject.Free;} - DataSet.Next; - end; - finally - DataSet.Close; - end; - finally - Broker.ReleaseDataSet(DataSet); - end; + LinkResolver.ReadAttributeObjects(TInstantParts(Attribute), + AObjectId); finally - Params.Free; + LinkResolver.Free; end; - //Changed; end; end else @@ -14633,41 +14744,21 @@ procedure ReadReferencesAttribute; var - RefObject:TInstantObjectReference; Stream: TInstantStringStream; - Statement: string; - Params: TParams; + LinkResolver: TInstantSQLLinkResolver; begin if AttributeMetadata.StorageKind = skExternal then begin with (Attribute as TInstantReferences) do begin Clear; - Params := TParams.Create; + LinkResolver := TInstantSQLLinkResolver.Create(Self, + AttributeMetadata.ExternalStorageName, AObject); try - Statement:=Format(SelectExternalSQL, [AttributeMetadata.ExternalStorageName]); - AddIdParam(Params, InstantParentIdFieldName, AObjectId); - AddStringParam(Params, InstantParentClassFieldName, AObject.ClassName); - AddStringParam(Params, InstantChildClassFieldName, AttributeMetadata.ObjectClassName); - DataSet := Broker.AcquireDataSet(Statement, Params); - try - DataSet.Open; - try - while not DataSet.Eof do - begin - RefObject := - (Attribute as TInstantReferences).ObjectReferenceList.Add; - RefObject.ReferenceObject(Metadata.ObjectClass, DataSet.Fields[1].AsString); - DataSet.Next; - end; - finally - DataSet.Close; - end; - finally - Broker.ReleaseDataSet(DataSet); - end; + LinkResolver.ReadAttributeObjects(TInstantReferences(Attribute), + AObjectId); finally - Params.Free; + LinkResolver.Free; end; end; end @@ -15810,6 +15901,12 @@ Result := IndexOf(Item, True); end; +function TInstantObjectReferenceList.IndexOfReference(AObjectReference: + TInstantObjectReference): Integer; +begin + Result := FList.IndexOf(AObjectReference); +end; + procedure TInstantObjectReferenceList.Insert(Index: Integer; Item: TInstantObject); var Ref: TInstantObjectReference; Modified: trunk/Source/Tests/TestInstantParts.pas =================================================================== --- trunk/Source/Tests/TestInstantParts.pas 2006-07-18 07:46:13 UTC (rev 686) +++ trunk/Source/Tests/TestInstantParts.pas 2006-07-20 00:56:59 UTC (rev 687) @@ -48,6 +48,7 @@ procedure TearDown; override; published procedure TestAdd; + procedure TestAddReference; procedure TestAssign; procedure TestAttachObject; procedure TestClear; @@ -77,6 +78,7 @@ procedure TearDown; override; published procedure TestAdd; + procedure TestAddReference; procedure TestAssign; procedure TestAttachObject; procedure TestClear; @@ -109,7 +111,7 @@ implementation -uses SysUtils, Classes, testregistry; +uses SysUtils, Classes, testregistry, InstantClasses; procedure TestTInstantExtParts.SetUp; var @@ -125,17 +127,17 @@ FOwner := TContact.Create(FConn); FInstantParts := FOwner._ExternalPhones; for i := 0 to 2 do - FOwner.AddExternalPart(TExternalPhones.Create(FConn)); + FOwner.AddExternalPart(TExternalPhone.Create(FConn)); AssertEquals('Setup FInstantParts.Count', 3, FInstantParts.Count); end; function TestTInstantExtParts.PartsExternalCompare(Holder, Obj1, Obj2: TInstantObject): Integer; var - vObj1, vObj2: TExternalPhones; + vObj1, vObj2: TExternalPhone; begin - vObj1 := Obj1 as TExternalPhones; - vObj2 := Obj2 as TExternalPhones; + vObj1 := Obj1 as TExternalPhone; + vObj2 := Obj2 as TExternalPhone; Result := AnsiCompareText(vObj1.Name, vObj2.Name); end; @@ -151,14 +153,29 @@ procedure TestTInstantExtParts.TestAdd; var vReturnValue: Integer; - vExternalPart: TExternalPhones; + vExternalPart: TExternalPhone; begin - vExternalPart := TExternalPhones.Create(FConn); + FInstantParts.Unchanged; + AssertFalse(FInstantParts.IsChanged); + vExternalPart := TExternalPhone.Create(FConn); vReturnValue := FInstantParts.Add(vExternalPart); AssertTrue(vReturnValue <> -1); + AssertTrue(FInstantParts.IsChanged); AssertEquals(4, FInstantParts.Count); end; +procedure TestTInstantExtParts.TestAddReference; +var + vReturnValue: Integer; +begin + FInstantParts.Unchanged; + AssertFalse(FInstantParts.IsChanged); + vReturnValue := FInstantParts.AddReference('TExternalPhone', 'NewPhoneId'); + AssertTrue(vReturnValue <> -1); + AssertTrue(FInstantParts.IsChanged); + AssertEquals(4, FInstantParts.Count); +end; + procedure TestTInstantExtParts.TestAssign; var vSource: TInstantParts; @@ -185,9 +202,9 @@ procedure TestTInstantExtParts.TestAttachObject; var vReturnValue: Boolean; - vExternalPart: TExternalPhones; + vExternalPart: TExternalPhone; begin - vExternalPart := TExternalPhones.Create(FConn); + vExternalPart := TExternalPhone.Create(FConn); vReturnValue := FInstantParts.AttachObject(vExternalPart); AssertTrue(vReturnValue); AssertEquals(4, FInstantParts.Count); @@ -224,13 +241,13 @@ procedure TestTInstantExtParts.TestExchange; begin - TExternalPhones(FInstantParts.Items[0]).Name := 'Part0'; - TExternalPhones(FInstantParts.Items[1]).Name := 'Part1'; - TExternalPhones(FInstantParts.Items[2]).Name := 'Part2'; + TExternalPhone(FInstantParts.Items[0]).Name := 'Part0'; + TExternalPhone(FInstantParts.Items[1]).Name := 'Part1'; + TExternalPhone(FInstantParts.Items[2]).Name := 'Part2'; FInstantParts.Exchange(0, 2); - AssertEquals('Part2', TExternalPhones(FInstantParts.Items[0]).Name); - AssertEquals('Part1', TExternalPhones(FInstantParts.Items[1]).Name); - AssertEquals('Part0', TExternalPhones(FInstantParts.Items[2]).Name); + AssertEquals('Part2', TExternalPhone(FInstantParts.Items[0]).Name); + AssertEquals('Part1', TExternalPhone(FInstantParts.Items[1]).Name); + AssertEquals('Part0', TExternalPhone(FInstantParts.Items[2]).Name); end; procedure TestTInstantExtParts.TestHasItem; @@ -250,7 +267,7 @@ vReturnValue: Integer; vObject: TInstantObject; begin - vObject := TExternalPhones.Create(FConn); + vObject := TExternalPhone.Create(FConn); FInstantParts.Insert(1, vObject); vReturnValue := FInstantParts.IndexOf(vObject); AssertEquals(1, vReturnValue); @@ -261,7 +278,7 @@ vReturnValue: Integer; vInstance: Pointer; begin - vInstance := TExternalPhones.Create(FConn); + vInstance := TExternalPhone.Create(FConn); FInstantParts.Insert(1, vInstance); vReturnValue := FInstantParts.IndexOfInstance(vInstance); AssertEquals(1, vReturnValue); @@ -269,19 +286,19 @@ procedure TestTInstantExtParts.TestMove; var - vExternalPart: TExternalPhones; + vExternalPart: TExternalPhone; begin - TExternalPhones(FInstantParts.Items[0]).Name := 'Part0'; - TExternalPhones(FInstantParts.Items[1]).Name := 'Part1'; - TExternalPhones(FInstantParts.Items[2]).Name := 'Part2'; - vExternalPart := TExternalPhones.Create(FConn); + TExternalPhone(FInstantParts.Items[0]).Name := 'Part0'; + TExternalPhone(FInstantParts.Items[1]).Name := 'Part1'; + TExternalPhone(FInstantParts.Items[2]).Name := 'Part2'; + vExternalPart := TExternalPhone.Create(FConn); FInstantParts.Add(vExternalPart); - TExternalPhones(FInstantParts.Items[3]).Name := 'Part3'; + TExternalPhone(FInstantParts.Items[3]).Name := 'Part3'; FInstantParts.Move(0, 2); - AssertEquals('Part1', TExternalPhones(FInstantParts.Items[0]).Name); - AssertEquals('Part2', TExternalPhones(FInstantParts.Items[1]).Name); - AssertEquals('Part0', TExternalPhones(FInstantParts.Items[2]).Name); - AssertEquals('Part3', TExternalPhones(FInstantParts.Items[3]).Name); + AssertEquals('Part1', TExternalPhone(FInstantParts.Items[0]).Name); + AssertEquals('Part2', TExternalPhone(FInstantParts.Items[1]).Name); + AssertEquals('Part0', TExternalPhone(FInstantParts.Items[2]).Name); + AssertEquals('Part3', TExternalPhone(FInstantParts.Items[3]).Name); end; procedure TestTInstantExtParts.TestRemove; @@ -321,20 +338,20 @@ procedure TestTInstantExtParts.TestSort; var - vExternalPart: TExternalPhones; + vExternalPart: TExternalPhone; begin - TExternalPhones(FInstantParts.Items[0]).Name := '2 Part'; - TExternalPhones(FInstantParts.Items[1]).Name := '0 Part'; - TExternalPhones(FInstantParts.Items[2]).Name := '1 Part'; - vExternalPart := TExternalPhones.Create(FConn); + TExternalPhone(FInstantParts.Items[0]).Name := '2 Part'; + TExternalPhone(FInstantParts.Items[1]).Name := '0 Part'; + TExternalPhone(FInstantParts.Items[2]).Name := '1 Part'; + vExternalPart := TExternalPhone.Create(FConn); FOwner.AddExternalPart(vExternalPart); - TExternalPhones(FInstantParts.Items[3]).Name := '0 Part'; + TExternalPhone(FInstantParts.Items[3]).Name := '0 Part'; FInstantParts.Sort(PartsExternalCompare); - AssertEquals('0 Part', TExternalPhones(FInstantParts.Items[0]).Name); - AssertEquals('0 Part', TExternalPhones(FInstantParts.Items[1]).Name); - AssertEquals('1 Part', TExternalPhones(FInstantParts.Items[2]).Name); - AssertEquals('2 Part', TExternalPhones(FInstantParts.Items[3]).Name); + AssertEquals('0 Part', TExternalPhone(FInstantParts.Items[0]).Name); + AssertEquals('0 Part', TExternalPhone(FInstantParts.Items[1]).Name); + AssertEquals('1 Part', TExternalPhone(FInstantParts.Items[2]).Name); + AssertEquals('2 Part', TExternalPhone(FInstantParts.Items[3]).Name); end; procedure TestTInstantExtParts.TestUnchanged; @@ -345,7 +362,7 @@ FInstantParts.Unchanged; AssertFalse(FInstantParts.IsChanged); - TExternalPhones(FInstantParts.Items[1]).Name := 'Part2'; + TExternalPhone(FInstantParts.Items[1]).Name := 'Part2'; AssertTrue(FInstantParts.IsChanged); end; @@ -399,6 +416,18 @@ AssertEquals(4, FInstantParts.Count); end; +procedure TestTinstantEmbParts.TestAddReference; +begin + try + FInstantParts.AddReference('TPhone', 'NewPhoneId'); + Fail('Should never get here!!'); + except + on E: EInstantError do ; // do nothing as this is expected + else + raise; + end; +end; + procedure TestTinstantEmbParts.TestAssign; var vSource: TInstantParts; @@ -577,7 +606,7 @@ FInstantParts.Unchanged; AssertFalse(FInstantParts.IsChanged); - TExternalPhones(FInstantParts.Items[1]).Name := 'Part2'; + TExternalPhone(FInstantParts.Items[1]).Name := 'Part2'; AssertTrue(FInstantParts.IsChanged); end; @@ -626,11 +655,11 @@ procedure TestTInstantParts_Leak.TestAddExternalObject; var vReturnValue: Integer; - vPart: TExternalPhones; + vPart: TExternalPhone; begin FInstantParts := FOwner._ExternalPhones; - vPart := TExternalPhones.Create(FConn); + vPart := TExternalPhone.Create(FConn); AssertEquals(1, vPart.RefCount); vReturnValue := FInstantParts.Add(vPart); Modified: trunk/Source/Tests/TestInstantReferences.pas =================================================================== --- trunk/Source/Tests/TestInstantReferences.pas 2006-07-18 07:46:13 UTC (rev 686) +++ trunk/Source/Tests/TestInstantReferences.pas 2006-07-20 00:56:59 UTC (rev 687) @@ -47,6 +47,7 @@ procedure TearDown; override; published procedure TestAdd; + procedure TestAddReference; procedure TestAssign; procedure TestAttachObject; procedure TestClear; @@ -77,6 +78,7 @@ procedure TearDown; override; published procedure TestAdd; + procedure TestAddReference; procedure TestAssign; procedure TestAttachObject; procedure TestClear; @@ -98,7 +100,7 @@ implementation -uses SysUtils, Classes, testregistry; +uses SysUtils, Classes, testregistry, InstantClasses; function TestTInstantEmbReferences.RefsEmbeddedCompare(Holder, ... [truncated message content] |
|
From: <sr...@us...> - 2006-08-09 01:04:02
|
Revision: 702 Author: srmitch Date: 2006-08-08 18:02:16 -0700 (Tue, 08 Aug 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=702&view=rev Log Message: ----------- - Merged Refactor_InstantPersistenceUnit branch changes r696:701 into the trunk. Modified Paths: -------------- trunk/Demos/Intro/Intro.dpr trunk/Demos/Intro/Intro.mdr trunk/Demos/PrimerCross/BasicBrowse.pas trunk/Demos/PrimerCross/BasicEdit.pas trunk/Demos/PrimerCross/BasicView.pas trunk/Demos/PrimerCross/CategoryBrowse.pas trunk/Demos/PrimerCross/CompanyBrowse.pas trunk/Demos/PrimerCross/CompanyEdit.pas trunk/Demos/PrimerCross/ContactBrowse.pas trunk/Demos/PrimerCross/ContactEdit.dfm trunk/Demos/PrimerCross/ContactEdit.pas trunk/Demos/PrimerCross/ContactFilterEdit.pas trunk/Demos/PrimerCross/ContactSort.pas trunk/Demos/PrimerCross/ContactView.dfm trunk/Demos/PrimerCross/ContactView.pas trunk/Demos/PrimerCross/CountryBrowse.pas trunk/Demos/PrimerCross/DemoData.pas trunk/Demos/PrimerCross/DemoDataRequest.pas trunk/Demos/PrimerCross/HelpView.pas trunk/Demos/PrimerCross/Main.pas trunk/Demos/PrimerCross/MainData.pas trunk/Demos/PrimerCross/PerformanceView.pas trunk/Demos/PrimerCross/PersonBrowse.pas trunk/Demos/PrimerCross/PersonEdit.pas trunk/Demos/PrimerCross/Primer.dpr trunk/Demos/PrimerCross/PrimerExternal.dpr trunk/Demos/PrimerCross/QueryView.pas trunk/Demos/PrimerCross/RandomData.pas trunk/Demos/PrimerCross/Stopwatch.pas trunk/Demos/PrimerCross/Utility.pas trunk/Demos/PrimerCross/Welcome.pas trunk/Source/Brokers/ADO/InstantADO.pas trunk/Source/Brokers/BDE/InstantBDE.pas trunk/Source/Brokers/BDE/InstantBDECatalog.pas trunk/Source/Brokers/BDE/InstantBDEConnectionDefEdit.pas trunk/Source/Brokers/DBX/InstantDBX.pas trunk/Source/Brokers/IBX/InstantIBX.pas trunk/Source/Brokers/IBX/InstantIBXConnectionDefEdit.pas trunk/Source/Brokers/NexusDb/InstantNexusDB.pas trunk/Source/Brokers/NexusDb/InstantNexusDBCatalog.pas trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.pas trunk/Source/Brokers/XML/InstantXML.pas trunk/Source/Brokers/XML/InstantXMLCatalog.pas trunk/Source/Catalogs/IBFb/InstantIBFbCatalog.pas trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas trunk/Source/Core/D2006/IOCore.dpk trunk/Source/Core/D5/IOCore_D5.dpk trunk/Source/Core/D6/IOCore.dpk trunk/Source/Core/D7/IOCore.dpk trunk/Source/Core/InstantAccessors.pas trunk/Source/Core/InstantClasses.pas trunk/Source/Core/InstantCode.pas trunk/Source/Core/InstantCommand.pas trunk/Source/Core/InstantConnectionManager.pas trunk/Source/Core/InstantConnectionManagerFormUnit.pas trunk/Source/Core/InstantCustomDBEvolverFormUnit.pas trunk/Source/Core/InstantDBBuild.pas trunk/Source/Core/InstantDBEvolution.pas trunk/Source/Core/InstantExplorer.pas trunk/Source/Core/InstantPersistence.pas trunk/Source/Core/InstantPresentation.pas trunk/Source/Core/InstantPump.pas trunk/Source/Core/K3/IOCore.dpk trunk/Source/Design/InstantAttributeEditor.pas trunk/Source/Design/InstantClassEditor.pas trunk/Source/Design/InstantCommandEditor.pas trunk/Source/ObjectFoundry/OFClasses.pas trunk/Source/ObjectFoundry/OFExpert.pas trunk/Source/Tests/InstantMock.pas trunk/Source/Tests/MinimalModel.pas trunk/Source/Tests/TestIO.mdr trunk/Source/Tests/TestIO.mdx trunk/Source/Tests/TestInstantAttribute.pas trunk/Source/Tests/TestInstantAttributeMap.pas trunk/Source/Tests/TestInstantAttributeMetadata.pas trunk/Source/Tests/TestInstantClassMetadata.pas trunk/Source/Tests/TestInstantFieldMetadata.pas trunk/Source/Tests/TestInstantIndexMetadata.pas trunk/Source/Tests/TestInstantMetadata.pas trunk/Source/Tests/TestInstantObject.pas trunk/Source/Tests/TestInstantObjectStore.pas trunk/Source/Tests/TestInstantPart.pas trunk/Source/Tests/TestInstantParts.pas trunk/Source/Tests/TestInstantReference.pas trunk/Source/Tests/TestInstantReferences.pas trunk/Source/Tests/TestInstantScheme.pas trunk/Source/Tests/TestInstantTableMetadata.pas trunk/Source/Tests/TestMinimalModel.pas trunk/Source/Tests/TestMockBroker.pas Added Paths: ----------- trunk/Source/Core/InstantBrokers.pas trunk/Source/Core/InstantMetadata.pas trunk/Source/Core/InstantTypes.pas Modified: trunk/Demos/Intro/Intro.dpr =================================================================== --- trunk/Demos/Intro/Intro.dpr 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/Intro/Intro.dpr 2006-08-09 01:02:16 UTC (rev 702) @@ -2,8 +2,8 @@ uses Forms, + Model in 'Model.pas', Main in 'Main.pas' {MainForm}, - Model in 'Model.pas', ContactEdit in 'ContactEdit.pas' {ContactEditForm}, PersonEdit in 'PersonEdit.pas' {PersonEditForm}, CompanyEdit in 'CompanyEdit.pas' {CompanyEditForm}; Modified: trunk/Demos/Intro/Intro.mdr =================================================================== (Binary files differ) Modified: trunk/Demos/PrimerCross/BasicBrowse.pas =================================================================== --- trunk/Demos/PrimerCross/BasicBrowse.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/BasicBrowse.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,7 +1,13 @@ unit BasicBrowse; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, Classes, DB, {$IFDEF MSWINDOWS} Modified: trunk/Demos/PrimerCross/BasicEdit.pas =================================================================== --- trunk/Demos/PrimerCross/BasicEdit.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/BasicEdit.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,7 +1,13 @@ unit BasicEdit; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, Classes, DB, {$IFDEF MSWINDOWS} Modified: trunk/Demos/PrimerCross/BasicView.pas =================================================================== --- trunk/Demos/PrimerCross/BasicView.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/BasicView.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -2,7 +2,11 @@ interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} uses SysUtils, Classes, Modified: trunk/Demos/PrimerCross/CategoryBrowse.pas =================================================================== --- trunk/Demos/PrimerCross/CategoryBrowse.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/CategoryBrowse.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -2,6 +2,12 @@ interface +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, Classes, {$IFDEF MSWINDOWS} Modified: trunk/Demos/PrimerCross/CompanyBrowse.pas =================================================================== --- trunk/Demos/PrimerCross/CompanyBrowse.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/CompanyBrowse.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -2,6 +2,12 @@ interface +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, Classes, {$IFDEF MSWINDOWS} Modified: trunk/Demos/PrimerCross/CompanyEdit.pas =================================================================== --- trunk/Demos/PrimerCross/CompanyEdit.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/CompanyEdit.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,7 +1,13 @@ unit CompanyEdit; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, Classes, {$IFDEF MSWINDOWS} Modified: trunk/Demos/PrimerCross/ContactBrowse.pas =================================================================== --- trunk/Demos/PrimerCross/ContactBrowse.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/ContactBrowse.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -2,6 +2,12 @@ interface +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, Classes, {$IFDEF MSWINDOWS} Modified: trunk/Demos/PrimerCross/ContactEdit.dfm =================================================================== --- trunk/Demos/PrimerCross/ContactEdit.dfm 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/ContactEdit.dfm 2006-08-09 01:02:16 UTC (rev 702) @@ -197,7 +197,6 @@ end end object PhonesExposer: TInstantExposer [2] - Options = [] ContainerName = 'Phones' MasterSource = SubjectSource Mode = amContent Modified: trunk/Demos/PrimerCross/ContactEdit.pas =================================================================== --- trunk/Demos/PrimerCross/ContactEdit.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/ContactEdit.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,7 +1,13 @@ unit ContactEdit; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, Classes, {$IFDEF MSWINDOWS} Modified: trunk/Demos/PrimerCross/ContactFilterEdit.pas =================================================================== --- trunk/Demos/PrimerCross/ContactFilterEdit.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/ContactFilterEdit.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,7 +1,13 @@ unit ContactFilterEdit; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, Classes, {$IFDEF MSWINDOWS} Modified: trunk/Demos/PrimerCross/ContactSort.pas =================================================================== --- trunk/Demos/PrimerCross/ContactSort.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/ContactSort.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,7 +1,13 @@ unit ContactSort; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, Classes, {$IFDEF MSWINDOWS} @@ -40,7 +46,8 @@ implementation uses - Model, TypInfo, InstantRtti, InstantPresentation; + Model, TypInfo, InstantRtti, InstantPresentation, InstantMetadata, + InstantTypes; {$R *.dfm} Modified: trunk/Demos/PrimerCross/ContactView.dfm =================================================================== --- trunk/Demos/PrimerCross/ContactView.dfm 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/ContactView.dfm 2006-08-09 01:02:16 UTC (rev 702) @@ -70,8 +70,6 @@ Height = 28 Align = alLeft BorderWidth = 1 - EdgeBorders = [] - Flat = True Images = ActionImages ParentShowHint = False ShowHint = True Modified: trunk/Demos/PrimerCross/ContactView.pas =================================================================== --- trunk/Demos/PrimerCross/ContactView.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/ContactView.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,11 +1,11 @@ unit ContactView; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} -{$IFDEF VER150} -{$WARN UNSAFE_TYPE OFF} -{$WARN UNSAFE_CAST OFF} -{$WARN UNSAFE_CODE OFF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} {$ENDIF} uses Modified: trunk/Demos/PrimerCross/CountryBrowse.pas =================================================================== --- trunk/Demos/PrimerCross/CountryBrowse.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/CountryBrowse.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -2,6 +2,12 @@ interface +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, Classes, BasicBrowse, DB, {$IFDEF MSWINDOWS} Modified: trunk/Demos/PrimerCross/DemoData.pas =================================================================== --- trunk/Demos/PrimerCross/DemoData.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/DemoData.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -2,6 +2,12 @@ interface +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses Classes, Model, InstantPersistence, RandomData; Modified: trunk/Demos/PrimerCross/DemoDataRequest.pas =================================================================== --- trunk/Demos/PrimerCross/DemoDataRequest.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/DemoDataRequest.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,7 +1,13 @@ unit DemoDataRequest; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, {$IFDEF MSWINDOWS} Modified: trunk/Demos/PrimerCross/HelpView.pas =================================================================== --- trunk/Demos/PrimerCross/HelpView.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/HelpView.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -2,6 +2,12 @@ interface +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, BasicView, OleCtrls, SHDocVw, StdCtrls, ExtCtrls, ComCtrls; Modified: trunk/Demos/PrimerCross/Main.pas =================================================================== --- trunk/Demos/PrimerCross/Main.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/Main.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,11 +1,11 @@ unit Main; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} -{$IFDEF VER150} -{$WARN UNSAFE_TYPE OFF} -{$WARN UNSAFE_CAST OFF} -{$WARN UNSAFE_CODE OFF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} {$ENDIF} uses @@ -108,7 +108,8 @@ procedure Connect; procedure Disconnect; procedure Reset; - property ActiveSubView: TBasicViewForm read FActiveSubView write SetActiveSubView; + property ActiveSubView: TBasicViewForm read FActiveSubView + write SetActiveSubView; property Connector: TInstantConnector read FConnector; property ConnectionName: string read GetConnectionName; property IsConnected: Boolean read GetIsConnected; @@ -124,7 +125,8 @@ implementation uses - Contnrs, Model, Welcome, MainData, RandomData, DemoData, Utility, ContactView, PerformanceView, + Contnrs, Model, Welcome, MainData, RandomData, DemoData, Utility, ContactView, + PerformanceView, {$IFDEF MSWINDOWS} HelpView, JPeg, {$ENDIF} @@ -132,7 +134,7 @@ HelpViewK3, {$ENDIF} DemoDataRequest, InstantPresentation, InstantClasses, - QueryView, InstantImageUtils, + QueryView, InstantImageUtils, InstantTypes, { Note: This demo attempts to include brokers for the data access layers supported natively by Delphi. To include additional brokers, Modified: trunk/Demos/PrimerCross/MainData.pas =================================================================== --- trunk/Demos/PrimerCross/MainData.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/MainData.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,7 +1,13 @@ unit MainData; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, Classes, {$IFDEF MSWINDOWS} Modified: trunk/Demos/PrimerCross/PerformanceView.pas =================================================================== --- trunk/Demos/PrimerCross/PerformanceView.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/PerformanceView.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,11 +1,11 @@ unit PerformanceView; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} -{$IFDEF VER150} -{$WARN UNSAFE_TYPE OFF} -{$WARN UNSAFE_CAST OFF} -{$WARN UNSAFE_CODE OFF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} {$ENDIF} uses @@ -173,7 +173,7 @@ {$R *.dfm} uses - Model, DemoData, IniFiles, Utility; + InstantBrokers, Model, DemoData, IniFiles, Utility; { TTestResult } Modified: trunk/Demos/PrimerCross/PersonBrowse.pas =================================================================== --- trunk/Demos/PrimerCross/PersonBrowse.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/PersonBrowse.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -2,6 +2,12 @@ interface +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, Classes, {$IFDEF MSWINDOWS} Modified: trunk/Demos/PrimerCross/PersonEdit.pas =================================================================== --- trunk/Demos/PrimerCross/PersonEdit.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/PersonEdit.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,7 +1,13 @@ unit PersonEdit; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, Classes, {$IFDEF MSWINDOWS} Modified: trunk/Demos/PrimerCross/Primer.dpr =================================================================== --- trunk/Demos/PrimerCross/Primer.dpr 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/Primer.dpr 2006-08-09 01:02:16 UTC (rev 702) @@ -32,8 +32,13 @@ program Primer; +{$IFDEF LINUX} {$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses Forms, Main in 'Main.pas' {MainForm}, Modified: trunk/Demos/PrimerCross/PrimerExternal.dpr =================================================================== --- trunk/Demos/PrimerCross/PrimerExternal.dpr 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/PrimerExternal.dpr 2006-08-09 01:02:16 UTC (rev 702) @@ -31,8 +31,13 @@ program PrimerExternal; -{$I '../../InstantDefines.inc'} +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses Forms, Main in 'Main.pas' {MainForm}, Modified: trunk/Demos/PrimerCross/QueryView.pas =================================================================== --- trunk/Demos/PrimerCross/QueryView.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/QueryView.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,7 +1,13 @@ unit QueryView; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + uses SysUtils, Classes, {$IFDEF MSWINDOWS} Modified: trunk/Demos/PrimerCross/RandomData.pas =================================================================== --- trunk/Demos/PrimerCross/RandomData.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/RandomData.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -2,10 +2,10 @@ interface -{$IFDEF VER150} -{$WARN UNSAFE_TYPE OFF} -{$WARN UNSAFE_CAST OFF} -{$WARN UNSAFE_CODE OFF} +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} {$ENDIF} type Modified: trunk/Demos/PrimerCross/Stopwatch.pas =================================================================== --- trunk/Demos/PrimerCross/Stopwatch.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/Stopwatch.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -2,7 +2,11 @@ interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} uses SysUtils, Modified: trunk/Demos/PrimerCross/Utility.pas =================================================================== --- trunk/Demos/PrimerCross/Utility.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/Utility.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,7 +1,13 @@ unit Utility; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} +{$ENDIF} + procedure BeginBusy; procedure EndBusy; function Confirm(const Text: string): Boolean; Modified: trunk/Demos/PrimerCross/Welcome.pas =================================================================== --- trunk/Demos/PrimerCross/Welcome.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Demos/PrimerCross/Welcome.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -1,9 +1,11 @@ unit Welcome; interface -{$IFDEF VER130}{$DEFINE MSWINDOWS}{$ENDIF} -{$IFDEF VER150} -{$WARN UNSAFE_TYPE OFF} + +{$IFDEF LINUX} +{$I '../../Source/InstantDefines.inc'} +{$ELSE} +{$I '..\..\Source\InstantDefines.inc'} {$ENDIF} uses Modified: trunk/Source/Brokers/ADO/InstantADO.pas =================================================================== --- trunk/Source/Brokers/ADO/InstantADO.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Brokers/ADO/InstantADO.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -40,7 +40,7 @@ uses Classes, Db, ADODB, SysUtils, InstantPersistence, InstantClasses, - InstantCommand; + InstantCommand, InstantBrokers, InstantMetadata, InstantTypes; type TInstantADOProviderType = (ptUnknown, ptMSJet, ptMSSQLServer, ptOracle, ptMySQL, ptIBMDB2); Modified: trunk/Source/Brokers/BDE/InstantBDE.pas =================================================================== --- trunk/Source/Brokers/BDE/InstantBDE.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Brokers/BDE/InstantBDE.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -44,7 +44,7 @@ uses Classes, Db, DBTables, SysUtils, InstantPersistence, InstantCommand, - InstantConsts; + InstantBrokers, InstantMetadata, InstantTypes, InstantConsts; type TInstantBDEDriverType = (dtUnknown, dtStandard, dtInterBase, dtMSAccess, Modified: trunk/Source/Brokers/BDE/InstantBDECatalog.pas =================================================================== --- trunk/Source/Brokers/BDE/InstantBDECatalog.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Brokers/BDE/InstantBDECatalog.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -38,7 +38,8 @@ interface uses - InstantPersistence, DB, DBTables; + InstantPersistence, DB, DBTables, InstantMetadata, InstantBrokers, + InstantTypes; type // A TInstantCatalog that reads catalog information from a BDE Modified: trunk/Source/Brokers/BDE/InstantBDEConnectionDefEdit.pas =================================================================== --- trunk/Source/Brokers/BDE/InstantBDEConnectionDefEdit.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Brokers/BDE/InstantBDEConnectionDefEdit.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -40,7 +40,7 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - InstantBDE, StdCtrls, ExtCtrls; + InstantBDE, StdCtrls, ExtCtrls, InstantMetadata; type TInstantBDEConnectionDefEditForm = class(TForm) @@ -84,7 +84,7 @@ {$R *.DFM} uses - DbTables, InstantPersistence, InstantClasses, InstantConsts; + DbTables, InstantPersistence, InstantClasses, InstantTypes, InstantConsts; const NoAlias = '(None)'; Modified: trunk/Source/Brokers/DBX/InstantDBX.pas =================================================================== --- trunk/Source/Brokers/DBX/InstantDBX.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Brokers/DBX/InstantDBX.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -45,7 +45,8 @@ {$IFDEF LINUX} QControls, {$ENDIF} - Classes, DB, DBXpress, SqlExpr, InstantPersistence, InstantCommand; + Classes, DB, DBXpress, SqlExpr, InstantPersistence, InstantCommand, + InstantBrokers, InstantMetadata, InstantTypes; type TInstantDBXConnectionDef = class(TInstantConnectionBasedConnectionDef) Modified: trunk/Source/Brokers/IBX/InstantIBX.pas =================================================================== --- trunk/Source/Brokers/IBX/InstantIBX.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Brokers/IBX/InstantIBX.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -40,7 +40,7 @@ uses Classes, Db, IBDatabase, IBTable, IBQuery, SysUtils, InstantPersistence, - InstantClasses, InstantCommand; + InstantBrokers, InstantClasses, InstantCommand, InstantMetadata, InstantTypes; type TInstantIBXOption = (ibxUseDelimitedIdents); Modified: trunk/Source/Brokers/IBX/InstantIBXConnectionDefEdit.pas =================================================================== --- trunk/Source/Brokers/IBX/InstantIBXConnectionDefEdit.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Brokers/IBX/InstantIBXConnectionDefEdit.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -89,7 +89,7 @@ {$R *.DFM} uses - IB, InstantPersistence, InstantClasses, InstantConsts; + IB, InstantPersistence, InstantClasses, InstantTypes, InstantConsts; { TInstantIBXConnectionDefEditForm } Modified: trunk/Source/Brokers/NexusDb/InstantNexusDB.pas =================================================================== --- trunk/Source/Brokers/NexusDb/InstantNexusDB.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Brokers/NexusDb/InstantNexusDB.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -43,7 +43,8 @@ {$IFDEF MSWINDOWS} Windows, {$ENDIF} - Classes, DB, InstantPersistence, InstantCommand, + Classes, DB, InstantPersistence, InstantBrokers, InstantCommand, + InstantMetadata, InstantTypes, nxptBasePooledTransport, nxsdServerEngine, nxdb, nxsdDataDictionary; type @@ -842,7 +843,7 @@ end; {$ENDIF} -{ TInstantNexusDBSQLQuery } +{ TInstantNexusDBQuery } class function TInstantNexusDBQuery.TranslatorClass: TInstantRelationalTranslatorClass; Modified: trunk/Source/Brokers/NexusDb/InstantNexusDBCatalog.pas =================================================================== --- trunk/Source/Brokers/NexusDb/InstantNexusDBCatalog.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Brokers/NexusDb/InstantNexusDBCatalog.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -39,7 +39,7 @@ interface uses - InstantPersistence; + InstantPersistence, InstantBrokers, InstantMetadata, InstantTypes; type // A TInstantCatalog that reads catalog information from a NexusDb Modified: trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.pas =================================================================== --- trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Brokers/NexusDb/InstantNexusDBConnectionDefEdit.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -124,9 +124,7 @@ {$WARN UNIT_PLATFORM ON} {$ENDIF} {$ENDIF} - InstantClasses, - InstantPersistence, - InstantConsts, + InstantClasses, InstantPersistence, InstantTypes, InstantConsts, InstantNexusDBConsts; { TInstantNexusDBConnectionDefEditForm } Modified: trunk/Source/Brokers/XML/InstantXML.pas =================================================================== --- trunk/Source/Brokers/XML/InstantXML.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Brokers/XML/InstantXML.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -42,7 +42,8 @@ interface uses - Classes, DB, InstantPersistence, InstantCommand, Contnrs; + Classes, DB, Contnrs, InstantPersistence, InstantBrokers, InstantCommand, + InstantMetadata, InstantTypes; const XML_UTF8_HEADER = '<?xml version="1.0" encoding="UTF-8"?>'; Modified: trunk/Source/Brokers/XML/InstantXMLCatalog.pas =================================================================== --- trunk/Source/Brokers/XML/InstantXMLCatalog.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Brokers/XML/InstantXMLCatalog.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -45,7 +45,7 @@ {$IFDEF MSWINDOWS} FileCtrl, {$ENDIF} - InstantPersistence; + InstantPersistence, InstantBrokers, InstantMetadata, InstantTypes; type // A TInstantCatalog that reads catalog information from a XML Modified: trunk/Source/Catalogs/IBFb/InstantIBFbCatalog.pas =================================================================== --- trunk/Source/Catalogs/IBFb/InstantIBFbCatalog.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Catalogs/IBFb/InstantIBFbCatalog.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -39,7 +39,7 @@ interface uses - InstantPersistence; + InstantPersistence, InstantBrokers, InstantMetadata, InstantTypes; type // A TInstantCatalog that reads catalog information from an InterBase Modified: trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas =================================================================== --- trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -38,7 +38,7 @@ interface uses - InstantPersistence; + InstantPersistence, InstantBrokers, InstantMetadata, InstantTypes; type // A TInstantCatalog that reads catalog information from an MS-SQL server database. Modified: trunk/Source/Core/D2006/IOCore.dpk =================================================================== --- trunk/Source/Core/D2006/IOCore.dpk 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Core/D2006/IOCore.dpk 2006-08-09 01:02:16 UTC (rev 702) @@ -54,6 +54,9 @@ InstantDBEvolution in '..\InstantDBEvolution.pas', InstantCustomDBEvolverFormUnit in '..\InstantCustomDBEvolverFormUnit.pas' {InstantCustomDBEvolverForm}, InstantDBEvolverFormUnit in '..\InstantDBEvolverFormUnit.pas' {InstantDBEvolverForm}, - InstantDBBuilderFormUnit in '..\InstantDBBuilderFormUnit.pas' {InstantDBBuilderForm}; + InstantDBBuilderFormUnit in '..\InstantDBBuilderFormUnit.pas' {InstantDBBuilderForm}, + InstantTypes in '..\InstantTypes.pas', + InstantBrokers in '..\InstantBrokers.pas', + InstantMetadata in '..\InstantMetadata.pas'; end. Modified: trunk/Source/Core/D5/IOCore_D5.dpk =================================================================== --- trunk/Source/Core/D5/IOCore_D5.dpk 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Core/D5/IOCore_D5.dpk 2006-08-09 01:02:16 UTC (rev 702) @@ -52,6 +52,9 @@ InstantCustomDBEvolverFormUnit in '..\InstantCustomDBEvolverFormUnit.pas' {InstantCustomDBEvolverForm}, InstantDBEvolverFormUnit in '..\InstantDBEvolverFormUnit.pas' {InstantDBEvolverForm}, InstantDBEvolution in '..\InstantDBEvolution.pas', - InstantDBBuild in '..\InstantDBBuild.pas'; + InstantDBBuild in '..\InstantDBBuild.pas', + InstantTypes in '..\InstantTypes.pas', + InstantBrokers in '..\InstantBrokers.pas', + InstantMetadata in '..\InstantMetadata.pas'; end. Modified: trunk/Source/Core/D6/IOCore.dpk =================================================================== --- trunk/Source/Core/D6/IOCore.dpk 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Core/D6/IOCore.dpk 2006-08-09 01:02:16 UTC (rev 702) @@ -54,6 +54,9 @@ InstantConnectionManagerFormUnit in '..\InstantConnectionManagerFormUnit.pas' {InstantConnectionManagerForm}, InstantCustomDBEvolverFormUnit in '..\InstantCustomDBEvolverFormUnit.pas' {InstantCustomDBEvolverForm}, InstantDBBuilderFormUnit in '..\InstantDBBuilderFormUnit.pas' {InstantDBBuilderForm}, - InstantDBEvolverFormUnit in '..\InstantDBEvolverFormUnit.pas' {InstantDBEvolverForm}; + InstantDBEvolverFormUnit in '..\InstantDBEvolverFormUnit.pas' {InstantDBEvolverForm}, + InstantTypes in '..\InstantTypes.pas', + InstantBrokers in '..\InstantBrokers.pas', + InstantMetadata in '..\InstantMetadata.pas'; end. Modified: trunk/Source/Core/D7/IOCore.dpk =================================================================== --- trunk/Source/Core/D7/IOCore.dpk 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Core/D7/IOCore.dpk 2006-08-09 01:02:16 UTC (rev 702) @@ -55,6 +55,9 @@ InstantDBEvolution in '..\InstantDBEvolution.pas', InstantCustomDBEvolverFormUnit in '..\InstantCustomDBEvolverFormUnit.pas' {InstantCustomDBEvolverForm}, InstantDBEvolverFormUnit in '..\InstantDBEvolverFormUnit.pas' {InstantDBEvolverForm}, - InstantDBBuilderFormUnit in '..\InstantDBBuilderFormUnit.pas' {InstantDBBuilderForm}; + InstantDBBuilderFormUnit in '..\InstantDBBuilderFormUnit.pas' {InstantDBBuilderForm}, + InstantTypes in '..\InstantTypes.pas', + InstantBrokers in '..\InstantBrokers.pas', + InstantMetadata in '..\InstantMetadata.pas'; end. Modified: trunk/Source/Core/InstantAccessors.pas =================================================================== --- trunk/Source/Core/InstantAccessors.pas 2006-08-09 00:04:12 UTC (rev 701) +++ trunk/Source/Core/InstantAccessors.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -158,6 +158,7 @@ else Result := InternalObjectCount; end; + function TInstantObjectAccessor.GetSubject: TInstantObject; begin Result := inherited Subject as TInstantObject; Copied: trunk/Source/Core/InstantBrokers.pas (from rev 701, branches/Refactor_InstantPersistenceUnit/Source/Core/InstantBrokers.pas) =================================================================== --- trunk/Source/Core/InstantBrokers.pas (rev 0) +++ trunk/Source/Core/InstantBrokers.pas 2006-08-09 01:02:16 UTC (rev 702) @@ -0,0 +1,5954 @@ +(* + * InstantObjects + * Broker and Connector Classes + *) + +(* ***** 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: Seleqt InstantObjects + * + * The Initial Developer of the Original Code is: Seleqt + * + * Portions created by the Initial Developer are Copyright (C) 2001-2003 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell, + * Joao Morais, Cesar Coll, Uberto Barbini, David Taylor, Hanedi Salas, + * Riceball Lee, David Moorhouse + * + * ***** END LICENSE BLOCK ***** *) + +unit InstantBrokers; + +{$IFDEF LINUX} +{$I '../InstantDefines.inc'} +{$ELSE} +{$I '..\InstantDefines.inc'} +{$ENDIF} + +interface + +uses SysUtils, Classes, Db, InstantPersistence, InstantTypes, InstantMetadata, + InstantConsts, InstantClasses, Contnrs, InstantCommand; + +type + TInstantBrokerCatalog = class; + TInstantConnectionBasedConnector = class; + TInstantCustomRelationalBroker = class; + TInstantCustomRelationalQuery = class; + TInstantCustomRelationalQueryClass = class of TInstantCustomRelationalQuery; + TInstantCustomResolver = class; + TInstantLinkResolver = class; + TInstantNavigationalBroker = class; + TInstantNavigationalLinkResolver = class; + TInstantNavigationalResolver = class; + TInstantNavigationalResolverClass = class of TInstantNavigationalResolver; + TInstantRelationalConnector = class; + TInstantRelationalTranslator = class; + TInstantRelationalTranslatorClass = class of TInstantRelationalTranslator; + TInstantSQLBroker = class; + TInstantSQLBrokerCatalog = class; + TInstantSQLGenerator = class; + TInstantSQLGeneratorClass = class of TInstantSQLGenerator; + TInstantSQLLinkResolver = class; + TInstantSQLResolver = class; + TInstantStatementCache = class; + + PObjectRow = ^TObjectRow; + TObjectRow = record + Row: Integer; + Instance: TObject; + end; + + PInstantOperationInfo = ^TInstantOperationInfo; + TInstantOperationInfo = record + Success: Boolean; + Conflict: Boolean; + end; + + TInstantBrokerOperation = procedure(AObject: TInstantObject; + const AObjectId: string; Map: TInstantAttributeMap; + ConflictAction: TInstantConflictAction = caFail; + Info: PInstantOperationInfo = nil) of object; + TInstantGetDataSetEvent = procedure(Sender: TObject; + const CommandText: string; var DataSet: TDataset) of object; + TInstantInitDataSetEvent = procedure(Sender: TObject; + const CommandText: string; DataSet: TDataSet) of object; + TInstantNavigationalResolverOperation = procedure(AObject: TInstantObject; + AttributeMetadata: TInstantAttributeMetadata) of object; + + + TInstantCustomRelationalBroker = class(TInstantBroker) + private + FStatementCache: TInstantStatementCache; + FStatementCacheCapacity: Integer; + procedure DisposeMap(AObject: TInstantObject; const AObjectId: string; + Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; + Info: PInstantOperationInfo); + function GetConnector: TInstantRelationalConnector; + function PerformOperation(AObject: TInstantObject; const AObjectId: string; + OperationType: TInstantOperationType; Operation: TInstantBrokerOperation; + ConflictAction: TInstantConflictAction): Boolean; + procedure RetrieveMap(AObject: TInstantObject; const AObjectId: string; + Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; + Info: PInstantOperationInfo); + procedure StoreMap(AObject: TInstantObject; const AObjectId: string; + Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; + Info: PInstantOperationInfo); + function GetStatementCache: TInstantStatementCache; + procedure SetStatementCacheCapacity(const Value: Integer); + protected + property StatementCache: TInstantStatementCache read GetStatementCache; + function EnsureResolver(Map: TInstantAttributeMap): TInstantCustomResolver; + virtual; abstract; + function GetDBMSName: string; virtual; + function GetSQLDelimiters: string; virtual; + function GetSQLQuote: Char; virtual; + function GetSQLWildcard: string; virtual; + function InternalDisposeObject(AObject: TInstantObject; + ConflictAction: TInstantConflictAction): Boolean; override; + function InternalRetrieveObject(AObject: TInstantObject; + const AObjectId: string; ConflictAction: TInstantConflictAction): Boolean; + override; + function InternalStoreObject(AObject: TInstantObject; + ConflictAction: TInstantConflictAction): Boolean; override; + public + constructor Create(AConnector: TInstantConnector); override; + destructor Destroy; override; + function Execute(const AStatement: string; AParams: TParams = nil): Integer; + virtual; + property Connector: TInstantRelationalConnector read GetConnector; + property DBMSName: string read GetDBMSName; + property SQLDelimiters: string read GetSQLDelimiters; + property SQLQuote: Char read GetSQLQuote; + property SQLWildcard: string read GetSQLWildCard; + property StatementCacheCapacity: Integer read FStatementCacheCapacity + write SetStatementCacheCapacity; + end; + + TInstantNavigationalBroker = class(TInstantCustomRelationalBroker) + private + FResolverList: TObjectList; + function GetResolverCount: Integer; + function GetResolverList: TObjectList; + function GetResolvers(Index: Integer): TInstantnavigationalResolver; + property ResolverList: TObjectList read GetResolverList; + protected + function CreateResolver(const TableName: string): + TInstantNavigationalResolver; virtual; abstract; + function EnsureResolver(Map: TInstantAttributeMap): TInstantCustomResolver; + override; + function FindResolver(const TableName: string): + TInstantNavigationalResolver; + property ResolverCount: Integer read GetResolverCount; + property Resolvers[Index: Integer]: TInstantNavigationalResolver + read GetResolvers; + public + destructor Destroy; override; + end; + + //Backwards compatibility + TInstantRelationalBroker = TInstantNavigationalBroker; + + TInstantSQLBroker = class(TInstantCustomRelationalBroker) + private + FGenerator: TInstantSQLGenerator; + FResolverList: TObjectList; + function GetResolverList: TObjectList; + function GetResolverCount: Integer; + function GetResolvers(Index: Integer): TInstantSQLResolver; + function GetGenerator: TInstantSQLGenerator; + protected + function CreateResolver(Map: TInstantAttributeMap): TInstantSQLResolver; + virtual; abstract; + function EnsureResolver(AMap: TInstantAttributeMap): TInstantCustomResolver; + override; + procedure InternalBuildDatabase(Scheme: TInstantScheme); override; + property ResolverList: TObjectList read GetResolverList; + procedure AssignDataSetParams(DataSet : TDataSet; AParams: TParams); + virtual; + function CreateDataSet(const AStatement: string; AParams: TParams = nil): + TDataSet; virtual; abstract; + public + destructor Destroy; override; + function AcquireDataSet(const AStatement: string; AParams: TParams = nil): + TDataSet; virtual; + procedure ReleaseDataSet(const ADataSet: TDataSet); virtual; + function DataTypeToColumnType(DataType: TInstantDataType; + Size: Integer): string; virtual; abstract; + function FindResolver(AMap: TInstantAttributeMap): TInstantSQLResolver; + class function GeneratorClass: TInstantSQLGeneratorClass; virtual; + property Generator: TInstantSQLGenerator read GetGenerator; + property ResolverCount: Integer read GetResolverCount; + property Resolvers[Index: Integer]: TInstantSQLResolver read GetResolvers; + end; + + TInstantRelationalConnector = class(TInstantConnector) + private + FOnGetDataSet: TInstantGetDataSetEvent; + FOnInitDataSet: TInstantInitDataSetEvent; + protected + procedure DoGetDataSet(const CommandText: string; var DataSet: TDataSet); + procedure DoInitDataSet(const CommandText: string; DataSet: TDataSet); + function GetBroker: TInstantCustomRelationalBroker; + procedure GetDataSet(const CommandText: string; var DataSet: TDataSet); + virtual; + function GetDBMSName: string; virtual; + procedure InitDataSet(const CommandText: string; DataSet: TDataSet); + virtual; + function InternalCreateScheme(Model: TInstantModel): TInstantScheme; + override; + public + property Broker: TInstantCustomRelationalBroker read GetBroker; + property DBMSName: string read GetDBMSName; + published + property OnGetDataSet: TInstantGetDataSetEvent read FOnGetDataSet + write FOnGetDataSet; + property OnInitDataSet: TInstantInitDataSetEvent read FOnInitDataSet + write FOnInitDataSet; + end; + + TInstantConnectionBasedConnector = class(TInstantRelationalConnector) + private + FConnection: TCustomConnection; + FLoginPrompt: Boolean; + procedure DoAfterConnectionChange; + procedure DoBeforeConnectionChange; + function GetConnection: TCustomConnection; + function GetLoginPrompt: Boolean; + procedure SetConnection(Value: TCustomConnection); + procedure SetLoginPrompt(const Value: Boolean); + protected + procedure AssignLoginOptions; virtual; + procedure AfterConnectionChange; virtual; + procedure BeforeConnectionChange; virtual; + procedure CheckConnection; + function GetConnected: Boolean; override; + procedure InternalConnect; override; + procedure InternalDisconnect; override; + procedure Notification(AComponent: TComponent; Operation: TOperation); + override; + public + property Connection: TCustomConnection read GetConnection + write SetConnection; + function HasConnection: Boolean; + constructor Create(AOwner: TComponent); override; + published + property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt + default True; + end; + + TInstantCustomResolver = class(TInstantStreamable) + private + FBroker: TInstantCustomRelationalBroker; + protected + function KeyViolation(AObject: TInstantObject; const AObjectId: string; + E: Exception): EInstantKeyViolation; + procedure InternalDisposeMap(AObject: TInstantObject; + Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; + Info: PInstantOperationInfo); virtual; + procedure InternalRetrieveMap(AObject: TInstantObject; + const AObjectId: string; Map: TInstantAttributeMap; + ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo); + virtual; + procedure InternalStoreMap(AObject: TInstantObject; + Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; + Info: PInstantOperationInfo); virtual; + public + constructor Create(ABroker: TInstantCustomRelationalBroker); + procedure DisposeMap(AObject: TInstantObject; Map: TInstantAttributeMap; + ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo); + procedure DisposeObject(AObject: TInstantObject; Conflict: + TInstantConflictAction); + procedure RetrieveMap(AObject: TInstantObject; const AObjectId: string; + Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; + Info: PInstantOperationInfo); + procedure StoreMap(AObject: TInstantObject; Map: TInstantAttributeMap; + ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo); + procedure StoreObject(AObject: TInstantObject; Conflict: + TInstantConflictAction); + property Broker: TInstantCustomRelationalBroker read FBroker; + end; + + TInstantNavigationalResolver = class(TInstantCustomResolver) + private + FDataSet: TDataSet; + FFreeDataSet: Boolean; + FNavigationalLinkResolvers: TObjectList; + FTableName: string; + function CheckConflict(AObject: TInstantObject; const AObjectId: string; + ConflictAction: TInstantConflictAction): Boolean; + procedure ClearAttribute(AObject: TInstantObject; + AttributeMetadata: TInstantAttributeMetadata); + function FieldByName(const FieldName: string): TField; + procedure FreeDataSet; + function GetBroker: TInstantNavigationalBroker; + function GetDataSet: TDataSet; + function GetNavigationalLinkResolvers: TObjectList; + function GetObjectClassName: string; + function GetObjectId: string; + procedure PerformOperation(AObject: TInstantObject; + Map: TInstantAttributeMap; Operation: + TInstantNavigationalResolverOperation); + procedure ReadAttribute(AObject: TInstantObject; + AttributeMetadata: TInstantAttributeMetadata); + procedure ResetAttribute(AObject: TInstantObject; + AttributeMetadata: TInstantAttributeMetadata); + procedure SetDataSet(Value: TDataset); + procedure WriteAttribute(AObject: TInstantObject; + AttributeMetadata: TInstantAttributeMetadata); + protected + procedure Append; virtual; + procedure Cancel; virtual; + procedure ClearBlob(Attribute: TInstantBlob); virtual; + procedure ClearBoolean(Attribute: TInstantBoolean); virtual; + procedure ClearDateTime(Attribute: TInstantDateTime); virtual; + procedure ClearInteger(Attribute: TInstantInteger); virtual; + procedure ClearFloat(Attribute: TInstantFloat); virtual; + procedure ClearCurrency(Attribute: TInstantCurrency); virtual; + procedure ClearMemo(Attribute: TInstantMemo); virtual; + procedure ClearPart(Attribute: TInstantPart); virtual; + procedure ClearParts(Attribute: TInstantParts); virtual; + procedure ClearReference(Attribute: TInstantReference); virtual; + procedure ClearReferences(Attribute: TInstantReferences); virtual; + procedure ClearString(Attribute: TInstantString); virtual; + procedure Close; virtual; + function CreateDataSet: TDataSet; virtual; abstract; + function CreateNavigationalLinkResolver(const ATableName: string): + TInstantNavigationalLinkResolver; virtual; abstract; + function CreateLocateVarArray(const AObjectClassName, AObjectId: string): + Variant; + procedure Delete; virtual; + procedure Edit; virtual; + function GetLinkDatasetResolver(const ATableName: string): + TInstantNavigationalLinkResolver; + function FieldHasObjects(Field: TField): Boolean; virtual; + function FindLinkDatasetResolver(const ATableName: string): + TInstantNavigationalLinkResolver; + procedure InternalDisposeMap(AObject: TInstantObject; + Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; + Info: PInstantOperationInfo); override; + procedure InternalRetrieveMap(AObject: TInstantObject; + const AObjectId: string; Map: TInstantAttributeMap; + ConflictAction: TInstantConflictAction; + Info: PInstantOperationInfo); override; + procedure InternalStoreMap(AObject: TInstantObject; + Map: TInstantAttributeMap; + ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo); + override; + function Locate(const AObjectClassName, AObjectId: string): Boolean; + virtual; abstract; + procedure Open; virtual; + procedure Post; virtual; + procedure ReadBlob(Attribute: TInstantBlob); virtual; + procedure ReadBoolean(Attribute: TInstantBoolean); virtual; + procedure ReadDateTime(Attribute: TInstantDateTime); virtual; + procedure ReadInteger(Attribute: TInstantInteger); virtual; + procedure ReadFloat(Attribute: TInstantFloat); virtual; + procedure ReadCurrency(Attribute: TInstantCurrency); virtual; + procedure ReadMemo(Attribute: TInstantMemo); virtual; + procedure ReadPart(Attribute: TInstantPart); virtual; + procedure ReadParts(Attribute: TInstantParts); virtual; + procedure ReadReference(Attribute: TInstantReference); virtual; + procedure ReadReferences(Attribute: TInstantReferences); virtual; + procedure ReadString(Attribute: TInstantString); virtual; + procedure ResetAttributes(AObject: TInstantObject; + Map: TInstantAttributeMap); + procedure SetObjectUpdateCount(AObject: TInstantObject; Value: Integer); + function TranslateError(AObject: TInstantObject; E: Exception): Exception; + virtual; + procedure WriteBlob(Attribute: TInstantBlob); virtual; + procedure WriteBoolean(Attribute: TInstantBoolean); virtual; + procedure WriteDateTime(Attribute: TInstantDateTime); virtual; + procedure WriteFloat(Attribute: TInstantFloat); virtual; + procedure WriteCurrency(Attribute: TInstantCurrency); virtual; + procedure WriteInteger(Attribute: TInstantInteger); virtual; + procedure WriteMemo(Attribute: TInstantMemo); virtual; + procedure WritePart(Attribute: TInstantPart); virtual; + procedure WriteParts(Attribute: TInstantParts); virtual; + procedure WriteReference(Attribute: TInstantReference); virtual; + procedure WriteReferences(Attribute: TInstantReferences); virtual; + procedure WriteString(Attribute: TInstantString); virtual; + property DataSet: TDataset read GetDataSet write SetDataSet; + property NavigationalLinkResolvers: TObjectList read + GetNavigationalLinkResolvers; + public + constructor Create(ABroker: TInstantNavigationalBroker; + const ATableName: string); + destructor Destroy; override; + property Broker: TInstantNavigationalBroker read GetBroker; + property ObjectClassName: string read GetObjectClassName; + property ObjectId: string read GetObjectId; + property TableName: string read FTableName; + end; + + //Backwards compatibility + TInstantResolver = TInstantNavigationalResolver; + + TInstantSQLResolver = class(TInstantCustomResolver) + private + FMap: TInstantAttributeMap; + FDeleteSQL: string; + FDeleteConcurrentSQL: string; + FInsertSQL: string; + FSelectSQL: string; + FUpdateSQL: string; + FUpdateConcurrentSQL: string; + FSelectExternalSQL: string; + FSelectExternalPartSQL: string; + FDeleteExternalSQL: string; + FInsertExternalSQL: string; + procedure AddIntegerParam(Params: TParams; const ParamName: string; + Value: Integer); + procedure AddStringParam(Params: TParams; const ParamName, Value: string); + // Adds an "Id" param, whose data type and size depends on connector + // settings. + procedure AddIdParam(Params: TParams; const ParamName, Value: string); + procedure CheckConflict(Info: PInstantOperationInfo; + AObject: TInstantObject); + function ExecuteStatement(const AStatement: string; AParams: TParams; + Info: PInstantOperationInfo; ConflictAction: TInstantConflictAction; + AObject: TInstantObject): Integer; + function GetDeleteConcurrentSQL: string; + function GetDeleteSQL: string; + function GetInsertSQL: string; + function GetSelectSQL: string; + function GetUpdateConcurrentSQL: string; + function GetUpdateSQL: string; + function GetBroker: TInstantSQLBroker; + function GetSelectExternalSQL: string; + function GetSelectExternalPartSQL: string; + function GetDeleteExternalSQL: string; + function GetInsertExternalSQL: string; + protected + procedure AddAttributeParam(Attribute: TInstantAttribute; + Params: TParams); virtual; + procedure AddAttributeParams(Params: TParams; AObject: TInstantObject; + Map: TInstantAttributeMap); + procedure AddBaseParams(Params: TParams; AClassName, AObjectId: string; + AUpdateCount: Integer = -1); + procedure AddConcurrencyParam(Params: TParams; AUpdateCount: Integer); + function AddParam(Params: TParams; const ParamName: string; + ADataType: TFieldType): TParam; + procedure AddPersistentIdParam(Params: TParams; APersistentId: string); + procedure InternalDisposeMap(AObject: TInstantObject; + Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; + Info: PInstantOperationInfo); override; + procedure InternalRetrieveMap(AObject: TInstantObject; + const AObjectId: string; Map: TInstantAttributeMap; + ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo); + override; + procedure InternalStoreMap(AObject: TInstantObject; + Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; + Info: PInstantOperationInfo); override; + procedure ReadAttribute(AObject: TInstantObject; const AObjectId: string; + AttributeMetadata: TInstantAttributeMetadata; DataSet: TDataSet); virtual; + procedure ReadAttributes(AObject: TInstantObject; const AObjectId: string; + Map: TInstantAttributeMap; DataSet: TDataSet); + function ReadBlobField(DataSet: TDataSet; const FieldName: string): string; + virtual; + function ReadBooleanField(DataSet: TDataSet; const FieldName: string): + Boolean; virtual; + function ReadDateTimeField(DataSet: TDataSet; const FieldName: string): + TDateTime; virtual; + function ReadFloatField(DataSet: TDataSet; const FieldName: string): Double; + virtual; + function ReadCurrencyField(DataSet: TDataSet; const FieldName: string): + Currency; virtual; + function ReadIntegerField(DataSet: TDataSet; const FieldName: string): + Integer; virtual; + function ReadMemoField(DataSet: TDataSet; const FieldName: string): string; + virtual; + function ReadStringField(DataSet: TDataSet; const FieldName: string): + string; virtual; + procedure RemoveConcurrencyParam(Params: TParams); + procedure RemovePersistentIdParam(Params: TParams); + function TranslateError(AObject: TInstantObject; + E: Exception): Exception; virtual; + public + constructor Create(ABroker: TInstantSQLBroker; AMap: TInstantAttributeMap); + property Broker: TInstantSQLBroker read GetBroker; + property DeleteConcurrentSQL: string read GetDeleteConcurrentSQL write FDeleteConcurrentSQL; + property DeleteSQL: string read GetDeleteSQL write FDeleteSQL; + property DeleteExternalSQL: string read GetDeleteExternalSQL write FDeleteExternalSQL; + property InsertSQL: string read GetInsertSQL write FInsertSQL; + property InsertExternalSQL: string read GetInsertExternalSQL + write FInsertExternalSQL; + property Map: TInstantAttributeMap read FMap; + property SelectSQL: string read GetSelectSQL write FSelectSQL; + property SelectExternalSQL: string read GetSelectExternalSQL + write FSelectExternalSQL; + property SelectExternalPartSQL: string read GetSelectExternalPartSQL + write FSelectExternalPartSQL; + property UpdateConcurrentSQL: string read GetUpdateConcurrentSQL + write FUpdateConcurrentSQL; + property UpdateSQL: string read GetUpdateSQL write FUpdateSQL; + end; + + // TInstantLinkResolver class defines common interface for handling + // access to container attributes with external storage + TInstantLinkResolver = class(TInstantStreamable) + private + FResolver: TInstantCustomResolver; + function GetBroker: TInstantCustomRelationalBroker; + function GetResolver: TInstantCustomResolver; + protected + procedure InternalStoreAttributeObjects(Attribute: TInstantContainer); + virtual; + procedure InternalClearAttributeLinkRecords; virtual; + procedure InternalDisposeDeletedAttributeObjects( + Attribute: TInstantContainer); virtual; + procedure InternalReadAttributeObjects(Attribute: TInstantContainer; + const AObjectId: string); virtual; + public + constructor Create(AResolver: TInstantCustomResolver); + procedure StoreAttributeObjects(Attribute: TInstantContainer); + procedure ClearAttributeLinkRecords; + procedure DisposeDeletedAttributeObjects(Attribute: TInstantContainer); + procedure ReadAttributeObjects(Attribute: TInstantContainer; + const AObjectId: string); + property Broker: TInstantCustomRelationalBroker read GetBroker; + property Resolver: TInstantCustomResolver read GetResolver; + end; + + // TInstantNavigationalLinkResolver is an abstract class that + // defines the interface for handling access to container attributes + // with external storage for navigational brokers. + // Each navigational broker needs to provide a concrete class descendent. + // See the BDE broker as an example. + TInstantNavigationalLinkResolver = class(TInstantLinkResolver) + private + FDataSet: TDataSet; + FFreeDataSet: Boolean; + FTableName: string; + function FieldByName(const FieldName: string): TField; + procedure FreeDataSet; + function GetBroker: TInstantNavigationalBroker; + function GetDataSet: TDataSet; + function GetResolver: TInstantNavigationalResolver; + procedure SetDataSet(Value: TDataset); + protected + procedure Append; virtual; + procedure Cancel; virtual; + procedure Close; virtual; + function CreateDataSet: TDataSet; virtual; abstract; + procedure Delete; virtual; + procedure Edit; virtual; + function Eof: Boolean; virtual; + procedure First; virtual; + procedure InternalStoreAttributeObjects(Attribute: TInstantContainer); override; + procedure InternalClearAttributeLinkRecords; override; + procedure InternalDisposeDeletedAttributeObjects( + Attribute: TInstantContainer); override; + procedure InternalReadAttributeObjects(Attribute: TInstantContainer; + const AObjectId: string); override; + procedure Next; virtual; + procedure Open; virtual; + procedure Post; virtual; + procedure SetDatasetParentRange(const AParentClass, AParentId: string); + virtual; abstract; + property DataSet: TDataset read GetDataSet write SetDataSet; + public + constructor Create(AResolver: TInstantNavigationalResolver; + const ATableName: string); + destructor Destroy; override; + property Broker: TInstantNavigationalBroker read GetBroker; + property Resolver: TInstantNavigationalResolver read GetResolver; + property TableName: string read FTableName; + end; + + // TInstantSQLLinkResolver class defines interface for handling + // access to container attributes with external storage for + // SQL brokers. Due to the generic nature of SQL this class is used + // directly and no descendant classes are needed for SQL brokers. + TInstantSQLLinkResolver = class(TInstantLinkResolver) + private + FAttributeOwner: TInstantObject; + FTableName: string; +... [truncated message content] |
|
From: <na...@us...> - 2006-11-16 09:03:07
|
Revision: 714
http://svn.sourceforge.net/instantobjects/revision/?rev=714&view=rev
Author: nandod
Date: 2006-11-16 01:03:07 -0800 (Thu, 16 Nov 2006)
Log Message:
-----------
* removed duplicate definition of sLineBreak; checked and fixed uses clauses accordingly.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantClasses.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2006-11-16 08:38:33 UTC (rev 713)
+++ trunk/Source/Core/InstantBrokers.pas 2006-11-16 09:03:07 UTC (rev 714)
@@ -40,7 +40,8 @@
interface
-uses SysUtils, Classes, Db, InstantPersistence, InstantTypes, InstantMetadata,
+uses
+ SysUtils, Classes, Db, InstantPersistence, InstantTypes, InstantMetadata,
InstantConsts, InstantClasses, Contnrs, InstantCommand;
type
Modified: trunk/Source/Core/InstantClasses.pas
===================================================================
--- trunk/Source/Core/InstantClasses.pas 2006-11-16 08:38:33 UTC (rev 713)
+++ trunk/Source/Core/InstantClasses.pas 2006-11-16 09:03:07 UTC (rev 714)
@@ -417,10 +417,6 @@
('Binary format',
'XML format');
-{$IFDEF D5}
- sLineBreak = #13#10;
-{$ENDIF}
-
function InstantBuildEndTag(const TagName: string): string;
function InstantBuildStartTag(const TagName: string): string;
procedure InstantCheckClass(AClass: TClass; MinimumClass: TClass);
|
|
From: <the...@us...> - 2006-11-29 17:19:52
|
Revision: 730
http://svn.sourceforge.net/instantobjects/revision/?rev=730&view=rev
Author: the_kique
Date: 2006-11-29 09:19:47 -0800 (Wed, 29 Nov 2006)
Log Message:
-----------
Added icon support to AssignToPicture [1603283], compatibility to Assign method in TPicture class [1603285]
Modified Paths:
--------------
trunk/Source/Core/InstantPersistence.pas
trunk/Source/Core/InstantTypes.pas
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2006-11-29 10:53:06 UTC (rev 729)
+++ trunk/Source/Core/InstantPersistence.pas 2006-11-29 17:19:47 UTC (rev 730)
@@ -422,6 +422,7 @@
procedure SetAsVariant(AValue: Variant); override;
function Write(const Buffer; Position, Count: Integer): Integer; virtual;
procedure WriteObject(Writer: TInstantWriter); override;
+ procedure AssignTo(Dest: TPersistent); override;
public
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
@@ -1956,6 +1957,9 @@
// gif format
else if (P[0] = #$47) and (P[1] = #$49) and (P[2] = #$46) then
Result := gffGif
+ // Ico format
+ else if (P[0] = #00) and (P[1] = #00) and (P[2] = #01) and (P[3] = #00) then
+ Result := gffIco
// bitmap format with TGraphicHeader header
else if (P[0] = #01) and (P[1] = #00) and (P[2] = #00) and (P[3] = #01)
and (PLongint(@p[4])^ = StreamLength - SizeOfGraphicHeader) then
@@ -3543,6 +3547,14 @@
Dest.Graphic := nil;
end;
+procedure TInstantBlob.AssignTo(Dest: TPersistent);
+begin
+ if Dest is TPicture then
+ AssignToPicture(TPicture(Dest))
+ else
+ inherited;
+end;
+
{ TInstantMemo }
class function TInstantMemo.AttributeType: TInstantAttributeType;
@@ -8815,12 +8827,14 @@
TInstantObjectReference, TInstantConnectionDefs, TInstantConnectionDef]);
ClassList := TList.Create;
{$IFDEF MSWINDOWS}
+ GraphicClassList[gffIco] := Graphics.TIcon;
GraphicClassList[gffBmp] := Graphics.TBitmap;
{$IFNDEF FPC}
GraphicClassList[gffEmf] := Graphics.TMetaFile;
{$ENDIF}
{$ENDIF}
{$IFDEF LINUX}
+ GraphicClassList[gffIco] := QGraphics.TIcon;
GraphicClassList[gffBmp] := QGraphics.TBitmap;
GraphicClassList[gffPng] := QGraphics.TBitmap;
GraphicClassList[gffJpeg]:= QGraphics.TBitmap;
Modified: trunk/Source/Core/InstantTypes.pas
===================================================================
--- trunk/Source/Core/InstantTypes.pas 2006-11-29 10:53:06 UTC (rev 729)
+++ trunk/Source/Core/InstantTypes.pas 2006-11-29 17:19:47 UTC (rev 730)
@@ -48,7 +48,7 @@
TInstantAttributeCategory = (acUnknown, acSimple, acElement, acContainer);
TInstantGraphicFileFormat = (gffUnknown, gffBmp, gffTiff, gffJpeg, gffPng,
- gffDcx, gffPcx, gffEmf, gffGif);
+ gffDcx, gffPcx, gffEmf, gffGif, gffIco);
TInstantPersistence = (peEmbedded, peStored);
|
|
From: <na...@us...> - 2007-02-25 15:49:47
|
Revision: 769
http://svn.sourceforge.net/instantobjects/revision/?rev=769&view=rev
Author: nandod
Date: 2007-02-25 07:49:44 -0800 (Sun, 25 Feb 2007)
Log Message:
-----------
* fixed two warnings.
Modified Paths:
--------------
trunk/Source/Core/InstantPersistence.pas
trunk/Source/Core/InstantPresentation.pas
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2007-02-25 15:46:50 UTC (rev 768)
+++ trunk/Source/Core/InstantPersistence.pas 2007-02-25 15:49:44 UTC (rev 769)
@@ -1113,7 +1113,6 @@
property Connector: TInstantConnector read GetConnector;
// Executes the database build step.
procedure Execute;
- published
property Enabled: Boolean read FEnabled write FEnabled;
end;
TInstantDBBuildCommandClass = class of TInstantDBBuildCommand;
Modified: trunk/Source/Core/InstantPresentation.pas
===================================================================
--- trunk/Source/Core/InstantPresentation.pas 2007-02-25 15:46:50 UTC (rev 768)
+++ trunk/Source/Core/InstantPresentation.pas 2007-02-25 15:49:44 UTC (rev 769)
@@ -367,7 +367,11 @@
protected
{ IProviderSupport }
procedure PSGetAttributes(List: TList); override;
+ {$IFDEF D10+}
+ function PSGetTableNameW: WideString; override;
+ {$ELSE}
function PSGetTableName: string; override;
+ {$ENDIF}
procedure PSReset; override;
protected
procedure AddClassFieldDefs(const FieldName: string; AClass: TClass); overload;
@@ -3748,7 +3752,11 @@
begin
end;
+{$IFDEF D10+}
+function TInstantCustomExposer.PSGetTableNameW: WideString;
+{$ELSE}
function TInstantCustomExposer.PSGetTableName: string;
+{$ENDIF}
begin
Result := ObjectClassName;
end;
|
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X