LeakView: Allow paste from clipboard; Allow parsing exception trace too

git-svn-id: trunk@24014 -
2025-08-15 23:59:12 +02:00 · 2010-03-15 17:46:15 +00:00 · 2010-03-15 17:46:15 +00:00 · 48c1748e02
commit 48c1748e02
parent 4ccc80843d
4 changed files with 117 additions and 56 deletions
--- a/components/leakview/heaptrcview.lfm
+++ b/components/leakview/heaptrcview.lfm
@ -13,15 +13,15 @@ object HeapTrcViewForm: THeapTrcViewForm
  LCLVersion = '0.9.29'
  object lblTrcFile: TLabel
    Left = 16
-    Height = 18
+    Height = 16
    Top = 16
-    Width = 45
+    Width = 37
    Caption = '.trc file'
    ParentColor = False
  end
  object edtTrcFileName: TEdit
    Left = 72
-    Height = 22
+    Height = 23
    Top = 16
    Width = 311
    Anchors = [akTop, akLeft, akRight]
@ -29,19 +29,19 @@ object HeapTrcViewForm: THeapTrcViewForm
  end
  object btnUpdate: TButton
    Left = 16
-    Height = 20
+    Height = 25
    Top = 54
-    Width = 70
+    Width = 64
    AutoSize = True
    Caption = 'Update'
    OnClick = btnUpdateClick
    TabOrder = 1
  end
  object chkStayOnTop: TCheckBox
-    Left = 335
-    Height = 18
+    Left = 347
+    Height = 19
    Top = 56
-    Width = 92
+    Width = 80
    Anchors = [akTop, akRight]
    Caption = 'Stay on top'
    OnChange = chkStayOnTopChange
@ -59,10 +59,10 @@ object HeapTrcViewForm: THeapTrcViewForm
    TabOrder = 3
  end
  object chkUseRaw: TCheckBox
-    Left = 99
-    Height = 18
+    Left = 240
+    Height = 19
    Top = 56
-    Width = 107
+    Width = 92
    Caption = 'Raw leak data'
    Checked = True
    OnChange = chkUseRawChange
@ -85,7 +85,7 @@ object HeapTrcViewForm: THeapTrcViewForm
      Top = 0
      Width = 415
      Align = alClient
-      DefaultItemHeight = 19
+      DefaultItemHeight = 17
      ReadOnly = True
      TabOrder = 0
      OnDblClick = trvTraceInfoDblClick
@ -111,4 +111,14 @@ object HeapTrcViewForm: THeapTrcViewForm
      ResizeAnchor = akBottom
    end
  end
+  object btnClipboard: TButton
+    Left = 104
+    Height = 25
+    Top = 54
+    Width = 109
+    AutoSize = True
+    Caption = 'Paste Clipboard'
+    OnClick = btnClipboardClick
+    TabOrder = 6
+  end
 end
--- a/components/leakview/heaptrcview.lrs
+++ b/components/leakview/heaptrcview.lrs
@ -6,31 +6,33 @@ LazarusResources.Add('THeapTrcViewForm','FORMDATA',[
  +'ption'#6#15'HeapTrcViewForm'#12'ClientHeight'#3#146#1#11'ClientWidth'#3#191
  +#1#9'FormStyle'#7#11'fsStayOnTop'#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7
  +#11'FormDestroy'#10'LCLVersion'#6#6'0.9.29'#0#6'TLabel'#10'lblTrcFile'#4'Lef'
-  +'t'#2#16#6'Height'#2#18#3'Top'#2#16#5'Width'#2'-'#7'Caption'#6#9'.trc file'
+  +'t'#2#16#6'Height'#2#16#3'Top'#2#16#5'Width'#2'%'#7'Caption'#6#9'.trc file'
  +#11'ParentColor'#8#0#0#5'TEdit'#14'edtTrcFileName'#4'Left'#2'H'#6'Height'#2
-  +#22#3'Top'#2#16#5'Width'#3'7'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0
-  +#8'TabOrder'#2#0#0#0#7'TButton'#9'btnUpdate'#4'Left'#2#16#6'Height'#2#20#3'T'
-  +'op'#2'6'#5'Width'#2'F'#8'AutoSize'#9#7'Caption'#6#6'Update'#7'OnClick'#7#14
+  +#23#3'Top'#2#16#5'Width'#3'7'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0
+  +#8'TabOrder'#2#0#0#0#7'TButton'#9'btnUpdate'#4'Left'#2#16#6'Height'#2#25#3'T'
+  +'op'#2'6'#5'Width'#2'@'#8'AutoSize'#9#7'Caption'#6#6'Update'#7'OnClick'#7#14
  +'btnUpdateClick'#8'TabOrder'#2#1#0#0#9'TCheckBox'#12'chkStayOnTop'#4'Left'#3
-  +'O'#1#6'Height'#2#18#3'Top'#2'8'#5'Width'#2'\'#7'Anchors'#11#5'akTop'#7'akRi'
+  +'['#1#6'Height'#2#19#3'Top'#2'8'#5'Width'#2'P'#7'Anchors'#11#5'akTop'#7'akRi'
  +'ght'#0#7'Caption'#6#11'Stay on top'#8'OnChange'#7#18'chkStayOnTopChange'#7
  +'OnClick'#7#17'chkStayOnTopClick'#8'TabOrder'#2#2#0#0#7'TButton'#9'btnBrowse'
  +#4'Left'#3#143#1#6'Height'#2#20#3'Top'#2#14#5'Width'#2' '#7'Anchors'#11#5'ak'
  +'Top'#7'akRight'#0#7'Caption'#6#3'...'#7'OnClick'#7#14'btnBrowseClick'#8'Tab'
-  +'Order'#2#3#0#0#9'TCheckBox'#9'chkUseRaw'#4'Left'#2'c'#6'Height'#2#18#3'Top'
-  +#2'8'#5'Width'#2'k'#7'Caption'#6#13'Raw leak data'#7'Checked'#9#8'OnChange'#7
-  +#15'chkUseRawChange'#5'State'#7#9'cbChecked'#8'TabOrder'#2#4#0#0#6'TPanel'#9
-  +'ctrlPanel'#4'Left'#2#16#6'Height'#3#27#1#3'Top'#2'`'#5'Width'#3#159#1#7'Anc'
-  +'hors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#10'BevelOuter'#7#6'bvN'
-  +'one'#12'ClientHeight'#3#27#1#11'ClientWidth'#3#159#1#8'TabOrder'#2#5#0#9'TT'
-  +'reeView'#12'trvTraceInfo'#4'Left'#2#0#6'Height'#3#197#0#3'Top'#2#0#5'Width'
-  +#3#159#1#5'Align'#7#8'alClient'#17'DefaultItemHeight'#2#19#8'ReadOnly'#9#8'T'
-  +'abOrder'#2#0#10'OnDblClick'#7#20'trvTraceInfoDblClick'#7'Options'#11#17'tvo'
-  +'AutoItemHeight'#16'tvoHideSelection'#21'tvoKeepCollapsedNodes'#11'tvoReadOn'
-  +'ly'#14'tvoShowButtons'#12'tvoShowLines'#11'tvoShowRoot'#11'tvoToolTips'#0#0
+  +'Order'#2#3#0#0#9'TCheckBox'#9'chkUseRaw'#4'Left'#3#240#0#6'Height'#2#19#3'T'
+  +'op'#2'8'#5'Width'#2'\'#7'Caption'#6#13'Raw leak data'#7'Checked'#9#8'OnChan'
+  +'ge'#7#15'chkUseRawChange'#5'State'#7#9'cbChecked'#8'TabOrder'#2#4#0#0#6'TPa'
+  +'nel'#9'ctrlPanel'#4'Left'#2#16#6'Height'#3#27#1#3'Top'#2'`'#5'Width'#3#159#1
+  +#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#10'BevelOuter'#7#6
+  +'bvNone'#12'ClientHeight'#3#27#1#11'ClientWidth'#3#159#1#8'TabOrder'#2#5#0#9
+  +'TTreeView'#12'trvTraceInfo'#4'Left'#2#0#6'Height'#3#197#0#3'Top'#2#0#5'Widt'
+  +'h'#3#159#1#5'Align'#7#8'alClient'#17'DefaultItemHeight'#2#17#8'ReadOnly'#9#8
+  +'TabOrder'#2#0#10'OnDblClick'#7#20'trvTraceInfoDblClick'#7'Options'#11#17'tv'
+  +'oAutoItemHeight'#16'tvoHideSelection'#21'tvoKeepCollapsedNodes'#11'tvoReadO'
+  +'nly'#14'tvoShowButtons'#12'tvoShowLines'#11'tvoShowRoot'#11'tvoToolTips'#0#0
  +#0#5'TMemo'#11'memoSummary'#4'Left'#2#0#6'Height'#2'Q'#3'Top'#3#202#0#5'Widt'
  +'h'#3#159#1#5'Align'#7#8'alBottom'#8'ReadOnly'#9#10'ScrollBars'#7#10'ssVerti'
  +'cal'#8'TabOrder'#2#1#0#0#9'TSplitter'#8'splitter'#6'Cursor'#7#8'crVSplit'#4
  +'Left'#2#0#6'Height'#2#5#3'Top'#3#197#0#5'Width'#3#159#1#5'Align'#7#8'alBott'
-  +'om'#12'ResizeAnchor'#7#8'akBottom'#0#0#0#0
+  +'om'#12'ResizeAnchor'#7#8'akBottom'#0#0#0#7'TButton'#12'btnClipboard'#4'Left'
+  +#2'h'#6'Height'#2#25#3'Top'#2'6'#5'Width'#2'm'#8'AutoSize'#9#7'Caption'#6#15
+  +'Paste Clipboard'#7'OnClick'#7#17'btnClipboardClick'#8'TabOrder'#2#6#0#0#0
 ]);
--- a/components/leakview/heaptrcview.pas
+++ b/components/leakview/heaptrcview.pas
@ -6,7 +6,7 @@ interface

 uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
-  StdCtrls, ComCtrls, ExtCtrls, LeakInfo, LazIDEIntf, MenuIntf, contnrs;
+  StdCtrls, ComCtrls, ExtCtrls, LeakInfo, LazIDEIntf, MenuIntf, contnrs, Clipbrd;

 type
  TJumpProc = procedure (Sender: TObject; const SourceName: string; Line: integer) of object;
@ -15,6 +15,7 @@ type
  THeapTrcViewForm = class(TForm)
    btnUpdate: TButton;
    btnBrowse: TButton;
+    btnClipboard: TButton;
    chkUseRaw: TCheckBox;
    chkStayOnTop: TCheckBox;
    edtTrcFileName: TEdit;
@ -23,6 +24,7 @@ type
    memoSummary: TMemo;
    splitter: TSplitter;
    trvTraceInfo: TTreeView;
+    procedure btnClipboardClick(Sender: TObject);
    procedure btnUpdateClick(Sender: TObject);
    procedure btnBrowseClick(Sender: TObject);
    procedure chkStayOnTopChange(Sender: TObject);
@ -35,7 +37,7 @@ type
    { private declarations }
    fItems  : TList;

-    procedure DoUpdateLeaks;
+    procedure DoUpdateLeaks(FromClip: Boolean = False);

    procedure ItemsToTree;
    procedure ChangeTreeText;
@ -93,6 +95,11 @@ begin
  DoUpdateLeaks;
 end;

+procedure THeapTrcViewForm.btnClipboardClick(Sender: TObject);
+begin
+  DoUpdateLeaks(True);
+end;
+
 procedure THeapTrcViewForm.btnBrowseClick(Sender: TObject);
 var
  OpenDialog : TOpenDialog;
@ -222,18 +229,25 @@ begin
  fItems.Clear;
 end;

-procedure THeapTrcViewForm.DoUpdateLeaks;
+procedure THeapTrcViewForm.DoUpdateLeaks(FromClip: Boolean = False);
 var
  info  : TLeakInfo;
  data  : TLeakStatus;
+  txt: String;
 begin
  trvTraceInfo.BeginUpdate;
  try
    ClearItems;
    trvTraceInfo.Items.Clear;
-    if not FileExistsUTF8(edtTrcFileName.Text) then Exit;
+    if FromClip then begin
+      txt := Clipboard.AsText;
+      if txt = '' then exit;
+      info := AllocHeapTraceInfoFromText(txt);
+    end else begin
+      if (not FileExistsUTF8(edtTrcFileName.Text)) or FromClip then Exit;
+      info := AllocHeapTraceInfo(edtTrcFileName.Text);
+    end;

-    info := AllocHeapTraceInfo(edtTrcFileName.Text);
    try
      if info.GetLeakInfo(data, fItems) then ItemsToTree
      else trvTraceInfo.Items.Add(nil, 'Error while parsing trace file');
--- a/components/leakview/leakinfo.pas
+++ b/components/leakview/leakinfo.pas
@ -72,6 +72,7 @@ type
  THeapTrcInfo = class(TLeakInfo)
  protected
    fTRCFile  : string;
+    fTRCText  : string;
    Trc       : TStringList;
    TrcIndex  : integer;
    fSummary  : string;
@ -89,10 +90,12 @@ type
  public
    TraceInfo : THeapTraceInfo;
    constructor Create(const ATRCFile: string);
+    constructor CreateFromTxt(const AText: string);
    function GetLeakInfo(var LeakData: TLeakStatus; var Traces: TList): Boolean; override;
  end;

 function AllocHeapTraceInfo(const TrcFile: string): TLeakInfo;
+function AllocHeapTraceInfoFromText(const TrcText: string): TLeakInfo;

 implementation

@ -101,6 +104,11 @@ begin
  Result := THeapTrcInfo.Create(TrcFile);
 end;

+function AllocHeapTraceInfoFromText(const TrcText: string): TLeakInfo;
+begin
+  Result := THeapTrcInfo.CreateFromTxt(TrcText);
+end;
+
 // heap trace parsing implementation

 const
@ -261,24 +269,35 @@ begin
  ClearTraceInfo(TraceInfo);
  if TrcIndex >= Trc.COunt then Exit;
  TraceInfo.ExeName := Trc[TrcIndex];
-  inc(TrcIndex);

-  while (TrcIndex < Trc.Count) and (not PosInTrc('Heap dump')) do
+  while (TrcIndex < Trc.Count)
+    and (not (PosInTrc('Heap dump') or  PosInTrc('Stack trace:') or PosInTrc(CallTracePrefix)) )
+  do
    inc(TrcIndex);

  if TrcIndex >= Trc.Count then Exit;
-  inc(TrcIndex);

-  with TraceInfo do begin
-    TrcNumFirstAndAfter(AllocBlocks, AllocSize, ': '); inc(TrcIndex);
-    TrcNumFirstAndAfter(FreedBlocks, FreedSize, ': '); inc(TrcIndex);
-    TrcNumFirstAndAfter(UnfreedBlocks, UnfreedSize, ': ');  inc(TrcIndex);
-    TrcNumberAfter(HeapSize, ': ');
-    TrcNumberAfter(StartupUsed, '('); inc(TrcIndex);
-    TrcNumberAfter(HeapFreed, ': '); inc(TrcIndex);
-    if PosInTrc('Should be') then begin
-      TrcNumberAfter(HeapShouldBe, ': ');
-      inc(TrcIndex);
+  if PosInTrc('Stack trace:') then begin
+    if not Assigned(traces) then Exit;
+    st := TStackTrace.Create;
+    ParseStackTrace(st); // changes TrcIndex
+    Traces.Add(st);
+    exit;
+  end;
+
+  if not PosInTrc(CallTracePrefix) then begin
+    inc(TrcIndex);
+    with TraceInfo do begin
+      TrcNumFirstAndAfter(AllocBlocks, AllocSize, ': '); inc(TrcIndex);
+      TrcNumFirstAndAfter(FreedBlocks, FreedSize, ': '); inc(TrcIndex);
+      TrcNumFirstAndAfter(UnfreedBlocks, UnfreedSize, ': ');  inc(TrcIndex);
+      TrcNumberAfter(HeapSize, ': ');
+      TrcNumberAfter(StartupUsed, '('); inc(TrcIndex);
+      TrcNumberAfter(HeapFreed, ': '); inc(TrcIndex);
+      if PosInTrc('Should be') then begin
+        TrcNumberAfter(HeapShouldBe, ': ');
+        inc(TrcIndex);
+      end;
    end;
  end;

@ -298,25 +317,38 @@ end;
 constructor THeapTrcInfo.Create(const ATRCFile: string);
 begin
  fTrcFile := ATrcFile;
+  fTRCText := '';
  inherited Create;
 end;

+constructor THeapTrcInfo.CreateFromTxt(const AText: string);
+begin
+  fTRCText := AText;
+end;
+
 procedure THeapTrcInfo.ParseStackTrace(trace: TStackTrace);
 var
  i   : integer;
  err : integer;
  hex : string;
 begin
-  i := Pos(CallTracePrefix, Trc[TrcIndex]);
-  if i <= 0 then Exit;
+  i := Pos('Stack trace:', Trc[TrcIndex]);
+  if i < 0 then begin
+    i := Pos(CallTracePrefix, Trc[TrcIndex]);
+    if i <= 0 then Exit;

-  trace.RawStackData := Trc[TrcIndex]; // raw stack trace data
+    trace.RawStackData := Trc[TrcIndex]; // raw stack trace data

-  inc(i, length(CallTracePrefix));
-  hex := ExtractHexNumberStr(Trc[TrcIndex], i);
+    inc(i, length(CallTracePrefix));
+    hex := ExtractHexNumberStr(Trc[TrcIndex], i);

-  Val(hex, trace.Addr, err);
-  GetNumberAfter(Trc[TrcIndex], trace.BlockSize, 'size ');
+    Val(hex, trace.Addr, err);
+    GetNumberAfter(Trc[TrcIndex], trace.BlockSize, 'size ');
+  end else begin
+    trace.RawStackData := 'Stack trace';
+    trace.Addr := 0;
+    trace.BlockSize := 0;
+  end;

  inc(TrcIndex);
  while (TrcIndex < Trc.Count) and (Pos(CallTracePrefix, Trc[TrcIndex]) = 0) do begin
@ -335,12 +367,15 @@ end;
 function THeapTrcInfo.GetLeakInfo(var LeakData: TLeakStatus; var Traces: TList): Boolean;
 begin
  Result := false;
-  if not FileExistsUTF8(fTRCFile) then
+  if (not FileExistsUTF8(fTRCFile)) and (fTRCText = '') then
    Exit;
  try
    Trc := TStringList.Create;
    try
-      Trc.LoadFromFile(fTrcFile);
+      if fTRCText <> '' then
+        Trc.Text := fTRCText
+      else
+        Trc.LoadFromFile(fTrcFile);
      TrcIndex := 0;

      DoParseTrc(Traces);