mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-05 03:39:13 +01:00
LeakView: Find repeated addresses, and complete line info from previous entry
git-svn-id: trunk@37434 -
This commit is contained in:
martin
parent
daf53bbb89
commit
6065637900
@ -9,14 +9,14 @@ object HeapTrcViewForm: THeapTrcViewForm
|
||||
FormStyle = fsStayOnTop
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
LCLVersion = '0.9.29'
|
||||
LCLVersion = '1.1'
|
||||
object lblTrcFile: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 6
|
||||
Height = 18
|
||||
Height = 16
|
||||
Top = 9
|
||||
Width = 45
|
||||
Width = 37
|
||||
BorderSpacing.Left = 6
|
||||
Caption = '.trc file'
|
||||
ParentColor = False
|
||||
@ -25,9 +25,9 @@ object HeapTrcViewForm: THeapTrcViewForm
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 20
|
||||
Height = 25
|
||||
Top = 40
|
||||
Width = 70
|
||||
Width = 64
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 12
|
||||
@ -40,10 +40,10 @@ object HeapTrcViewForm: THeapTrcViewForm
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 591
|
||||
Height = 18
|
||||
Top = 41
|
||||
Width = 92
|
||||
Left = 603
|
||||
Height = 19
|
||||
Top = 43
|
||||
Width = 80
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 6
|
||||
Caption = 'Stay on top'
|
||||
@ -67,10 +67,10 @@ object HeapTrcViewForm: THeapTrcViewForm
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = btnUpdate
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 211
|
||||
Height = 18
|
||||
Top = 41
|
||||
Width = 107
|
||||
Left = 191
|
||||
Height = 19
|
||||
Top = 43
|
||||
Width = 92
|
||||
BorderSpacing.Left = 6
|
||||
Caption = 'Raw leak data'
|
||||
Checked = True
|
||||
@ -87,24 +87,24 @@ object HeapTrcViewForm: THeapTrcViewForm
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 444
|
||||
Top = 66
|
||||
Height = 439
|
||||
Top = 71
|
||||
Width = 677
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Around = 6
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 444
|
||||
ClientHeight = 439
|
||||
ClientWidth = 677
|
||||
TabOrder = 4
|
||||
object trvTraceInfo: TTreeView
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 352
|
||||
Height = 347
|
||||
Top = 6
|
||||
Width = 677
|
||||
Align = alClient
|
||||
BorderSpacing.Top = 6
|
||||
DefaultItemHeight = 19
|
||||
DefaultItemHeight = 18
|
||||
ReadOnly = True
|
||||
TabOrder = 0
|
||||
OnDblClick = trvTraceInfoDblClick
|
||||
@ -113,7 +113,7 @@ object HeapTrcViewForm: THeapTrcViewForm
|
||||
object memoSummary: TMemo
|
||||
Left = 0
|
||||
Height = 81
|
||||
Top = 363
|
||||
Top = 358
|
||||
Width = 677
|
||||
Align = alBottom
|
||||
ReadOnly = True
|
||||
@ -124,7 +124,7 @@ object HeapTrcViewForm: THeapTrcViewForm
|
||||
Cursor = crVSplit
|
||||
Left = 0
|
||||
Height = 5
|
||||
Top = 358
|
||||
Top = 353
|
||||
Width = 677
|
||||
Align = alBottom
|
||||
ResizeAnchor = akBottom
|
||||
@ -134,10 +134,10 @@ object HeapTrcViewForm: THeapTrcViewForm
|
||||
AnchorSideLeft.Control = btnUpdate
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = btnUpdate
|
||||
Left = 82
|
||||
Height = 20
|
||||
Left = 76
|
||||
Height = 25
|
||||
Top = 40
|
||||
Width = 123
|
||||
Width = 109
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 6
|
||||
Caption = 'Paste Clipboard'
|
||||
@ -148,14 +148,14 @@ object HeapTrcViewForm: THeapTrcViewForm
|
||||
AnchorSideLeft.Control = lblTrcFile
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideRight.Control = btnBrowse
|
||||
Left = 57
|
||||
Height = 21
|
||||
Left = 49
|
||||
Height = 23
|
||||
Top = 8
|
||||
Width = 582
|
||||
Width = 590
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Right = 6
|
||||
ItemHeight = 0
|
||||
ItemHeight = 15
|
||||
TabOrder = 6
|
||||
end
|
||||
end
|
||||
|
||||
@ -223,10 +223,10 @@ var
|
||||
i : integer;
|
||||
sz : Integer;
|
||||
begin
|
||||
sz := 16 + trace.LinesCount * 16; // 8 hex digits for Size + 8 hex digits for Size
|
||||
sz := 16 + trace.Count * 16; // 8 hex digits for Size + 8 hex digits for Size
|
||||
SetLength(Result, sz);
|
||||
HexInt64ToStr(trace.BlockSize, Result, 1);
|
||||
for i := 0 to trace.LinesCount - 1 do
|
||||
for i := 0 to trace.Count - 1 do
|
||||
HexInt64ToStr(trace.lines[i].Addr, Result, 17 + i * 16);
|
||||
end;
|
||||
|
||||
@ -260,7 +260,7 @@ begin
|
||||
for i := 0 to fItems.Count - 1 do begin
|
||||
trace := TStackTrace(fItems[i]);
|
||||
nd := trvTraceInfo.Items.AddChildObject(nil, '+', trace);
|
||||
for j := 0 to trace.LinesCount - 1 do begin
|
||||
for j := 0 to trace.Count - 1 do begin
|
||||
trvTraceInfo.Items.AddChildObject(nd, '-', Pointer(j));
|
||||
end;
|
||||
end;
|
||||
@ -337,7 +337,7 @@ begin
|
||||
|
||||
idx := Integer(nd.Data);
|
||||
trace := TStackTrace(nd.Parent.Data);
|
||||
if not Assigned(trace) or (idx >= trace.LinesCount) then Exit;
|
||||
if not Assigned(trace) or (idx >= trace.Count) then Exit;
|
||||
|
||||
searchFile := trace.Lines[idx].FileName;
|
||||
if searchFile = '' then Exit;
|
||||
|
||||
@ -5,24 +5,42 @@ unit leakinfo;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil;
|
||||
Classes, SysUtils, FileUtil, LazClasses;
|
||||
|
||||
type
|
||||
{ TStackLine }
|
||||
|
||||
TStackLine = record
|
||||
TStackLine = class(TRefCountedObject)
|
||||
LineNum : Integer; // -1 is line is uknown
|
||||
FileName : string; // should be empty if file is unknown
|
||||
Addr : Int64; // -1 if address is unknown
|
||||
RawLineData: string;
|
||||
function Equals(ALine: TStackLine): boolean; reintroduce;
|
||||
procedure Assign(ALine: TStackLine);
|
||||
end;
|
||||
|
||||
{ TStackLines }
|
||||
|
||||
TStackLines = class(TObject)
|
||||
private
|
||||
FLines: TRefCntObjList;
|
||||
function GetLine(Index: Integer): TStackLine;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function Count: Integer;
|
||||
procedure Clear;
|
||||
function Add(ALine: TStackLine): Integer;
|
||||
function IndexOfAddr(AnAddr: Int64): Integer;
|
||||
function FindAddr(AnAddr: Int64): TStackLine;
|
||||
procedure CopyLineInfoByAddr(AnOtherLines: TStackLines);
|
||||
property Lines[Index: Integer]: TStackLine read GetLine;
|
||||
end;
|
||||
|
||||
{ TStackTrace }
|
||||
|
||||
TStackTrace = class(TObject)
|
||||
TStackTrace = class(TStackLines)
|
||||
public
|
||||
Lines : array of TStackLine;
|
||||
LinesCount : integer;
|
||||
BlockSize : integer;
|
||||
Addr : Int64;
|
||||
LeakCount : Integer;
|
||||
@ -76,6 +94,7 @@ type
|
||||
Trc : TStringList;
|
||||
TrcIndex : integer;
|
||||
fSummary : string;
|
||||
FKnownAddresses: TStackLines;
|
||||
|
||||
fParsed : Boolean;
|
||||
|
||||
@ -92,6 +111,7 @@ type
|
||||
TraceInfo : THeapTraceInfo;
|
||||
constructor Create(const ATRCFile: string);
|
||||
constructor CreateFromTxt(const AText: string);
|
||||
destructor Destroy; override;
|
||||
function GetLeakInfo(var LeakData: TLeakStatus; var Traces: TList): Boolean; override;
|
||||
end;
|
||||
|
||||
@ -226,7 +246,24 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TStackLine }
|
||||
|
||||
function TStackLine.Equals(ALine: TStackLine): boolean;
|
||||
begin
|
||||
Result :=
|
||||
(LineNum = ALine.LineNum) and
|
||||
(FileName = ALine.FileName) and
|
||||
(Addr = ALine.Addr) and
|
||||
(RawLineData = ALine.RawLineData);
|
||||
end;
|
||||
|
||||
procedure TStackLine.Assign(ALine: TStackLine);
|
||||
begin
|
||||
LineNum := ALine.LineNum;
|
||||
FileName := ALine.FileName;
|
||||
Addr := ALine.Addr;
|
||||
RawLineData := ALine.RawLineData;
|
||||
end;
|
||||
|
||||
{ THeapTrcInfo }
|
||||
|
||||
@ -336,6 +373,7 @@ end;
|
||||
|
||||
constructor THeapTrcInfo.Create(const ATRCFile: string);
|
||||
begin
|
||||
FKnownAddresses := TStackLines.Create;
|
||||
fTrcFile := ATrcFile;
|
||||
fTRCText := '';
|
||||
inherited Create;
|
||||
@ -343,14 +381,22 @@ end;
|
||||
|
||||
constructor THeapTrcInfo.CreateFromTxt(const AText: string);
|
||||
begin
|
||||
FKnownAddresses := TStackLines.Create;
|
||||
fTRCText := AText;
|
||||
end;
|
||||
|
||||
destructor THeapTrcInfo.Destroy;
|
||||
begin
|
||||
FreeAndNil(FKnownAddresses);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure THeapTrcInfo.ParseStackTrace(trace: TStackTrace);
|
||||
var
|
||||
i : integer;
|
||||
err : integer;
|
||||
hex : string;
|
||||
NewLine: TStackLine;
|
||||
begin
|
||||
i := Pos(RawTracePrefix, Trc[TrcIndex]);
|
||||
if (i <= 0) and not IsTraceLine(Trc[TrcIndex]) then begin
|
||||
@ -374,21 +420,28 @@ begin
|
||||
while (TrcIndex < Trc.Count) and (Pos(CallTracePrefix, Trc[TrcIndex]) = 0) and
|
||||
(Pos(RawTracePrefix, Trc[TrcIndex]) = 0)
|
||||
do begin
|
||||
if trace.LinesCount = length(trace.Lines) then begin
|
||||
if trace.LinesCount = 0 then SetLength(trace.Lines, 4)
|
||||
else SetLength(trace.Lines, trace.LinesCount * 2);
|
||||
end;
|
||||
ParseTraceLine(Trc[Trcindex], trace.Lines[trace.LinesCount]);
|
||||
trace.Lines[trace.LinesCount].RawLineData := Trc[Trcindex]; // raw stack line data
|
||||
inc(trace.LinesCount);
|
||||
NewLine := TStackLine.Create; // No reference
|
||||
trace.Add(NewLine);
|
||||
ParseTraceLine(Trc[Trcindex], NewLine);
|
||||
NewLine.RawLineData := Trc[Trcindex]; // raw stack line data
|
||||
inc(Trcindex);
|
||||
|
||||
if (NewLine.FileName <> '') then begin
|
||||
i := FKnownAddresses.IndexOfAddr(NewLine.Addr);
|
||||
// Todo: compare addr, to detect inconsistencies
|
||||
if i < 0 then
|
||||
FKnownAddresses.Add(NewLine);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function THeapTrcInfo.GetLeakInfo(var LeakData: TLeakStatus; var Traces: TList): Boolean;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := false;
|
||||
FKnownAddresses.Clear;
|
||||
if (not FileExistsUTF8(fTRCFile)) and (fTRCText = '') then
|
||||
Exit;
|
||||
try
|
||||
@ -409,18 +462,90 @@ begin
|
||||
Trc.Free;
|
||||
Trc := nil;
|
||||
end;
|
||||
|
||||
for i := 0 to Traces.Count - 1 do
|
||||
TStackTrace(Traces[i]).CopyLineInfoByAddr(FKnownAddresses);
|
||||
except
|
||||
Result := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TStackLines }
|
||||
|
||||
function TStackLines.GetLine(Index: Integer): TStackLine;
|
||||
begin
|
||||
Result := TStackLine(FLines[Index]);
|
||||
end;
|
||||
|
||||
constructor TStackLines.Create;
|
||||
begin
|
||||
FLines := TRefCntObjList.Create;
|
||||
end;
|
||||
|
||||
destructor TStackLines.Destroy;
|
||||
begin
|
||||
FLines.Clear;
|
||||
FreeAndNil(FLines);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TStackLines.Count: Integer;
|
||||
begin
|
||||
Result := FLines.Count;
|
||||
end;
|
||||
|
||||
procedure TStackLines.Clear;
|
||||
begin
|
||||
FLines.Clear;
|
||||
end;
|
||||
|
||||
function TStackLines.Add(ALine: TStackLine): Integer;
|
||||
begin
|
||||
Result := FLines.Add(ALine);
|
||||
end;
|
||||
|
||||
function TStackLines.IndexOfAddr(AnAddr: Int64): Integer;
|
||||
begin
|
||||
Result := Count - 1;
|
||||
while (Result >= 0) and (Lines[Result].Addr <> AnAddr) do
|
||||
dec(Result);
|
||||
end;
|
||||
|
||||
function TStackLines.FindAddr(AnAddr: Int64): TStackLine;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
i := IndexOfAddr(AnAddr);
|
||||
if i < 0 then
|
||||
Result := nil
|
||||
else
|
||||
Result := Lines[i];
|
||||
end;
|
||||
|
||||
procedure TStackLines.CopyLineInfoByAddr(AnOtherLines: TStackLines);
|
||||
var
|
||||
i, j: Integer;
|
||||
CurLine: TStackLine;
|
||||
begin
|
||||
for i := 0 to Count - 1 do begin
|
||||
CurLine := Lines[i];
|
||||
if (CurLine.FileName = '') then begin
|
||||
j := AnOtherLines.IndexOfAddr(CurLine.Addr);
|
||||
if J >= 0 then
|
||||
CurLine.Assign(AnOtherLines.Lines[j]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TStackTrace }
|
||||
|
||||
constructor TStackTrace.Create;
|
||||
begin
|
||||
LeakCount := 1;
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user