paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-23 19:28:48 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazUtils: Extending TRefCountedObject

Browse Source 
git-svn-id: trunk@43656 -
This commit is contained in:
martin 2014-01-06 14:34:14 +00:00
parent 229d28ca58
commit 4dac3a41c9
1 changed files with 78 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
components/lazutils/lazclasses.pas
View File

@ -26,14 +26,20 @@ type
TRefCountedObject = class(TFreeNotifyingObject) TRefCountedObject = class(TFreeNotifyingObject)
private private
FRefCount: Integer; FRefCount: Integer;
{$IFDEF WITH_REFCOUNT_DEBUG}
FDebugList: TStringList;
FInDestroy: Boolean;
{$ENDIF}
protected protected
procedure DoFree; virtual; procedure DoFree; virtual;
procedure DoReferenceAdded; virtual;
procedure DoReferenceReleased; virtual;
property RefCount: Integer read FRefCount; property RefCount: Integer read FRefCount;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
procedure AddReference; procedure AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr: Pointer = nil; DebugIdTxt: String = ''){$ENDIF};
procedure ReleaseReference; procedure ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr: Pointer = nil; DebugIdTxt: String = ''){$ENDIF};
end; end;
{ TRefCntObjList } { TRefCntObjList }
@ -47,6 +53,9 @@ type
procedure ReleaseRefAndNil(var ARefCountedObject); procedure ReleaseRefAndNil(var ARefCountedObject);
implementation implementation
{$IFDEF WITH_REFCOUNT_DEBUG}
uses LazLoggerBase;
{$ENDIF}
{ TFreeNotifyingObject } { TFreeNotifyingObject }
@ -75,33 +84,97 @@ end;
{ TRefCountedObject } { TRefCountedObject }
procedure TRefCountedObject.AddReference; procedure TRefCountedObject.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr: Pointer = nil; DebugIdTxt: String = ''){$ENDIF};
{$IFDEF WITH_REFCOUNT_DEBUG}
var
s: String;
{$ENDIF}
begin begin
{$IFDEF WITH_REFCOUNT_DEBUG}
if FDebugList = nil then FDebugList := TStringList.Create;
if (DebugIdAdr <> nil) or (DebugIdTxt <> '') then
s := inttostr(PtrUInt(DebugIdAdr))+': '+DebugIdTxt
else
s := 'not named';
if FDebugList.indexOf(s) < 0 then
FDebugList.AddObject(s, TObject(1))
else begin
if s <> 'not named' then
debugln(['TRefCountedObject.AddReference Duplicate ref ', s]);
FDebugList.Objects[FDebugList.IndexOf(s)] :=
TObject(PtrUint(FDebugList.Objects[FDebugList.IndexOf(s)])+1);
end;
{$ENDIF}
Inc(FRefcount); Inc(FRefcount);
// call only if overridden
If TMethod(@DoReferenceAdded).Code <> Pointer(@TRefCountedObject.DoReferenceAdded) then
DoReferenceAdded;
end; end;
procedure TRefCountedObject.DoFree; procedure TRefCountedObject.DoFree;
begin begin
{$IFDEF WITH_REFCOUNT_DEBUG}
Assert(not FInDestroy, 'TRefCountedObject.DoFree: Double destroy');
FInDestroy := True;
{$ENDIF}
Self.Free; Self.Free;
end; end;
procedure TRefCountedObject.DoReferenceAdded;
begin
//
end;
procedure TRefCountedObject.DoReferenceReleased;
begin
//
end;
constructor TRefCountedObject.Create; constructor TRefCountedObject.Create;
begin begin
FRefCount := 0; FRefCount := 0;
{$IFDEF WITH_REFCOUNT_DEBUG}
if FDebugList = nil then
FDebugList := TStringList.Create;
{$ENDIF}
inherited; inherited;
end; end;
destructor TRefCountedObject.Destroy; destructor TRefCountedObject.Destroy;
begin begin
{$IFDEF WITH_REFCOUNT_DEBUG}
FDebugList.Free;
{$ENDIF}
Assert(FRefcount = 0, 'Destroying referenced object'); Assert(FRefcount = 0, 'Destroying referenced object');
inherited; inherited;
end; end;
procedure TRefCountedObject.ReleaseReference; procedure TRefCountedObject.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr: Pointer = nil; DebugIdTxt: String = ''){$ENDIF};
{$IFDEF WITH_REFCOUNT_DEBUG}
var
s: String;
{$ENDIF}
begin begin
if Self = nil then exit; if Self = nil then exit;
{$IFDEF WITH_REFCOUNT_DEBUG}
if FDebugList = nil then FDebugList := TStringList.Create;
if (DebugIdAdr <> nil) or (DebugIdTxt <> '') then
s := inttostr(PtrUInt(DebugIdAdr))+': '+DebugIdTxt
else
s := 'not named';
assert(FDebugList.indexOf(s) >= 0, 'Has reference (entry) for '+s);
assert(PtrUint(FDebugList.Objects[FDebugList.IndexOf(s)]) > 0, 'Has reference (> 0) for '+s);
if PtrUint(FDebugList.Objects[FDebugList.IndexOf(s)]) = 1 then
FDebugList.Delete(FDebugList.IndexOf(s))
else
FDebugList.Objects[FDebugList.IndexOf(s)] :=
TObject(PtrInt(FDebugList.Objects[FDebugList.IndexOf(s)])-1);
{$ENDIF}
Assert(FRefCount > 0, 'TRefCountedObject.ReleaseReference RefCount > 0'); Assert(FRefCount > 0, 'TRefCountedObject.ReleaseReference RefCount > 0');
Dec(FRefCount); Dec(FRefCount);
// call only if overridden
If TMethod(@DoReferenceReleased).Code <> Pointer(@TRefCountedObject.DoReferenceReleased) then
DoReferenceReleased;
if FRefCount = 0 then DoFree; if FRefCount = 0 then DoFree;
end; end;
@ -130,5 +203,5 @@ begin
Pointer(ARefCountedObject) := nil; Pointer(ARefCountedObject) := nil;
end; end;
end. end .