diff --git a/components/leakview/heaptrcview.lfm b/components/leakview/heaptrcview.lfm index 374cf2664a..4f5f19cbf7 100644 --- 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 diff --git a/components/leakview/heaptrcview.lrs b/components/leakview/heaptrcview.lrs index 52bd183c61..c1dc02012a 100644 --- 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 ]); diff --git a/components/leakview/heaptrcview.pas b/components/leakview/heaptrcview.pas index 43336ce866..789f32e66e 100644 --- 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'); diff --git a/components/leakview/leakinfo.pas b/components/leakview/leakinfo.pas index 1795e0ea06..322bf40071 100644 --- 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);