From: <fas...@us...> - 2006-02-03 02:48:04
|
Revision: 575 Author: fastbike2 Date: 2006-02-02 18:47:44 -0800 (Thu, 02 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=575&view=rev Log Message: ----------- Fix for Bug 1423157. Parts Attribute Insert causes Error Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-03 01:59:28 UTC (rev 574) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-03 02:47:44 UTC (rev 575) @@ -26,7 +26,7 @@ * Contributor(s): * Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell, * Joao Morais, Cesar Coll, Uberto Barbini, David Taylor, Hanedi Salas, - * Riceball Lee + * Riceball Lee, David Moorhouse * * ***** END LICENSE BLOCK ***** *) @@ -6592,7 +6592,8 @@ procedure TInstantContainer.Insert(Index: Integer; AObject: TInstantObject); begin - CheckRange(Index); + if Index <> 0 then + CheckRange(Index); ValidateObject(AObject); BeforeContentChange(ctAdd, Index, AObject); InternalInsert(Index, AObject); |
From: <fas...@us...> - 2006-02-03 03:11:15
|
Revision: 576 Author: fastbike2 Date: 2006-02-02 19:10:51 -0800 (Thu, 02 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=576&view=rev Log Message: ----------- Bug 1385748 "Nested calls to Store cause Stack Overflow" Added flag to prevent recursive calls to Store. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-03 02:47:44 UTC (rev 575) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-03 03:10:51 UTC (rev 576) @@ -1151,6 +1151,7 @@ FChangesDisabledCount: Integer; FConnector: TInstantConnector; FId: string; + FInUpdate: Boolean; FObjectStore: TInstantObjectStore; FOwner: TInstantObject; FOwnerAttribute: TInstantComplex; @@ -9993,27 +9994,32 @@ if not (Assigned(AObject) and AObject.Metadata.IsStored) then Exit; CheckBroker(Broker); + AObject.FInUpdate := True; try - if Broker.StoreObject(AObject, ConflictAction) then - begin - if AObject.IsPersistent then + try + if Broker.StoreObject(AObject, ConflictAction) then begin - MustAdd := AObject.Id <> AObject.PersistentId; + if AObject.IsPersistent then + begin + MustAdd := AObject.Id <> AObject.PersistentId; + if MustAdd then + RemoveFromCache(AObject); + end else + MustAdd := True; + AObject.SetPersistentId(AObject.Id); if MustAdd then - RemoveFromCache(AObject); - end else - MustAdd := True; - AObject.SetPersistentId(AObject.Id); - if MustAdd then - AddToCache(AObject); + AddToCache(AObject); + end; + except + on E: Exception do + if (E is EInstantError) or (E is EAbort) then + raise + else + raise EInstantError.CreateFmt(SErrorStoringObject, + [AObject.ClassName, AObject.Id, E.Message], E); end; - except - on E: Exception do - if (E is EInstantError) or (E is EAbort) then - raise - else - raise EInstantError.CreateFmt(SErrorStoringObject, - [AObject.ClassName, AObject.Id, E.Message], E); + finally + AObject.FInUpdate := False; end; end; @@ -14233,6 +14239,8 @@ 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); |
From: <fas...@us...> - 2006-02-03 04:15:23
|
Revision: 577 Author: fastbike2 Date: 2006-02-02 20:14:57 -0800 (Thu, 02 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=577&view=rev Log Message: ----------- Added new public property RefItems to TInstantReferences. This is an indexed property that returns the TInstantObjectReference from the internal list, allowing you to get a list of referenced object IDs without retrieving them. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-03 03:10:51 UTC (rev 576) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-03 04:14:57 UTC (rev 577) @@ -1084,6 +1084,7 @@ function GetObjectReferenceList: TInstantObjectReferenceList; property ObjectReferenceList: TInstantObjectReferenceList read GetObjectReferenceList; + function GetRefItems(Index: Integer): TInstantObjectReference; protected class function AttributeType: TInstantAttributeType; override; function GetAllowOwned: Boolean; override; @@ -1113,6 +1114,7 @@ procedure SaveReferencesToStream(AStream: TStream); property AllowOwned write SetAllowOwned; property Connector write FConnector; + property RefItems[Index: Integer]: TInstantObjectReference read GetRefItems; end; TInstantObjectState = class(TPersistent) @@ -7180,6 +7182,11 @@ Result := FObjectReferenceList; end; +function TInstantReferences.GetRefItems(Index: Integer): TInstantObjectReference; +begin + Result := ObjectReferenceList.RefItems[Index]; +end; + function TInstantReferences.InternalAdd(AObject: TInstantObject): Integer; begin Result := ObjectReferenceList.Add(AObject); |
From: <jcm...@us...> - 2006-02-05 14:25:43
|
Revision: 581 Author: jcmoraisjr Date: 2006-02-05 06:25:24 -0800 (Sun, 05 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=581&view=rev Log Message: ----------- Fixed leakage using TInstantObject instance via interface pointer. Bug # 1424540 Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-05 14:07:57 UTC (rev 580) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-05 14:25:24 UTC (rev 581) @@ -8900,7 +8900,14 @@ function TInstantObject._Release: Integer; begin - Result := Release; + FreeCircularReferences; + Result := DoRelease; + if FRefCount = 1 then + try + Finit; + finally + inherited FreeInstance; + end; end; { TInstantConnectionDef } |
From: <jcm...@us...> - 2006-02-05 16:40:41
|
Revision: 583 Author: jcmoraisjr Date: 2006-02-05 08:40:22 -0800 (Sun, 05 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=583&view=rev Log Message: ----------- Fixed leakages with part and parts attributes in circular reference check effort. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-05 14:41:54 UTC (rev 582) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-05 16:40:22 UTC (rev 583) @@ -8236,26 +8236,33 @@ procedure TInstantObject.FreeCircularReferences; - function IsInsideCircularReference(const AItem: TInstantComplex): - Boolean; + function IsInsideCircularReference(const AItem: TInstantComplex): Boolean; var + ItemOwner: TInstantObject; CurrentItem: TInstantComplex; I: Integer; begin - Result := AItem.Owner = Self; - if not Result and Assigned(AItem.Owner.FRefBy) then - for I := 0 to Pred(AItem.Owner.FRefBy.Count) do - if AItem.Owner.FRefBy[I] is TInstantComplex then + Result := Assigned(AItem); + if not Result then + Exit; + ItemOwner := AItem.Owner; + Result := (ItemOwner = Self) or + IsInsideCircularReference(ItemOwner.OwnerAttribute); + if not Result and Assigned(ItemOwner.FRefBy) then + begin + for I := 0 to Pred(ItemOwner.FRefBy.Count) do + if ItemOwner.FRefBy[I] is TInstantComplex then begin - CurrentItem := TInstantComplex(AItem.Owner.FRefBy[I]); + CurrentItem := TInstantComplex(ItemOwner.FRefBy[I]); if CurrentItem.AttributeType in [atReference, atReferences] then begin - Result := (AItem.Owner.RefCount = AItem.Owner.FRefBy.Count) and - IsInsideCircularReference(CurrentItem); + Result := (ItemOwner.RefCount = ItemOwner.FRefBy.Count) and + IsInsideCircularReference(CurrentItem); if Result then Exit; end; end; + end; end; var |
From: <na...@us...> - 2007-01-16 17:09:36
|
Revision: 751 http://svn.sourceforge.net/instantobjects/revision/?rev=751&view=rev Author: nandod Date: 2007-01-16 09:09:37 -0800 (Tue, 16 Jan 2007) Log Message: ----------- * fix for test case 10 for circular references (on behalf of Joao Morais). Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2007-01-16 10:23:05 UTC (rev 750) +++ trunk/Source/Core/InstantPersistence.pas 2007-01-16 17:09:37 UTC (rev 751) @@ -6113,10 +6113,11 @@ var I: Integer; begin - CheckedObjects := TObjectList.Create(False); - try - if RefByCount = RefCount - 1 then - for I := Pred(RefByCount) downto 0 do + if RefByCount = RefCount - 1 then + for I := Pred(RefByCount) downto 0 do + begin + CheckedObjects := TObjectList.Create(False); + try if (FRefBy[I] is TInstantComplex) and IsInsideCircularReference(TInstantComplex(FRefBy[I])) then case TInstantComplex(FRefBy[I]).AttributeType of @@ -6125,9 +6126,10 @@ atReferences: TInstantReferences(FRefBy[I]).DestroyObject(Self); end; - finally - CheckedObjects.Free; - end; + finally + CheckedObjects.Free; + end; + end; end; procedure TInstantObject.FreeInstance; |
From: <fas...@us...> - 2006-02-13 17:57:40
|
Revision: 588 Author: fastbike2 Date: 2006-02-13 09:57:13 -0800 (Mon, 13 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=588&view=rev Log Message: ----------- Fix for Bug 1375131: Evolving database with part attributes causes "Class Not Registered" error when object is retrieved. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-13 15:56:16 UTC (rev 587) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-13 17:57:13 UTC (rev 588) @@ -14403,6 +14403,8 @@ procedure ReadPartAttribute; var Stream: TInstantStringStream; + LPartClassName: string; + LPartId: string; begin if AttributeMetadata.StorageKind = skExternal then begin @@ -14411,13 +14413,23 @@ // Must clear Value first to avoid leak for Refresh operation // as OldValue = NewValue. Value := nil; - Value := InstantFindClass(ReadStringField(DataSet, AFieldName + InstantClassFieldName)).Retrieve( - ReadStringField(DataSet, AFieldName + InstantIdFieldName), False, False, AObject.Connector); + LPartClassName := ReadStringField(DataSet, AFieldName + + InstantClassFieldName); + LPartId := ReadStringField(DataSet, AFieldName + + InstantIdFieldName); + // LPartClassName and LPartId will be empty if the attribute was + // added to a class with existing instances in the database. + if (LPartClassName = '') and (LPartId = '') then + (Attribute as TInstantPart).Reset + else + Value := InstantFindClass(LPartClassName).Retrieve(LPartId, + False, False, AObject.Connector); end; end else begin - Stream := TInstantStringStream.Create(ReadBlobField(DataSet, AFieldName)); + Stream := TInstantStringStream.Create(ReadBlobField(DataSet, + AFieldName)); try if Stream.Size = 0 then (Attribute as TInstantPart).Reset |
From: <jcm...@us...> - 2006-02-22 17:38:26
|
Revision: 619 Author: jcmoraisjr Date: 2006-02-22 09:38:12 -0800 (Wed, 22 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=619&view=rev Log Message: ----------- Fixed new TInstanReferences.DestroyObject method that is causing an infinite loop into FreeCircularReference. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-21 19:43:52 UTC (rev 618) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-22 17:38:12 UTC (rev 619) @@ -7204,7 +7204,7 @@ Index: Integer; begin Index := IndexOf(AObject); - Result := Index >= 0; + Result := (Index >= 0) and ObjectReferenceList.RefItems[Index].HasInstance; if Result then ObjectReferenceList.RefItems[Index].DestroyInstance; end; |
From: <jcm...@us...> - 2006-02-23 14:14:12
|
Revision: 622 Author: jcmoraisjr Date: 2006-02-23 06:14:00 -0800 (Thu, 23 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=622&view=rev Log Message: ----------- Fixed Info.Conflict assignment into TInstantSQLResolver.ExecuteStatement method. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-22 23:10:36 UTC (rev 621) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-23 14:14:00 UTC (rev 622) @@ -13781,7 +13781,7 @@ try Result := Broker.Execute(AStatement, AParams); Info.Success := Result >= 1; - Info.Conflict := not Info.Success or (ConflictAction = caIgnore); + Info.Conflict := not (Info.Success or (ConflictAction = caIgnore)); except on EAbort do raise; |
From: <jcm...@us...> - 2006-02-26 14:25:44
|
Revision: 630 Author: jcmoraisjr Date: 2006-02-26 06:25:36 -0800 (Sun, 26 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=630&view=rev Log Message: ----------- Fixed bug # 1439025 Apply/RestoreState decrementing StateLevel. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-26 13:50:12 UTC (rev 629) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-26 14:25:36 UTC (rev 630) @@ -7537,6 +7537,8 @@ procedure TInstantObject.ApplyState; begin + if FSaveStateLevel = 0 then + Exit; if FSaveStateLevel = 1 then try SavedState.Assign(State); @@ -8791,6 +8793,8 @@ var vInCache: Boolean; begin + if FSaveStateLevel = 0 then + Exit; if (FSaveStateLevel = 1) and not IsAbandoned then try vInCache := ObjectStore.Find(Self.PersistentId) = Self; @@ -8868,7 +8872,6 @@ begin if State.PersistentId = '' then Exit; - if FSaveStateLevel = 0 then try SavedState.Assign(State); |
From: <na...@us...> - 2006-02-28 08:48:48
|
Revision: 633 Author: nandod Date: 2006-02-28 00:48:40 -0800 (Tue, 28 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=633&view=rev Log Message: ----------- cosmetic fixes Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-28 03:06:41 UTC (rev 632) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-28 08:48:40 UTC (rev 633) @@ -3092,58 +3092,54 @@ SizeOfGraphicHeader = 8; MinimumBytesToRead = 10; var - P: PChar; + P: array [0..MinimumBytesToRead - 1] of Char; StreamLength: Longint; BytesRetrieved: Integer; begin Result := gffUnknown; if not Assigned(AStream) then Exit; - GetMem(P, 10); - try - StreamLength := AStream.Size; - AStream.Position := 0; - BytesRetrieved := AStream.Read(P[0], MinimumBytesToRead); - AStream.Position := 0; - if BytesRetrieved < MinimumBytesToRead then - Exit; - // bitmap format - if (P[0] = #66) and (P[1] = #77) then - Result := gffBmp - // tiff format - else if ((P[0] = #73) and (P[1] = #73) and (P[2] = #42) and (P[3] = #0)) - or ((P[0] = #77) and (P[1] = #77) and (P[2] = #42) and (P[3] = #0)) then - Result := gffTiff - // jpg format - else if (P[6] = #74) and (P[7] = #70) and (P[8] = #73) and (P[9] = #70) - or (P[6] = #69) and (P[7] = #120) and (P[8] = #105) and (P[9] = #102) then - Result := gffJpeg - // png format - else if (P[0] = #137 ) and (P[1] = #80) and (P[2] = #78) and (P[3] = #71) - and (P[4] = #13) and (P[5] = #10) and (P[6] = #26) and (P[7] = #10) then - Result := gffPng - // dcx format - else if (P[0] = #177) and (P[1] = #104) and (P[2] = #222) and (P[3] = #58) then - Result := gffDcx - // pcx format - else if p[0] = #10 then - Result := gffPcx - // emf format - else if ((P[0] = #215) and (P[1] = #205) and (P[2] = #198) and (P[3] = #154)) - or ((P[0] = #1) and (P[1] = #0) and (P[2] = #0) and (P[3] = #0)) then - Result := gffEmf - // gif format - else if (P[0] = #$47) and (P[1] = #$49) and (P[2] = #$46) then - Result := gffGif - // 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 - begin - Result := gffBmp; - AStream.Position := SizeOfGraphicHeader; - end; - finally - FreeMem(P); + StreamLength := AStream.Size; + AStream.Position := 0; + FillChar(P, SizeOf(P), #0); + BytesRetrieved := AStream.Read(P[0], SizeOf(P)); + AStream.Position := 0; + if BytesRetrieved < MinimumBytesToRead then + Exit; + // bitmap format + if (P[0] = #66) and (P[1] = #77) then + Result := gffBmp + // tiff format + else if ((P[0] = #73) and (P[1] = #73) and (P[2] = #42) and (P[3] = #0)) + or ((P[0] = #77) and (P[1] = #77) and (P[2] = #42) and (P[3] = #0)) then + Result := gffTiff + // jpg format + else if (P[6] = #74) and (P[7] = #70) and (P[8] = #73) and (P[9] = #70) + or (P[6] = #69) and (P[7] = #120) and (P[8] = #105) and (P[9] = #102) then + Result := gffJpeg + // png format + else if (P[0] = #137 ) and (P[1] = #80) and (P[2] = #78) and (P[3] = #71) + and (P[4] = #13) and (P[5] = #10) and (P[6] = #26) and (P[7] = #10) then + Result := gffPng + // dcx format + else if (P[0] = #177) and (P[1] = #104) and (P[2] = #222) and (P[3] = #58) then + Result := gffDcx + // pcx format + else if p[0] = #10 then + Result := gffPcx + // emf format + else if ((P[0] = #215) and (P[1] = #205) and (P[2] = #198) and (P[3] = #154)) + or ((P[0] = #1) and (P[1] = #0) and (P[2] = #0) and (P[3] = #0)) then + Result := gffEmf + // gif format + else if (P[0] = #$47) and (P[1] = #$49) and (P[2] = #$46) then + Result := gffGif + // 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 + begin + Result := gffBmp; + AStream.Position := SizeOfGraphicHeader; end; end; |
From: <na...@us...> - 2006-02-28 09:17:46
|
Revision: 634 Author: nandod Date: 2006-02-28 01:17:36 -0800 (Tue, 28 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=634&view=rev Log Message: ----------- + FR# 1440209 - Pass the object instance to OnGenerateId Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-28 08:48:40 UTC (rev 633) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-28 09:17:36 UTC (rev 634) @@ -1433,7 +1433,8 @@ TInstantQuery = class; TInstantSchemeEvent = procedure(Sender: TObject; Scheme: TInstantScheme) of object; - TInstantGenerateIdEvent = procedure(Sender: TObject; var Id: String) of object; + TInstantGenerateIdEvent = procedure(Sender: TObject; const AObject: TInstantObject; + var Id: string) of object; TInstantConnector = class(TComponent) private @@ -1483,7 +1484,7 @@ function InternalCreateQuery: TInstantQuery; virtual; function InternalCreateScheme(Model: TInstantModel): TInstantScheme; virtual; abstract; procedure InternalDisconnect; virtual; abstract; - function InternalGenerateId: string; virtual; + function InternalGenerateId(const AObject: TInstantObject = nil): string; virtual; procedure InternalRollbackTransaction; virtual; procedure InternalStartTransaction; virtual; function RemoveTransactedObject(AObject: TInstantObject): Integer; @@ -1503,7 +1504,7 @@ function CreateQuery: TInstantQuery; procedure Disconnect; function EnsureObjectStore(AClass: TInstantObjectClass): TInstantObjectStore; - function GenerateId: string; + function GenerateId(const AObject: TInstantObject = nil): string; class procedure RegisterClass; procedure RegisterClient(Client: TObject); procedure RollbackTransaction; @@ -9225,9 +9226,9 @@ end; end; -function TInstantConnector.GenerateId: string; +function TInstantConnector.GenerateId(const AObject: TInstantObject = nil): string; begin - Result := InternalGenerateId; + Result := InternalGenerateId(AObject); end; function TInstantConnector.GetBroker: TInstantBroker; @@ -9366,12 +9367,12 @@ Result := Broker.CreateQuery; end; -function TInstantConnector.InternalGenerateId: string; +function TInstantConnector.InternalGenerateId(const AObject: TInstantObject = nil): string; begin if Assigned(FOnGenerateId) then begin Result := ''; - FOnGenerateId(Self, Result); + FOnGenerateId(Self, AObject, Result); end else Result := InstantGenerateId; |
From: <jcm...@us...> - 2006-03-27 11:50:15
|
Revision: 658 Author: jcmoraisjr Date: 2006-03-27 03:50:07 -0800 (Mon, 27 Mar 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=658&view=rev Log Message: ----------- Rolled back part of the fix for the bug "1424540 Leakage using interfaces", that is raising AVs when class and interface pointers are used together. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-03-23 08:34:36 UTC (rev 657) +++ trunk/Source/Core/InstantPersistence.pas 2006-03-27 11:50:07 UTC (rev 658) @@ -9036,7 +9036,7 @@ begin FreeCircularReferences; Result := DoRelease; - if FRefCount = 1 then + if FRefCount = 0 then try Finit; finally |
From: <fas...@us...> - 2006-04-10 19:13:50
|
Revision: 665 Author: fastbike2 Date: 2006-04-10 11:55:03 -0700 (Mon, 10 Apr 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=665&view=rev Log Message: ----------- Bug Fix [ 1464661 ] TInstantReference.Assign causes AV Check for nil before we try to clone a TInstantReference attribute object. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-04-10 08:31:44 UTC (rev 664) +++ trunk/Source/Core/InstantPersistence.pas 2006-04-10 18:55:03 UTC (rev 665) @@ -6285,7 +6285,12 @@ begin // cross-connector object assignment must be supported for InstantPump. if Self.Connector <> Connector then - Self.Value := Value.Clone(Self.Connector) + begin + if Assigned(Value) then + Self.Value := Value.Clone(Self.Connector) + else + Self.Value := nil; + end else Self.Value := Value; end; |
From: <fas...@us...> - 2006-04-24 23:01:11
|
Revision: 668 Author: fastbike2 Date: 2006-04-24 16:01:01 -0700 (Mon, 24 Apr 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=668&view=rev Log Message: ----------- Bug fix for #1475841 "TInstantContainer.Sort error if empty" Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-04-24 11:25:52 UTC (rev 667) +++ trunk/Source/Core/InstantPersistence.pas 2006-04-24 23:01:01 UTC (rev 668) @@ -6817,7 +6817,8 @@ procedure TInstantContainer.Sort(Compare: TInstantSortCompare); begin - QuickSort(0, Pred(Count), Compare); + if Count > 1 then + QuickSort(0, Pred(Count), Compare); end; procedure TInstantContainer.ValidateObject(AObject: TInstantObject); |
From: <jcm...@us...> - 2006-05-02 19:09:29
|
Revision: 672 Author: jcmoraisjr Date: 2006-05-02 12:09:06 -0700 (Tue, 02 May 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=672&view=rev Log Message: ----------- Changed the visibility of the TInstantReferences.ObjectReferenceList property (private -> protected) Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-05-01 21:24:47 UTC (rev 671) +++ trunk/Source/Core/InstantPersistence.pas 2006-05-02 19:09:06 UTC (rev 672) @@ -1100,8 +1100,6 @@ FConnector: TInstantConnector; FObjectReferenceList: TInstantObjectReferenceList; function GetObjectReferenceList: TInstantObjectReferenceList; - property ObjectReferenceList: TInstantObjectReferenceList read - GetObjectReferenceList; function GetRefItems(Index: Integer): TInstantObjectReference; protected class function AttributeType: TInstantAttributeType; override; @@ -1123,6 +1121,8 @@ procedure SetAllowOwned(Value: Boolean); virtual; procedure ValidateObject(AObject: TInstantObject); override; procedure WriteObject(Writer: TInstantWriter); override; + property ObjectReferenceList: TInstantObjectReferenceList read + GetObjectReferenceList; public destructor Destroy; override; procedure Assign(Source: TPersistent); override; |
From: <na...@us...> - 2006-05-16 15:52:40
|
Revision: 675 Author: nandod Date: 2006-05-16 08:52:33 -0700 (Tue, 16 May 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=675&view=rev Log Message: ----------- * made TInstantSQLBroker.AcquireDataSet virtual. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-05-11 07:41:33 UTC (rev 674) +++ trunk/Source/Core/InstantPersistence.pas 2006-05-16 15:52:33 UTC (rev 675) @@ -2379,7 +2379,7 @@ function CreateDataSet(const AStatement: string; AParams: TParams = nil): TDataSet; virtual; abstract; public destructor Destroy; override; - function AcquireDataSet(const AStatement: string; AParams: TParams = nil): TDataSet; + 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; |
From: <sr...@us...> - 2006-07-22 22:06:21
|
Revision: 689 Author: srmitch Date: 2006-07-22 15:06:11 -0700 (Sat, 22 Jul 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=689&view=rev Log Message: ----------- - Remove TInstantNavigationalResolver.ClearEnum implementation from InstantPersistence.pas that was incorrectly added in previous update (687). Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-07-22 05:32:46 UTC (rev 688) +++ trunk/Source/Core/InstantPersistence.pas 2006-07-22 22:06:11 UTC (rev 689) @@ -12312,10 +12312,6 @@ inherited; end; -procedure TInstantNavigationalResolver.ClearEnum(Attribute: TInstantEnum); -begin -end; - procedure TInstantNavigationalResolver.Edit; begin DataSet.Edit; |
From: <sr...@us...> - 2006-07-22 22:43:25
|
Revision: 690 Author: srmitch Date: 2006-07-22 15:43:16 -0700 (Sat, 22 Jul 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=690&view=rev Log Message: ----------- - Added implementation of class methods that were left out of 687 update in InstantPersistence.pas. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-07-22 22:06:11 UTC (rev 689) +++ trunk/Source/Core/InstantPersistence.pas 2006-07-22 22:43:16 UTC (rev 690) @@ -15951,6 +15951,463 @@ end; end; +constructor TInstantNavigationalLinkResolver.Create(AResolver: + TInstantNavigationalResolver; const ATableName: string); +begin + inherited Create(AResolver); + FTableName := ATableName; +end; + +destructor TInstantNavigationalLinkResolver.Destroy; +begin + FreeDataSet; + inherited; +end; + +procedure TInstantNavigationalLinkResolver.Append; +begin + DataSet.Append; +end; + +procedure TInstantNavigationalLinkResolver.Cancel; +begin + DataSet.Cancel; +end; + +procedure TInstantNavigationalLinkResolver.Close; +begin + DataSet.Close; +end; + +procedure TInstantNavigationalLinkResolver.Delete; +begin + DataSet.Delete; +end; + +procedure TInstantNavigationalLinkResolver.Edit; +begin + DataSet.Edit; +end; + +function TInstantNavigationalLinkResolver.Eof: Boolean; +begin + Result := DataSet.Eof; +end; + +function TInstantNavigationalLinkResolver.FieldByName(const FieldName: string): + TField; +begin + Result := DataSet.FieldByName(FieldName); +end; + +procedure TInstantNavigationalLinkResolver.First; +begin + Dataset.First; +end; + +procedure TInstantNavigationalLinkResolver.FreeDataSet; +begin + if FFreeDataSet then + FreeAndNil(FDataSet); +end; + +function TInstantNavigationalLinkResolver.GetBroker: TInstantNavigationalBroker; +begin + Result := Resolver.Broker; +end; + +function TInstantNavigationalLinkResolver.GetDataSet: TDataSet; +begin + if not Assigned(FDataSet) then + begin + Broker.Connector.DoGetDataSet(TableName, FDataSet); + if not Assigned(FDataSet) then + begin + FDataSet := CreateDataSet; + FFreeDataSet := True; + end; + Broker.Connector.DoInitDataSet(TableName, FDataSet); + end; + Result := FDataSet; +end; + +function TInstantNavigationalLinkResolver.GetResolver: + TInstantNavigationalResolver; +begin + Result := inherited Resolver as TInstantNavigationalResolver; +end; + +procedure TInstantNavigationalLinkResolver.InternalStoreAttributeObjects( + Attribute: TInstantContainer); +var + I: Integer; + Obj: TInstantObject; + WasOpen: Boolean; +begin + WasOpen := Dataset.Active; + + if not WasOpen then + Open; + try + for I := 0 to Pred(Attribute.Count) do + begin + Obj := Attribute.Items[I]; + if Obj.InUpdate then // prevent recursion + Continue; + Obj.CheckId; + Append; + try + FieldByName(InstantIdFieldName).AsString := Obj.GenerateId; + FieldByName(InstantParentClassFieldName).AsString := + Attribute.Owner.ClassName; + FieldByName(InstantParentIdFieldName).AsString := Attribute.Owner.Id; + FieldByName(InstantChildClassFieldName).AsString := Obj.ClassName; + FieldByName(InstantChildIdFieldName).AsString := Obj.Id; + FieldByName(InstantSequenceNoFieldName).AsInteger := Succ(I); + Post; + except + Cancel; + end; + Obj.ObjectStore.StoreObject(Obj, caIgnore); + end; + finally + if not WasOpen then + Close; + end; +end; + +procedure TInstantNavigationalLinkResolver.InternalClearAttributeLinkRecords; +var + WasOpen: Boolean; +begin + WasOpen := Dataset.Active; + + if not WasOpen then + Open; + try + SetDatasetParentRange(Resolver.ObjectClassname, Resolver.ObjectId); + First; + while not Eof do + Delete; + finally + if not WasOpen then + Close; + end; +end; + +procedure TInstantNavigationalLinkResolver.InternalDisposeDeletedAttributeObjects( + Attribute: TInstantContainer); +var +// I: Integer; + Obj: TInstantObject; + AttributeMetadata: TInstantAttributeMetadata; + ObjDisposed: Boolean; + WasOpen: Boolean; +begin + WasOpen := Dataset.Active; + + if not WasOpen then + Open; + try + SetDatasetParentRange(Attribute.Owner.ClassName, Attribute.Owner.Id); + First; + AttributeMetadata := Attribute.Metadata; + while not Eof do + begin + ObjDisposed := False; + Obj := AttributeMetadata.ObjectClass.Retrieve( + FieldByName(InstantChildIdFieldName).AsString, + False, False, Attribute.Connector); + try + if Assigned(Obj) and + (Attribute.IndexOf(Obj) = -1) then + begin + Obj.ObjectStore.DisposeObject(Obj, caIgnore); + Delete; + ObjDisposed := True; + end; + finally + Obj.Free; + end; + if not ObjDisposed then + Next; + end; + finally + if not WasOpen then + Close; + end; +end; + +procedure TInstantNavigationalLinkResolver.InternalReadAttributeObjects( + Attribute: TInstantContainer; const AObjectId: string); +var + WasOpen: Boolean; +begin + WasOpen := Dataset.Active; + + if not WasOpen then + Open; + try + // Attribute.Owner.Id can be '', so do not use here. + SetDatasetParentRange(Attribute.Owner.Classname, AObjectId); + First; + while not Eof do + begin + Attribute.AddReference( + FieldByName(InstantChildClassFieldName).AsString, + FieldByName(InstantChildIdFieldName).AsString); + Next; + end; + finally + if not WasOpen then + Close; + end; +end; + +procedure TInstantNavigationalLinkResolver.Next; +begin + DataSet.Next; +end; + +procedure TInstantNavigationalLinkResolver.Open; +begin + DataSet.Open; +end; + +procedure TInstantNavigationalLinkResolver.Post; +begin + DataSet.Post; +end; + +procedure TInstantNavigationalLinkResolver.SetDataSet(Value: TDataset); +begin + if Value <> FDataSet then + begin + FreeDataSet; + FDataSet := Value; + end; +end; + +constructor TInstantLinkResolver.Create(AResolver: TInstantCustomResolver); +begin + inherited Create; + FResolver := AResolver; +end; + +procedure TInstantLinkResolver.StoreAttributeObjects(Attribute: + TInstantContainer); +begin + InternalStoreAttributeObjects(Attribute); +end; + +procedure TInstantLinkResolver.ClearAttributeLinkRecords; +begin + InternalClearAttributeLinkRecords; +end; + +procedure TInstantLinkResolver.DisposeDeletedAttributeObjects(Attribute: + TInstantContainer); +begin + InternalDisposeDeletedAttributeObjects(Attribute); +end; + +function TInstantLinkResolver.GetBroker: TInstantCustomRelationalBroker; +begin + Result := Resolver.Broker; +end; + +function TInstantLinkResolver.GetResolver: TInstantCustomResolver; +begin + Result := FResolver; +end; + +procedure TInstantLinkResolver.InternalStoreAttributeObjects(Attribute: + TInstantContainer); +begin +end; + +procedure TInstantLinkResolver.InternalClearAttributeLinkRecords; +begin +end; + +procedure TInstantLinkResolver.InternalDisposeDeletedAttributeObjects( + Attribute: TInstantContainer); +begin +end; + +procedure TInstantLinkResolver.InternalReadAttributeObjects(Attribute: + TInstantContainer; const AObjectId: string); +begin +end; + +procedure TInstantLinkResolver.ReadAttributeObjects(Attribute: + TInstantContainer; const AObjectId: string); +begin + InternalReadAttributeObjects(Attribute, AObjectId); +end; + +constructor TInstantSQLLinkResolver.Create(AResolver: TInstantSQLResolver; + const ATableName: string; AObject: TInstantObject); +begin + inherited Create(AResolver); + FTableName := ATableName; + FAttributeOwner := AObject; +end; + +function TInstantSQLLinkResolver.GetBroker: TInstantSQLBroker; +begin + Result := Resolver.Broker; +end; + +function TInstantSQLLinkResolver.GetResolver: TInstantSQLResolver; +begin + Result := FResolver as TInstantSQLResolver; +end; + +procedure TInstantSQLLinkResolver.InternalStoreAttributeObjects(Attribute: + TInstantContainer); +var + Params: TParams; + Statement: string; + Obj: TInstantObject; + I: Integer; +begin + // Store all objects and links + for I := 0 to Pred(Attribute.Count) do + begin + // Store object + Obj := Attribute.Items[I]; + Obj.CheckId; + Obj.ObjectStore.StoreObject(Obj, caIgnore); + + // Insert link + Params := TParams.Create; + try + Statement := Format(Resolver.InsertExternalSQL, + [TableName]); + Resolver.AddIdParam(Params, InstantIdFieldName, AttributeOwner.GenerateId); + Resolver.AddStringParam(Params, InstantParentClassFieldName, + AttributeOwner.ClassName); + Resolver.AddIdParam(Params, InstantParentIdFieldName, + AttributeOwner.Id); + Resolver.AddStringParam(Params, InstantChildClassFieldName, + Obj.ClassName); + Resolver.AddIdParam(Params, InstantChildIdFieldName, + Obj.Id); + Resolver.AddIntegerParam(Params, InstantSequenceNoFieldName, Succ(I)); + Broker.Execute(Statement, Params); + finally + Params.Free; + end; + end; +end; + +procedure TInstantSQLLinkResolver.InternalClearAttributeLinkRecords; +var + Params: TParams; + Statement: string; +begin + Params := TParams.Create; + try + Statement := Format(Resolver.DeleteExternalSQL, + [TableName, + InstantParentClassFieldName, + InstantParentIdFieldName]); + Resolver.AddStringParam(Params, InstantParentClassFieldName, + AttributeOwner.ClassName); + Resolver.AddIdParam(Params, InstantParentIdFieldName, + AttributeOwner.Id); + Broker.Execute(Statement, Params); + finally + Params.Free; + end; +end; + +procedure TInstantSQLLinkResolver.InternalDisposeDeletedAttributeObjects( + Attribute: TInstantContainer); +var + Statement: string; + Params: TParams; + Dataset: TDataset; + Obj: TInstantObject; +begin + // Delete all objects + Params := TParams.Create; + try + Statement := Format(Resolver.SelectExternalSQL, [TableName]); + Resolver.AddIdParam(Params, InstantParentIdFieldName, AttributeOwner.Id); + Resolver.AddStringParam(Params, InstantParentClassFieldName, + AttributeOwner.ClassName); + Resolver.AddStringParam(Params, InstantChildClassFieldName, + Attribute.Metadata.ObjectClassName); + DataSet := Broker.AcquireDataSet(Statement, Params); + try + DataSet.Open; + try + while not DataSet.Eof do + begin + Obj := Attribute.Metadata.ObjectClass.Retrieve( + DataSet.FieldByName(InstantChildIdFieldName).AsString, + False, False, Attribute.Connector); + try + if Assigned(Obj) and + (Attribute.IndexOf(Obj) = -1) then + Obj.ObjectStore.DisposeObject(Obj, + caIgnore); + finally + Obj.Free; + end; + DataSet.Next; + end; + finally + DataSet.Close; + end; + finally + Broker.ReleaseDataSet(DataSet); + end; + finally + Params.Free; + end; +end; + +procedure TInstantSQLLinkResolver.InternalReadAttributeObjects(Attribute: + TInstantContainer; const AObjectId: string); +var + Statement: string; + Params: TParams; + Dataset: TDataset; +begin + Params := TParams.Create; + try + Statement := Format(Resolver.SelectExternalSQL, [TableName]); + Resolver.AddIdParam(Params, InstantParentIdFieldName, AObjectId); + Resolver.AddStringParam(Params, InstantParentClassFieldName, + AttributeOwner.ClassName); + Resolver.AddStringParam(Params, InstantChildClassFieldName, + Attribute.Metadata.ObjectClassName); + DataSet := Broker.AcquireDataSet(Statement, Params); + try + DataSet.Open; + try + while not DataSet.Eof do + begin + Attribute.AddReference( + DataSet.FieldByName(InstantChildClassFieldName).AsString, + DataSet.FieldByName(InstantChildIdFieldName).AsString); + DataSet.Next; + end; + finally + DataSet.Close; + end; + finally + Broker.ReleaseDataSet(DataSet); + end; + finally + Params.Free; + end; +end; + + initialization RegisterClasses([TInstantClassMetadatas, TInstantClassMetadata, TInstantAttributeMetadatas, TInstantAttributeMetadata, |
From: <jcm...@us...> - 2006-08-01 23:06:24
|
Revision: 693 Author: jcmoraisjr Date: 2006-08-01 16:06:12 -0700 (Tue, 01 Aug 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=693&view=rev Log Message: ----------- - Fixed bug [1531266] Connector.GenerateId doesn't receive Object; - Removed default parameter value from GenerateId method. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-07-30 15:08:43 UTC (rev 692) +++ trunk/Source/Core/InstantPersistence.pas 2006-08-01 23:06:12 UTC (rev 693) @@ -1496,7 +1496,7 @@ function InternalCreateQuery: TInstantQuery; virtual; function InternalCreateScheme(Model: TInstantModel): TInstantScheme; virtual; abstract; procedure InternalDisconnect; virtual; abstract; - function InternalGenerateId(const AObject: TInstantObject = nil): string; virtual; + function InternalGenerateId(const AObject: TInstantObject): string; virtual; procedure InternalRollbackTransaction; virtual; procedure InternalStartTransaction; virtual; function RemoveTransactedObject(AObject: TInstantObject): Integer; @@ -1516,7 +1516,7 @@ function CreateQuery: TInstantQuery; procedure Disconnect; function EnsureObjectStore(AClass: TInstantObjectClass): TInstantObjectStore; - function GenerateId(const AObject: TInstantObject = nil): string; + function GenerateId(const AObject: TInstantObject): string; class procedure RegisterClass; procedure RegisterClient(Client: TObject); procedure RollbackTransaction; @@ -8605,7 +8605,7 @@ if IsAbandoned then Result := InstantGenerateId else - Result := Connector.GenerateId; + Result := Connector.GenerateId(Self); end; function TInstantObject.GetCaption: string; @@ -9459,7 +9459,7 @@ end; end; -function TInstantConnector.GenerateId(const AObject: TInstantObject = nil): string; +function TInstantConnector.GenerateId(const AObject: TInstantObject): string; begin Result := InternalGenerateId(AObject); end; @@ -9600,7 +9600,7 @@ Result := Broker.CreateQuery; end; -function TInstantConnector.InternalGenerateId(const AObject: TInstantObject = nil): string; +function TInstantConnector.InternalGenerateId(const AObject: TInstantObject): string; begin if Assigned(FOnGenerateId) then begin |
From: <bvs...@us...> - 2006-12-11 01:06:05
|
Revision: 739 http://svn.sourceforge.net/instantobjects/revision/?rev=739&view=rev Author: bvsimmons Date: 2006-12-10 17:06:06 -0800 (Sun, 10 Dec 2006) Log Message: ----------- Updated InstantPersistence.pas to support InstantDate and InstantTime data types. Found a missing change. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-12-11 00:35:04 UTC (rev 738) +++ trunk/Source/Core/InstantPersistence.pas 2006-12-11 01:06:06 UTC (rev 739) @@ -388,7 +388,6 @@ FValue: TDateTime; function DefaultValue: TDateTime; protected - class function AttributeType: TInstantAttributeType; override; function GetAsDateTime: TDateTime; override; function GetAsString: string; override; function GetAsVariant: Variant; override; |
From: <sr...@us...> - 2006-12-24 01:13:43
|
Revision: 746 http://svn.sourceforge.net/instantobjects/revision/?rev=746&view=rev Author: srmitch Date: 2006-12-23 17:13:39 -0800 (Sat, 23 Dec 2006) Log Message: ----------- - Fix for SF Bug #1620637 - TInstantReferences.HasItem(Index) incorrect implementation. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-12-22 05:13:59 UTC (rev 745) +++ trunk/Source/Core/InstantPersistence.pas 2006-12-24 01:13:39 UTC (rev 746) @@ -4975,7 +4975,7 @@ function TInstantReferences.GetInstances(Index: Integer): TInstantObject; begin - Result := ObjectReferenceList[Index]; + Result := RefItems[Index].Instance; end; function TInstantReferences.GetObjectReferenceList: TInstantObjectReferenceList; |
From: <jcm...@us...> - 2007-02-24 19:31:50
|
Revision: 759 http://svn.sourceforge.net/instantobjects/revision/?rev=759&view=rev Author: jcmoraisjr Date: 2007-02-24 11:31:26 -0800 (Sat, 24 Feb 2007) Log Message: ----------- Moving TInstantPart.ObjectReferences property to the protected area to allow optimizations. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2007-02-20 21:44:49 UTC (rev 758) +++ trunk/Source/Core/InstantPersistence.pas 2007-02-24 19:31:26 UTC (rev 759) @@ -660,7 +660,6 @@ function GetObjectReferences(Index: Integer): TInstantObjectReference; procedure SetObjectReferences(Index: Integer; Value: TInstantObjectReference); property ObjectReferenceList: TObjectList read GetObjectReferenceList; - property ObjectReferences[Index: Integer]: TInstantObjectReference read GetObjectReferences write SetObjectReferences; protected class function AttributeType: TInstantAttributeType; override; function GetAllowOwned: Boolean; override; @@ -683,6 +682,7 @@ procedure SetAllowOwned(Value: Boolean); virtual; procedure ValidateObject(AObject: TInstantObject); override; procedure WriteObject(Writer: TInstantWriter); override; + property ObjectReferences[Index: Integer]: TInstantObjectReference read GetObjectReferences write SetObjectReferences; public destructor Destroy; override; procedure Assign(Source: TPersistent); override; |
From: <jcm...@us...> - 2007-02-24 19:35:00
|
Revision: 760 http://svn.sourceforge.net/instantobjects/revision/?rev=760&view=rev Author: jcmoraisjr Date: 2007-02-24 11:35:00 -0800 (Sat, 24 Feb 2007) Log Message: ----------- Small fpc-compatibility optimization. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2007-02-24 19:31:26 UTC (rev 759) +++ trunk/Source/Core/InstantPersistence.pas 2007-02-24 19:35:00 UTC (rev 760) @@ -901,11 +901,7 @@ procedure Changed; virtual; function ChangesDisabled: Boolean; procedure CheckId; -{$IFDEF FPC} - class function ClassType: TInstantObjectClass; -{$ELSE} - function ClassType: TInstantObjectClass; -{$ENDIF} + {$IFDEF FPC}class{$ENDIF} function ClassType: TInstantObjectClass; procedure ClearObjects; function Clone(AConnector: TInstantConnector = nil): TInstantObject; overload; function ContainerByName(const ContainerName: string): TInstantContainer; @@ -5412,11 +5408,7 @@ end; end; -{$IFDEF FPC} -class function TInstantObject.ClassType: TInstantObjectClass; -{$ELSE} -function TInstantObject.ClassType: TInstantObjectClass; -{$ENDIF} +{$IFDEF FPC}class{$ENDIF} function TInstantObject.ClassType: TInstantObjectClass; begin Result := TInstantObjectClass(inherited ClassType); end; |
From: <jcm...@us...> - 2007-02-24 23:45:10
|
Revision: 765 http://svn.sourceforge.net/instantobjects/revision/?rev=765&view=rev Author: jcmoraisjr Date: 2007-02-24 15:45:06 -0800 (Sat, 24 Feb 2007) Log Message: ----------- Fixed bug #1668108. Modified Paths: -------------- trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2007-02-24 20:08:53 UTC (rev 764) +++ trunk/Source/Core/InstantPersistence.pas 2007-02-24 23:45:06 UTC (rev 765) @@ -4227,7 +4227,7 @@ if Assigned(Metadata) and (Metadata.StorageKind = skEmbedded) then raise EInstantError.CreateFmt(SUnsupportedAttributeOperation, ['AddReference', ClassName, Name, 'StorageKind = skEmbedded']); - if RequiredClassName <> AObjectClassName then + if not InstantFindClass(AObjectClassName).InheritsFrom(RequiredClass) then raise EInstantValidationError.CreateFmt(SInvalidObjectClass, [AObjectClassName, ClassName, Name, RequiredClass.ClassName]); |