mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2026-01-04 18:30:32 +01:00
components: added leakview ide plugin to show heaptrc logs in the IDE from skalogryyz (issue #12513)
git-svn-id: trunk@17192 -
This commit is contained in:
vincents
parent
94f25c24bf
commit
fb3c068b0d
6
.gitattributes
vendored
6
.gitattributes
vendored
@ -915,6 +915,12 @@ components/lazthread/reglazthread.pas svneol=native#text/plain
|
||||
components/lazthread/threadoptionsdialog.lfm svneol=native#text/plain
|
||||
components/lazthread/threadoptionsdialog.lrs svneol=native#text/plain
|
||||
components/lazthread/threadoptionsdialog.pas svneol=native#text/plain
|
||||
components/leakview/heaptrcview.lfm svneol=native#text/plain
|
||||
components/leakview/heaptrcview.lrs svneol=native#text/plain
|
||||
components/leakview/heaptrcview.pas svneol=native#text/plain
|
||||
components/leakview/leakinfo.pas svneol=native#text/plain
|
||||
components/leakview/leakview.lpk svneol=native#text/plain
|
||||
components/leakview/leakview.pas svneol=native#text/plain
|
||||
components/macfiles/Makefile svneol=native#text/plain
|
||||
components/macfiles/Makefile.fpc svneol=native#text/plain
|
||||
components/macfiles/examples/Readme.txt svneol=native#text/plain
|
||||
|
||||
280
components/leakview/heaptrcview.lfm
Normal file
280
components/leakview/heaptrcview.lfm
Normal file
@ -0,0 +1,280 @@
|
||||
object HeapTrcViewForm: THeapTrcViewForm
|
||||
Left = 730
|
||||
Height = 298
|
||||
Top = 134
|
||||
Width = 387
|
||||
HelpContext = 0
|
||||
Align = alNone
|
||||
AllowDropFiles = False
|
||||
AutoScroll = True
|
||||
AutoSize = False
|
||||
BorderIcons = [biSystemMenu, biMinimize, biMaximize]
|
||||
BorderStyle = bsSizeable
|
||||
Caption = 'HeapTrcViewForm'
|
||||
ChildSizing.LeftRightSpacing = 0
|
||||
ChildSizing.TopBottomSpacing = 0
|
||||
ChildSizing.HorizontalSpacing = 0
|
||||
ChildSizing.VerticalSpacing = 0
|
||||
ChildSizing.ControlsPerLine = 0
|
||||
ClientHeight = 298
|
||||
ClientWidth = 387
|
||||
DockSite = False
|
||||
DragKind = dkDrag
|
||||
DragMode = dmManual
|
||||
Enabled = True
|
||||
Font.Height = 0
|
||||
Font.Style = []
|
||||
FormStyle = fsStayOnTop
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
ParentBiDiMode = True
|
||||
ParentFont = False
|
||||
Position = poDesigned
|
||||
ShowInTaskBar = stDefault
|
||||
UseDockManager = False
|
||||
LCLVersion = '0.9.27'
|
||||
WindowState = wsNormal
|
||||
object lblTrcFile: TLabel
|
||||
Left = 16
|
||||
Height = 18
|
||||
Top = 16
|
||||
Width = 45
|
||||
HelpContext = 0
|
||||
Align = alNone
|
||||
Alignment = taLeftJustify
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 0
|
||||
BorderSpacing.Top = 0
|
||||
BorderSpacing.Right = 0
|
||||
BorderSpacing.Bottom = 0
|
||||
BorderSpacing.Around = 0
|
||||
BorderSpacing.CellAlignHorizontal = ccaFill
|
||||
BorderSpacing.CellAlignVertical = ccaFill
|
||||
Caption = '.trc file'
|
||||
DragCursor = crDrag
|
||||
DragMode = dmManual
|
||||
Enabled = True
|
||||
Layout = tlTop
|
||||
ParentBidiMode = True
|
||||
ParentColor = False
|
||||
ParentFont = True
|
||||
ParentShowHint = True
|
||||
ShowAccelChar = True
|
||||
Transparent = True
|
||||
Visible = True
|
||||
WordWrap = False
|
||||
OptimalFill = False
|
||||
end
|
||||
object edtTrcFileName: TEdit
|
||||
Left = 72
|
||||
Height = 23
|
||||
Top = 16
|
||||
Width = 251
|
||||
HelpContext = 0
|
||||
Align = alNone
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
AutoSize = False
|
||||
AutoSelect = False
|
||||
BorderSpacing.Left = 0
|
||||
BorderSpacing.Top = 0
|
||||
BorderSpacing.Right = 0
|
||||
BorderSpacing.Bottom = 0
|
||||
BorderSpacing.Around = 0
|
||||
BorderSpacing.CellAlignHorizontal = ccaFill
|
||||
BorderSpacing.CellAlignVertical = ccaFill
|
||||
CharCase = ecNormal
|
||||
DragCursor = crDrag
|
||||
DragMode = dmManual
|
||||
EchoMode = emNormal
|
||||
Enabled = True
|
||||
MaxLength = -1
|
||||
ParentBidiMode = True
|
||||
ParentFont = True
|
||||
ParentShowHint = True
|
||||
PasswordChar = #0
|
||||
ReadOnly = False
|
||||
TabStop = True
|
||||
TabOrder = 0
|
||||
Visible = True
|
||||
end
|
||||
object btnUpdate: TButton
|
||||
Left = 16
|
||||
Height = 20
|
||||
Top = 54
|
||||
Width = 75
|
||||
HelpContext = 0
|
||||
Align = alNone
|
||||
AutoSize = False
|
||||
BorderSpacing.Left = 0
|
||||
BorderSpacing.Top = 0
|
||||
BorderSpacing.Right = 0
|
||||
BorderSpacing.Bottom = 0
|
||||
BorderSpacing.Around = 0
|
||||
BorderSpacing.CellAlignHorizontal = ccaFill
|
||||
BorderSpacing.CellAlignVertical = ccaFill
|
||||
Cancel = False
|
||||
Caption = 'Update'
|
||||
Default = False
|
||||
DragCursor = crDrag
|
||||
DragMode = dmManual
|
||||
Enabled = True
|
||||
ParentBidiMode = True
|
||||
ModalResult = 0
|
||||
OnClick = btnUpdateClick
|
||||
ParentFont = True
|
||||
ParentShowHint = True
|
||||
TabOrder = 1
|
||||
TabStop = True
|
||||
Visible = True
|
||||
end
|
||||
object trvTraceInfo: TTreeView
|
||||
Tag = 0
|
||||
Left = 16
|
||||
Height = 191
|
||||
Top = 88
|
||||
Width = 355
|
||||
HelpContext = 0
|
||||
Align = alNone
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
AutoExpand = False
|
||||
BorderSpacing.Left = 0
|
||||
BorderSpacing.Top = 0
|
||||
BorderSpacing.Right = 0
|
||||
BorderSpacing.Bottom = 0
|
||||
BorderSpacing.Around = 0
|
||||
BorderSpacing.CellAlignHorizontal = ccaFill
|
||||
BorderSpacing.CellAlignVertical = ccaFill
|
||||
BackgroundColor = clWindow
|
||||
BorderStyle = bsSingle
|
||||
BorderWidth = 0
|
||||
Ctl3D = False
|
||||
DefaultItemHeight = 19
|
||||
DragKind = dkDrag
|
||||
DragCursor = crDrag
|
||||
DragMode = dmManual
|
||||
Enabled = True
|
||||
ExpandSignType = tvestPlusMinus
|
||||
HideSelection = True
|
||||
HotTrack = False
|
||||
Indent = 15
|
||||
ParentCtl3D = True
|
||||
ParentFont = True
|
||||
ParentShowHint = True
|
||||
ReadOnly = False
|
||||
RightClickSelect = False
|
||||
RowSelect = False
|
||||
ScrollBars = ssBoth
|
||||
SelectionColor = clHighlight
|
||||
ShowButtons = True
|
||||
ShowLines = True
|
||||
ShowRoot = True
|
||||
SortType = stNone
|
||||
TabOrder = 2
|
||||
ToolTips = True
|
||||
Visible = True
|
||||
OnDblClick = trvTraceInfoDblClick
|
||||
Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips]
|
||||
TreeLineColor = clWindowFrame
|
||||
TreeLinePenStyle = psPattern
|
||||
ExpandSignColor = clWindowFrame
|
||||
end
|
||||
object chkStayOnTop: TCheckBox
|
||||
Left = 275
|
||||
Height = 18
|
||||
Top = 56
|
||||
Width = 92
|
||||
HelpContext = 0
|
||||
Align = alNone
|
||||
AllowGrayed = False
|
||||
Anchors = [akTop, akRight]
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 0
|
||||
BorderSpacing.Top = 0
|
||||
BorderSpacing.Right = 0
|
||||
BorderSpacing.Bottom = 0
|
||||
BorderSpacing.Around = 0
|
||||
BorderSpacing.CellAlignHorizontal = ccaFill
|
||||
BorderSpacing.CellAlignVertical = ccaFill
|
||||
Caption = 'Stay on top'
|
||||
Checked = False
|
||||
DragCursor = crDrag
|
||||
DragKind = dkDrag
|
||||
DragMode = dmManual
|
||||
Enabled = True
|
||||
OnChange = chkStayOnTopChange
|
||||
OnClick = chkStayOnTopClick
|
||||
ParentColor = True
|
||||
ParentFont = True
|
||||
ParentShowHint = True
|
||||
ParentBidiMode = True
|
||||
State = cbUnchecked
|
||||
TabOrder = 3
|
||||
TabStop = True
|
||||
UseOnChange = False
|
||||
Visible = True
|
||||
end
|
||||
object btnBrowse: TButton
|
||||
Left = 339
|
||||
Height = 20
|
||||
Top = 14
|
||||
Width = 32
|
||||
HelpContext = 0
|
||||
Align = alNone
|
||||
Anchors = [akTop, akRight]
|
||||
AutoSize = False
|
||||
BorderSpacing.Left = 0
|
||||
BorderSpacing.Top = 0
|
||||
BorderSpacing.Right = 0
|
||||
BorderSpacing.Bottom = 0
|
||||
BorderSpacing.Around = 0
|
||||
BorderSpacing.CellAlignHorizontal = ccaFill
|
||||
BorderSpacing.CellAlignVertical = ccaFill
|
||||
Cancel = False
|
||||
Caption = '...'
|
||||
Default = False
|
||||
DragCursor = crDrag
|
||||
DragMode = dmManual
|
||||
Enabled = True
|
||||
ParentBidiMode = True
|
||||
ModalResult = 0
|
||||
OnClick = btnBrowseClick
|
||||
ParentFont = True
|
||||
ParentShowHint = True
|
||||
TabOrder = 4
|
||||
TabStop = True
|
||||
Visible = True
|
||||
end
|
||||
object chkUseRaw: TCheckBox
|
||||
Left = 99
|
||||
Height = 18
|
||||
Top = 56
|
||||
Width = 107
|
||||
HelpContext = 0
|
||||
Align = alNone
|
||||
AllowGrayed = False
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 0
|
||||
BorderSpacing.Top = 0
|
||||
BorderSpacing.Right = 0
|
||||
BorderSpacing.Bottom = 0
|
||||
BorderSpacing.Around = 0
|
||||
BorderSpacing.CellAlignHorizontal = ccaFill
|
||||
BorderSpacing.CellAlignVertical = ccaFill
|
||||
Caption = 'Raw leak data'
|
||||
Checked = True
|
||||
DragCursor = crDrag
|
||||
DragKind = dkDrag
|
||||
DragMode = dmManual
|
||||
Enabled = True
|
||||
OnChange = chkUseRawChange
|
||||
ParentColor = True
|
||||
ParentFont = True
|
||||
ParentShowHint = True
|
||||
ParentBidiMode = True
|
||||
State = cbChecked
|
||||
TabOrder = 5
|
||||
TabStop = True
|
||||
UseOnChange = False
|
||||
Visible = True
|
||||
end
|
||||
end
|
||||
91
components/leakview/heaptrcview.lrs
Normal file
91
components/leakview/heaptrcview.lrs
Normal file
@ -0,0 +1,91 @@
|
||||
{ This is an automatically generated lazarus resource file }
|
||||
|
||||
LazarusResources.Add('THeapTrcViewForm','FORMDATA',[
|
||||
'TPF0'#16'THeapTrcViewForm'#15'HeapTrcViewForm'#4'Left'#3#218#2#6'Height'#3'*'
|
||||
+#1#3'Top'#3#134#0#5'Width'#3#131#1#11'HelpContext'#2#0#5'Align'#7#6'alNone'
|
||||
+#14'AllowDropFiles'#8#10'AutoScroll'#9#8'AutoSize'#8#11'BorderIcons'#11#12'b'
|
||||
+'iSystemMenu'#10'biMinimize'#10'biMaximize'#0#11'BorderStyle'#7#10'bsSizeabl'
|
||||
+'e'#7'Caption'#6#15'HeapTrcViewForm'#28'ChildSizing.LeftRightSpacing'#2#0#28
|
||||
+'ChildSizing.TopBottomSpacing'#2#0#29'ChildSizing.HorizontalSpacing'#2#0#27
|
||||
+'ChildSizing.VerticalSpacing'#2#0#27'ChildSizing.ControlsPerLine'#2#0#12'Cli'
|
||||
+'entHeight'#3'*'#1#11'ClientWidth'#3#131#1#8'DockSite'#8#8'DragKind'#7#6'dkD'
|
||||
+'rag'#8'DragMode'#7#8'dmManual'#7'Enabled'#9#11'Font.Height'#2#0#10'Font.Sty'
|
||||
+'le'#11#0#9'FormStyle'#7#11'fsStayOnTop'#8'OnCreate'#7#10'FormCreate'#9'OnDe'
|
||||
+'stroy'#7#11'FormDestroy'#14'ParentBiDiMode'#9#10'ParentFont'#8#8'Position'#7
|
||||
+#10'poDesigned'#13'ShowInTaskBar'#7#9'stDefault'#14'UseDockManager'#8#10'LCL'
|
||||
+'Version'#6#6'0.9.27'#11'WindowState'#7#8'wsNormal'#0#6'TLabel'#10'lblTrcFil'
|
||||
+'e'#4'Left'#2#16#6'Height'#2#18#3'Top'#2#16#5'Width'#2'-'#11'HelpContext'#2#0
|
||||
+#5'Align'#7#6'alNone'#9'Alignment'#7#13'taLeftJustify'#8'AutoSize'#9#18'Bord'
|
||||
+'erSpacing.Left'#2#0#17'BorderSpacing.Top'#2#0#19'BorderSpacing.Right'#2#0#20
|
||||
+'BorderSpacing.Bottom'#2#0#20'BorderSpacing.Around'#2#0'!BorderSpacing.CellA'
|
||||
+'lignHorizontal'#7#7'ccaFill'#31'BorderSpacing.CellAlignVertical'#7#7'ccaFil'
|
||||
+'l'#7'Caption'#6#9'.trc file'#10'DragCursor'#7#6'crDrag'#8'DragMode'#7#8'dmM'
|
||||
+'anual'#7'Enabled'#9#6'Layout'#7#5'tlTop'#14'ParentBidiMode'#9#11'ParentColo'
|
||||
+'r'#8#10'ParentFont'#9#14'ParentShowHint'#9#13'ShowAccelChar'#9#11'Transpare'
|
||||
+'nt'#9#7'Visible'#9#8'WordWrap'#8#11'OptimalFill'#8#0#0#5'TEdit'#14'edtTrcFi'
|
||||
+'leName'#4'Left'#2'H'#6'Height'#2#23#3'Top'#2#16#5'Width'#3#251#0#11'HelpCon'
|
||||
+'text'#2#0#5'Align'#7#6'alNone'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0
|
||||
+#8'AutoSize'#8#10'AutoSelect'#8#18'BorderSpacing.Left'#2#0#17'BorderSpacing.'
|
||||
+'Top'#2#0#19'BorderSpacing.Right'#2#0#20'BorderSpacing.Bottom'#2#0#20'Border'
|
||||
+'Spacing.Around'#2#0'!BorderSpacing.CellAlignHorizontal'#7#7'ccaFill'#31'Bor'
|
||||
+'derSpacing.CellAlignVertical'#7#7'ccaFill'#8'CharCase'#7#8'ecNormal'#10'Dra'
|
||||
+'gCursor'#7#6'crDrag'#8'DragMode'#7#8'dmManual'#8'EchoMode'#7#8'emNormal'#7
|
||||
+'Enabled'#9#9'MaxLength'#2#255#14'ParentBidiMode'#9#10'ParentFont'#9#14'Pare'
|
||||
+'ntShowHint'#9#12'PasswordChar'#6#1#0#8'ReadOnly'#8#7'TabStop'#9#8'TabOrder'
|
||||
+#2#0#7'Visible'#9#0#0#7'TButton'#9'btnUpdate'#4'Left'#2#16#6'Height'#2#20#3
|
||||
+'Top'#2'6'#5'Width'#2'K'#11'HelpContext'#2#0#5'Align'#7#6'alNone'#8'AutoSize'
|
||||
+#8#18'BorderSpacing.Left'#2#0#17'BorderSpacing.Top'#2#0#19'BorderSpacing.Rig'
|
||||
+'ht'#2#0#20'BorderSpacing.Bottom'#2#0#20'BorderSpacing.Around'#2#0'!BorderSp'
|
||||
+'acing.CellAlignHorizontal'#7#7'ccaFill'#31'BorderSpacing.CellAlignVertical'
|
||||
+#7#7'ccaFill'#6'Cancel'#8#7'Caption'#6#6'Update'#7'Default'#8#10'DragCursor'
|
||||
+#7#6'crDrag'#8'DragMode'#7#8'dmManual'#7'Enabled'#9#14'ParentBidiMode'#9#11
|
||||
+'ModalResult'#2#0#7'OnClick'#7#14'btnUpdateClick'#10'ParentFont'#9#14'Parent'
|
||||
+'ShowHint'#9#8'TabOrder'#2#1#7'TabStop'#9#7'Visible'#9#0#0#9'TTreeView'#12't'
|
||||
+'rvTraceInfo'#3'Tag'#2#0#4'Left'#2#16#6'Height'#3#191#0#3'Top'#2'X'#5'Width'
|
||||
+#3'c'#1#11'HelpContext'#2#0#5'Align'#7#6'alNone'#7'Anchors'#11#5'akTop'#6'ak'
|
||||
+'Left'#7'akRight'#8'akBottom'#0#10'AutoExpand'#8#18'BorderSpacing.Left'#2#0
|
||||
+#17'BorderSpacing.Top'#2#0#19'BorderSpacing.Right'#2#0#20'BorderSpacing.Bott'
|
||||
+'om'#2#0#20'BorderSpacing.Around'#2#0'!BorderSpacing.CellAlignHorizontal'#7#7
|
||||
+'ccaFill'#31'BorderSpacing.CellAlignVertical'#7#7'ccaFill'#15'BackgroundColo'
|
||||
+'r'#7#8'clWindow'#11'BorderStyle'#7#8'bsSingle'#11'BorderWidth'#2#0#5'Ctl3D'
|
||||
+#8#17'DefaultItemHeight'#2#19#8'DragKind'#7#6'dkDrag'#10'DragCursor'#7#6'crD'
|
||||
+'rag'#8'DragMode'#7#8'dmManual'#7'Enabled'#9#14'ExpandSignType'#7#14'tvestPl'
|
||||
+'usMinus'#13'HideSelection'#9#8'HotTrack'#8#6'Indent'#2#15#11'ParentCtl3D'#9
|
||||
+#10'ParentFont'#9#14'ParentShowHint'#9#8'ReadOnly'#8#16'RightClickSelect'#8#9
|
||||
+'RowSelect'#8#10'ScrollBars'#7#6'ssBoth'#14'SelectionColor'#7#11'clHighlight'
|
||||
+#11'ShowButtons'#9#9'ShowLines'#9#8'ShowRoot'#9#8'SortType'#7#6'stNone'#8'Ta'
|
||||
+'bOrder'#2#2#8'ToolTips'#9#7'Visible'#9#10'OnDblClick'#7#20'trvTraceInfoDblC'
|
||||
+'lick'#7'Options'#11#17'tvoAutoItemHeight'#16'tvoHideSelection'#21'tvoKeepCo'
|
||||
+'llapsedNodes'#14'tvoShowButtons'#12'tvoShowLines'#11'tvoShowRoot'#11'tvoToo'
|
||||
+'lTips'#0#13'TreeLineColor'#7#13'clWindowFrame'#16'TreeLinePenStyle'#7#9'psP'
|
||||
+'attern'#15'ExpandSignColor'#7#13'clWindowFrame'#0#0#9'TCheckBox'#12'chkStay'
|
||||
+'OnTop'#4'Left'#3#19#1#6'Height'#2#18#3'Top'#2'8'#5'Width'#2'\'#11'HelpConte'
|
||||
+'xt'#2#0#5'Align'#7#6'alNone'#11'AllowGrayed'#8#7'Anchors'#11#5'akTop'#7'akR'
|
||||
+'ight'#0#8'AutoSize'#9#18'BorderSpacing.Left'#2#0#17'BorderSpacing.Top'#2#0
|
||||
+#19'BorderSpacing.Right'#2#0#20'BorderSpacing.Bottom'#2#0#20'BorderSpacing.A'
|
||||
+'round'#2#0'!BorderSpacing.CellAlignHorizontal'#7#7'ccaFill'#31'BorderSpacin'
|
||||
+'g.CellAlignVertical'#7#7'ccaFill'#7'Caption'#6#11'Stay on top'#7'Checked'#8
|
||||
,#10'DragCursor'#7#6'crDrag'#8'DragKind'#7#6'dkDrag'#8'DragMode'#7#8'dmManual'
|
||||
+#7'Enabled'#9#8'OnChange'#7#18'chkStayOnTopChange'#7'OnClick'#7#17'chkStayOn'
|
||||
+'TopClick'#11'ParentColor'#9#10'ParentFont'#9#14'ParentShowHint'#9#14'Parent'
|
||||
+'BidiMode'#9#5'State'#7#11'cbUnchecked'#8'TabOrder'#2#3#7'TabStop'#9#11'UseO'
|
||||
+'nChange'#8#7'Visible'#9#0#0#7'TButton'#9'btnBrowse'#4'Left'#3'S'#1#6'Height'
|
||||
+#2#20#3'Top'#2#14#5'Width'#2' '#11'HelpContext'#2#0#5'Align'#7#6'alNone'#7'A'
|
||||
+'nchors'#11#5'akTop'#7'akRight'#0#8'AutoSize'#8#18'BorderSpacing.Left'#2#0#17
|
||||
+'BorderSpacing.Top'#2#0#19'BorderSpacing.Right'#2#0#20'BorderSpacing.Bottom'
|
||||
+#2#0#20'BorderSpacing.Around'#2#0'!BorderSpacing.CellAlignHorizontal'#7#7'cc'
|
||||
+'aFill'#31'BorderSpacing.CellAlignVertical'#7#7'ccaFill'#6'Cancel'#8#7'Capti'
|
||||
+'on'#6#3'...'#7'Default'#8#10'DragCursor'#7#6'crDrag'#8'DragMode'#7#8'dmManu'
|
||||
+'al'#7'Enabled'#9#14'ParentBidiMode'#9#11'ModalResult'#2#0#7'OnClick'#7#14'b'
|
||||
+'tnBrowseClick'#10'ParentFont'#9#14'ParentShowHint'#9#8'TabOrder'#2#4#7'TabS'
|
||||
+'top'#9#7'Visible'#9#0#0#9'TCheckBox'#9'chkUseRaw'#4'Left'#2'c'#6'Height'#2
|
||||
+#18#3'Top'#2'8'#5'Width'#2'k'#11'HelpContext'#2#0#5'Align'#7#6'alNone'#11'Al'
|
||||
+'lowGrayed'#8#8'AutoSize'#9#18'BorderSpacing.Left'#2#0#17'BorderSpacing.Top'
|
||||
+#2#0#19'BorderSpacing.Right'#2#0#20'BorderSpacing.Bottom'#2#0#20'BorderSpaci'
|
||||
+'ng.Around'#2#0'!BorderSpacing.CellAlignHorizontal'#7#7'ccaFill'#31'BorderSp'
|
||||
+'acing.CellAlignVertical'#7#7'ccaFill'#7'Caption'#6#13'Raw leak data'#7'Chec'
|
||||
+'ked'#9#10'DragCursor'#7#6'crDrag'#8'DragKind'#7#6'dkDrag'#8'DragMode'#7#8'd'
|
||||
+'mManual'#7'Enabled'#9#8'OnChange'#7#15'chkUseRawChange'#11'ParentColor'#9#10
|
||||
+'ParentFont'#9#14'ParentShowHint'#9#14'ParentBidiMode'#9#5'State'#7#9'cbChec'
|
||||
+'ked'#8'TabOrder'#2#5#7'TabStop'#9#11'UseOnChange'#8#7'Visible'#9#0#0#0
|
||||
]);
|
||||
341
components/leakview/heaptrcview.pas
Normal file
341
components/leakview/heaptrcview.pas
Normal file
@ -0,0 +1,341 @@
|
||||
unit HeapTrcView;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, ComCtrls, LeakInfo, LazIDEIntf, MenuIntf, contnrs;
|
||||
|
||||
type
|
||||
TJumpProc = procedure (Sender: TObject; const SourceName: string; Line: integer) of object;
|
||||
{ THeapTrcViewForm }
|
||||
|
||||
THeapTrcViewForm = class(TForm)
|
||||
btnUpdate: TButton;
|
||||
btnBrowse: TButton;
|
||||
chkUseRaw: TCheckBox;
|
||||
chkStayOnTop: TCheckBox;
|
||||
edtTrcFileName: TEdit;
|
||||
lblTrcFile: TLabel;
|
||||
trvTraceInfo: TTreeView;
|
||||
procedure btnUpdateClick(Sender: TObject);
|
||||
procedure btnBrowseClick(Sender: TObject);
|
||||
procedure chkStayOnTopChange(Sender: TObject);
|
||||
procedure chkStayOnTopClick(Sender: TObject);
|
||||
procedure chkUseRawChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure trvTraceInfoDblClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
fItems : TList;
|
||||
|
||||
procedure DoUpdateLeaks;
|
||||
|
||||
procedure ItemsToTree;
|
||||
procedure ChangeTreeText;
|
||||
|
||||
procedure ClearItems;
|
||||
procedure DoJump;
|
||||
|
||||
function GetStackTraceText(trace: TStackTrace; useRaw: Boolean): string;
|
||||
function GetStackLineText(const Line: TStackLine; useRaw: Boolean): string;
|
||||
|
||||
protected
|
||||
procedure LazarusJump(Sender: TObject; const SourceFile: string; Line: Integer);
|
||||
public
|
||||
{ public declarations }
|
||||
|
||||
OnJumpProc : TJumpProc; //= procedure (Sender: TObject; const SourceName: string; Line: integer) of object;
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
HeapTrcViewForm: THeapTrcViewForm = nil;
|
||||
|
||||
// JumpProc is the callback that is called everytime user double clicks
|
||||
// on the leak line. It's legal to pass nil, then LazarusIDE is used to peform a jump
|
||||
procedure ShowHeapTrcViewForm(JumpProc: TJumpProc = nil);
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
const // resorucestring ?
|
||||
StackTraceFormat = 'Leak: %d bytes x %d times'; // number of bytes leaked, leaks count
|
||||
StackTraceFormatSingle = 'Leak: %d bytes'; // number of bytes leaked
|
||||
StackLineFormatWithFile = '%s line: %d; file: %s'; // stack addr, filename (no path), line number
|
||||
StackLineFormat = '%s'; // stack addr
|
||||
|
||||
procedure ShowHeapTrcViewForm(JumpProc: TJumpProc);
|
||||
begin
|
||||
if not Assigned(HeapTrcViewForm) then HeapTrcViewForm := THeapTrcViewForm.Create(nil);
|
||||
if not Assigned(JumpProc)
|
||||
then HeapTrcViewForm.OnJumpProc := @HeapTrcViewForm.LazarusJump
|
||||
else HeapTrcViewForm.OnJumpProc := JumpProc;
|
||||
HeapTrcViewForm.Show;
|
||||
end;
|
||||
|
||||
{ THeapTrcViewForm }
|
||||
|
||||
procedure THeapTrcViewForm.btnUpdateClick(Sender: TObject);
|
||||
begin
|
||||
DoUpdateLeaks;
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.btnBrowseClick(Sender: TObject);
|
||||
var
|
||||
OpenDialog : TOpenDialog;
|
||||
begin
|
||||
OpenDialog := TOpenDialog.Create(nil);
|
||||
try
|
||||
if not OpenDialog.Execute then Exit;
|
||||
edtTrcFileName.Text := OpenDialog.FileName;
|
||||
DoUpdateLeaks;
|
||||
finally
|
||||
OpenDialog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.chkStayOnTopChange(Sender: TObject);
|
||||
begin
|
||||
if chkStayOnTop.Checked then Self.formStyle := fsStayOnTop
|
||||
else Self.formStyle := fsNormal;
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.chkStayOnTopClick(Sender: TObject);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.chkUseRawChange(Sender: TObject);
|
||||
begin
|
||||
ChangeTreeText;
|
||||
trvTraceInfo.Invalidate;
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
fItems := TList.Create;
|
||||
chkStayOnTop.Checked := FormStyle = fsStayOnTop;
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
ClearItems;
|
||||
fItems.Free;
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.trvTraceInfoDblClick(Sender: TObject);
|
||||
begin
|
||||
DoJump;
|
||||
end;
|
||||
|
||||
//note: to range check performed
|
||||
procedure HexInt64ToStr(i64: Int64; var s: string; ofs: Integer);
|
||||
var
|
||||
i : Integer;
|
||||
j : Integer;
|
||||
const
|
||||
Hexes: array [0..$F] of char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
|
||||
begin
|
||||
j := ofs + 15;
|
||||
for i := 0 to 7 do begin
|
||||
s[j] := Hexes[ i64 and $F ]; dec(j);
|
||||
s[j] := Hexes[ ((i64 and $F0) shr 4) and $F ]; dec(j);
|
||||
i64 := i64 shr 8;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetHashString(trace: TStackTrace): string;
|
||||
var
|
||||
i : integer;
|
||||
sz : Integer;
|
||||
begin
|
||||
sz := 16 + trace.LinesCount * 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
|
||||
HexInt64ToStr(trace.lines[i].Addr, Result, 17 + i * 16);
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.ItemsToTree;
|
||||
var
|
||||
i : Integer;
|
||||
j : Integer;
|
||||
trace : TStackTrace;
|
||||
nd : TTreeNode;
|
||||
hash : TFPObjectHashTable;
|
||||
hnode : THTObjectNode;
|
||||
list : TFPObjectList;
|
||||
hashed : TStackTrace;
|
||||
s : string;
|
||||
cnt : integer;
|
||||
begin
|
||||
hash := TFPObjectHashTable.Create(false);
|
||||
try
|
||||
// removing duplicates
|
||||
for i := 0 to fItems.Count - 1 do begin
|
||||
trace := TStackTrace(fItems[i]);
|
||||
s := GetHashString(trace);
|
||||
hashed := TStackTrace(hash.Items[s]);
|
||||
if Assigned(hashed) then begin
|
||||
inc(hashed.LeakCount);
|
||||
trace.Free; // remove from list
|
||||
fItems[i] := nil;
|
||||
end else
|
||||
hash.Add(s, trace)
|
||||
end;
|
||||
fItems.Pack;
|
||||
|
||||
// filling the tree
|
||||
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
|
||||
trvTraceInfo.Items.AddChildObject(nd, '-', Pointer(j));
|
||||
end;
|
||||
end;
|
||||
|
||||
// updating tree text
|
||||
ChangeTreeText;
|
||||
|
||||
finally
|
||||
hash.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.ClearItems;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
for i := 0 to fItems.Count - 1 do TObject(fItems[i]).Free;
|
||||
fItems.Clear;
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.DoUpdateLeaks;
|
||||
var
|
||||
info : TLeakInfo;
|
||||
data : TLeakStatus;
|
||||
begin
|
||||
ClearItems;
|
||||
trvTraceInfo.Items.Clear;
|
||||
if not FileExists(edtTrcFileName.Text) then Exit;
|
||||
|
||||
info := AllocHeapTraceInfo(edtTrcFileName.Text);
|
||||
try
|
||||
if info.GetLeakInfo(data, fItems) then ItemsToTree
|
||||
else trvTraceInfo.Items.Add(nil, 'Error while parsing trace file');
|
||||
finally
|
||||
info.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.DoJump;
|
||||
var
|
||||
nd : TTreeNode;
|
||||
searchFile : string;
|
||||
idx : Integer;
|
||||
trace : TStackTrace;
|
||||
begin
|
||||
if not Assigned(@OnJumpProc) then Exit;
|
||||
nd := trvTraceInfo.Selected;
|
||||
|
||||
if not Assigned(nd) then Exit;
|
||||
if nd.Parent = nil then Exit;
|
||||
|
||||
idx := Integer(nd.Data);
|
||||
trace := TStackTrace(nd.Parent.Data);
|
||||
if not Assigned(trace) or (idx >= trace.LinesCount) then Exit;
|
||||
|
||||
searchFile := trace.Lines[idx].FileName;
|
||||
if searchFile = '' then Exit;
|
||||
|
||||
idx := trace.Lines[idx].LineNum;
|
||||
OnJumpProc(Self, searchFile, idx);
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.ChangeTreeText;
|
||||
var
|
||||
i, j : Integer;
|
||||
idx : Integer;
|
||||
useRaw : Boolean;
|
||||
nd : TTreeNode;
|
||||
trace : TStackTrace;
|
||||
begin
|
||||
trvTraceInfo.Items.BeginUpdate;
|
||||
try
|
||||
useRaw := chkUseRaw.Checked;
|
||||
for i := 0 to trvTraceInfo. Items.Count - 1 do begin
|
||||
nd := TTreeNode(trvTraceInfo.Items[i]);
|
||||
if Assigned(nd.Parent) or not Assigned(nd.Data) then Continue;
|
||||
trace := TStackTrace(nd.Data);
|
||||
nd.Text := GetStackTraceText(trace, useRaw);
|
||||
for j := 0 to nd.Count - 1 do begin
|
||||
idx := Integer(nd.Items[j].Data);
|
||||
nd.Items[j].Text := GetStackLineText( trace.Lines[j], useRaw );
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
trvTraceInfo.Items.EndUpdate;
|
||||
end;
|
||||
end;
|
||||
|
||||
function THeapTrcViewForm.GetStackTraceText(trace: TStackTrace; useRaw: boolean): string;
|
||||
begin
|
||||
if useRaw then begin
|
||||
Result := trace.RawStackData;
|
||||
if (Result <> '') and (trace.LeakCount > 1) then Result := Result + Format(' (%d times)', [trace.LeakCount]);
|
||||
end;
|
||||
|
||||
if not useRaw or (Result = '') then begin
|
||||
if trace.LeakCount > 1
|
||||
then Result := Format(StackTraceFormat, [trace.BlockSize, trace.LeakCount])
|
||||
else Result := Format(StackTraceFormatSingle, [trace.BlockSize]);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function THeapTrcViewForm.GetStackLineText(const Line: TStackLine; useRaw: boolean): string;
|
||||
begin
|
||||
if useRaw then Result := Line.RawLineData;
|
||||
if not useRaw or (Result = '') then
|
||||
with Line do
|
||||
if FileName <> ''
|
||||
then Result := Format(StackLineFormatWithFile, ['$'+IntToHex(Addr, sizeof(Pointer)*2), LineNum, ExtractFileName(FileName)])
|
||||
else Result := Format(StackLineFormat, ['$'+IntToHex(Addr, sizeof(Pointer)*2)]);
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.LazarusJump(Sender: TObject; const SourceFile: string; Line: Integer);
|
||||
var
|
||||
nm : string;
|
||||
begin
|
||||
if not FileExists(SourceFile) then begin
|
||||
nm := LazarusIDE.FindSourceFile(SourceFile, '', [fsfUseIncludePaths] );
|
||||
if nm = '' then nm := SourceFile;
|
||||
end else
|
||||
nm := SourceFile;
|
||||
LazarusIDE.DoOpenFileAndJumpToPos(nm, Point(1, Line), -1, -1, [ofOnlyIfExists, ofRegularFile]);
|
||||
end;
|
||||
|
||||
procedure IDEMenuClicked(Sender: TObject);
|
||||
begin
|
||||
ShowHeapTrcViewForm(nil);
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
// todo:
|
||||
RegisterIDEMenuCommand(mnuTools, 'mnuLeakView', 'Leak View', nil, @IDEMenuClicked);
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
{$I heaptrcview.lrs}
|
||||
|
||||
finalization
|
||||
HeapTrcViewForm.Free;
|
||||
|
||||
end.
|
||||
|
||||
361
components/leakview/leakinfo.pas
Normal file
361
components/leakview/leakinfo.pas
Normal file
@ -0,0 +1,361 @@
|
||||
unit leakinfo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil;
|
||||
|
||||
type
|
||||
{ TStackLine }
|
||||
|
||||
TStackLine = record
|
||||
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;
|
||||
end;
|
||||
|
||||
{ TStackTrace }
|
||||
|
||||
TStackTrace = class(TObject)
|
||||
public
|
||||
Lines : array of TStackLine;
|
||||
LinesCount : integer;
|
||||
BlockSize : integer;
|
||||
Addr : Int64;
|
||||
LeakCount : Integer;
|
||||
RawStackData: string;
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
TLeakStatus = record
|
||||
TotalMem : Int64; // total mem used (-1) if unavailable
|
||||
LeakedMem : Int64; // leaked mem size (0) if none
|
||||
LeakCount : Int64; // number of unfreed pointers
|
||||
end;
|
||||
|
||||
|
||||
// abstract class
|
||||
|
||||
{ TLeakInfo }
|
||||
|
||||
TLeakInfo = class(TObject)
|
||||
// returns True, if information has been succesfully received, False otherwise
|
||||
// Fills LeakData record
|
||||
// if Traces is not nil, fill the list with TStackTrace object. User is responsible for freeing them
|
||||
function GetLeakInfo(var LeakData: TLeakStatus; var Traces: TList): Boolean; virtual; abstract;
|
||||
end;
|
||||
|
||||
// this file can be (should be?) hidden in the other unit, or to the implementation section
|
||||
// but it's hear for debugging purposes yet.
|
||||
|
||||
// heap trc class
|
||||
|
||||
{ THeapTrcInfo }
|
||||
|
||||
THeapTraceInfo = record
|
||||
ExeName : string;
|
||||
AllocSize : Int64;
|
||||
FreedSize : Int64;
|
||||
UnfreedSize : Int64;
|
||||
AllocBlocks : Int64;
|
||||
FreedBlocks : Int64;
|
||||
Unfreedblocks : Int64;
|
||||
HeapSize : Int64;
|
||||
HeapFreed : Int64;
|
||||
HeapShouldbe : Int64;
|
||||
StartupUsed : Int64;
|
||||
end;
|
||||
|
||||
THeapTrcInfo = class(TLeakInfo)
|
||||
protected
|
||||
fTRCFile : string;
|
||||
Trc : TStringList;
|
||||
TrcIndex : integer;
|
||||
|
||||
function PosInTrc(const SubStr: string; CaseSensetive: Boolean = false): Boolean;
|
||||
function TrcNumberAfter(var Num: Int64; const AfterSub: string): Boolean;
|
||||
function TrcNumberAfter(var Num: Integer; const AfterSub: string): Boolean;
|
||||
function TrcNumFirstAndAfter(var FirstNum, AfterNum: Int64; const AfterSub: string): Boolean;
|
||||
|
||||
procedure ParseStackTrace(trace: TStackTrace);
|
||||
procedure DoParseTrc(traces: TList);
|
||||
|
||||
public
|
||||
TraceInfo : THeapTraceInfo;
|
||||
constructor Create(const ATRCFile: string);
|
||||
function GetLeakInfo(var LeakData: TLeakStatus; var Traces: TList): Boolean; override;
|
||||
end;
|
||||
|
||||
function AllocHeapTraceInfo(const TrcFile: string): TLeakInfo;
|
||||
|
||||
implementation
|
||||
|
||||
function AllocHeapTraceInfo(const TrcFile: string): TLeakInfo;
|
||||
begin
|
||||
Result := THeapTrcInfo.Create(TrcFile);
|
||||
end;
|
||||
|
||||
// heap trace parsing implementation
|
||||
|
||||
const
|
||||
CallTracePrefix = 'Call trace for block ';
|
||||
|
||||
|
||||
procedure ClearTraceInfo(var TraceInfo: THeapTraceInfo);
|
||||
begin
|
||||
with TraceInfo do begin
|
||||
ExeName := '';
|
||||
AllocSize := -1;
|
||||
FreedSize := -1;
|
||||
UnfreedSize := 0;
|
||||
AllocBlocks := -1;
|
||||
FreedBlocks := -1;
|
||||
Unfreedblocks := 0;
|
||||
HeapSize := -1;
|
||||
HeapFreed := -1;
|
||||
HeapShouldbe := -1;
|
||||
StartupUsed := -1;
|
||||
end;
|
||||
end;
|
||||
|
||||
function ExtractNumberStr(const s: string; Offset: Integer): string;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
for i := Offset to length(s) do
|
||||
if not (s[i] in ['0'..'9']) then begin
|
||||
Result := Copy(s, Offset, i - Offset);
|
||||
Exit;
|
||||
end;
|
||||
Result := Copy(s, Offset, length(s)-Offset+1);
|
||||
end;
|
||||
|
||||
function ExtractHexNumberStr(const s: string; Offset: Integer): string;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
Result := '';
|
||||
if s[Offset] = '$' then i := Offset + 1
|
||||
else i := Offset;
|
||||
|
||||
for i := i to length(s) do
|
||||
if not (s[i] in ['0'..'9','A'..'F', 'a'..'f']) then begin
|
||||
Result := Copy(s, Offset, i - Offset);
|
||||
Exit;
|
||||
end;
|
||||
Result := Copy(s, Offset, length(s)-Offset+1);
|
||||
end;
|
||||
|
||||
function StrToInt(const s: string; var Num: int64): Boolean;
|
||||
var
|
||||
err : Integer;
|
||||
begin
|
||||
if s = '' then Result := false
|
||||
else begin
|
||||
Val(s, Num, err);
|
||||
Result := err = 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetNumberAfter(const s: string; var Num: int64; const AfterStr: string): Boolean; overload;
|
||||
var
|
||||
i : integer;
|
||||
sub : string;
|
||||
begin
|
||||
i := Pos(AfterStr, s);
|
||||
Result := i > 0;
|
||||
if not Result then Exit;
|
||||
|
||||
inc(i, length(AfterStr));
|
||||
sub := ExtractNumberStr(s, i);
|
||||
Result := sub <> '';
|
||||
if not Result then Exit;
|
||||
Result := StrToInt(sub, num);
|
||||
end;
|
||||
|
||||
function GetNumberAfter(const s: string; var Num: integer; const AfterStr: string): Boolean; overload;
|
||||
var
|
||||
i64 : Int64;
|
||||
begin
|
||||
i64 := Num;
|
||||
Result := GetNumberAfter(s, i64, AfterStr);
|
||||
Num := i64;
|
||||
end;
|
||||
|
||||
procedure GetNumFirstAndAfter(const s: string; var FirstNum, AfterNum: Int64; const AfterStr: string);
|
||||
begin
|
||||
StrToInt(ExtractNumberStr(s, 1), FirstNum);
|
||||
GetNumberAfter(s, AfterNum, AfterStr);
|
||||
end;
|
||||
|
||||
procedure ParseTraceLine(const s: string; var line: TStackLine);
|
||||
var
|
||||
i : integer;
|
||||
err : Integer;
|
||||
hex : string;
|
||||
begin
|
||||
i := Pos('$', s);
|
||||
if i <= 0 then Exit;
|
||||
hex := ExtractHexNumberStr(s, i);
|
||||
Val(hex, line.Addr, err);
|
||||
|
||||
if not GetNumberAfter(s, line.LineNum, 'line ') then begin
|
||||
line.LineNum := -1;
|
||||
line.FileName := ''
|
||||
end else begin
|
||||
i := Pos(' of ', s);
|
||||
if i <= 0 then Exit;
|
||||
inc(i, 4);
|
||||
line.FileName := Copy(s, i, length(s) - i + 1);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{ THeapTrcInfo }
|
||||
|
||||
function THeapTrcInfo.PosInTrc(const SubStr: string; CaseSensetive: Boolean): Boolean;
|
||||
begin
|
||||
Result := TrcIndex<Trc.Count;
|
||||
if not Result then Exit;
|
||||
|
||||
if CaseSensetive then
|
||||
Result := Pos(SubStr, Trc[TrcIndex])>0
|
||||
else // slow?
|
||||
Result := Pos(UpperCase(SubStr), UpperCase(Trc[TrcIndex]))>0
|
||||
end;
|
||||
|
||||
function THeapTrcInfo.TrcNumberAfter(var Num: Int64; const AfterSub: string): Boolean;
|
||||
begin
|
||||
Result := TrcIndex<Trc.Count;
|
||||
if not Result then Exit;
|
||||
GetNumberAfter(Trc[TrcIndex], Num, AfterSub);
|
||||
end;
|
||||
|
||||
function THeapTrcInfo.TrcNumberAfter(var Num: Integer; const AfterSub: string): Boolean;
|
||||
var
|
||||
i : Int64;
|
||||
begin
|
||||
i := Num;
|
||||
Result := TrcNumberAfter(i, AfterSub);
|
||||
Num := i;
|
||||
end;
|
||||
|
||||
function THeapTrcInfo.TrcNumFirstAndAfter(var FirstNum, AfterNum: Int64; const AfterSub: string): Boolean;
|
||||
begin
|
||||
Result := TrcIndex<Trc.Count;
|
||||
if not Result then Exit;
|
||||
GetNumFirstAndAfter(Trc[TrcIndex], FirstNum, AfterNum, AfterSub);
|
||||
end;
|
||||
|
||||
procedure THeapTrcInfo.DoParseTrc(traces: TList);
|
||||
var
|
||||
st : TStackTrace;
|
||||
begin
|
||||
ClearTraceInfo(TraceInfo);
|
||||
if TrcIndex >= Trc.COunt then Exit;
|
||||
TraceInfo.ExeName := Trc[TrcIndex];
|
||||
inc(TrcIndex);
|
||||
|
||||
if not PosInTrc('Heap dump') 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);
|
||||
end;
|
||||
end;
|
||||
|
||||
if not Assigned(traces) then Exit;
|
||||
|
||||
while TrcIndex < Trc.Count do begin
|
||||
if PosInTrc(CallTracePrefix) then begin
|
||||
st := TStackTrace.Create;
|
||||
ParseStackTrace(st); // changes TrcIndex
|
||||
Traces.Add(st);
|
||||
end else
|
||||
inc(TrcIndex);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
constructor THeapTrcInfo.Create(const ATRCFile: string);
|
||||
begin
|
||||
fTrcFile := ATrcFile;
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
procedure THeapTrcInfo.ParseStackTrace(trace: TStackTrace);
|
||||
var
|
||||
i : integer;
|
||||
err : integer;
|
||||
hex : string;
|
||||
begin
|
||||
i := Pos(CallTracePrefix, Trc[TrcIndex]);
|
||||
if i <= 0 then Exit;
|
||||
|
||||
trace.RawStackData := Trc[TrcIndex]; // raw stack trace data
|
||||
|
||||
inc(i, length(CallTracePrefix));
|
||||
hex := ExtractHexNumberStr(Trc[TrcIndex], i);
|
||||
|
||||
Val(hex, trace.Addr, err);
|
||||
GetNumberAfter(Trc[TrcIndex], trace.BlockSize, 'size ');
|
||||
|
||||
inc(TrcIndex);
|
||||
while (TrcIndex < Trc.Count) and (Pos(CallTracePrefix, 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);
|
||||
inc(Trcindex);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function THeapTrcInfo.GetLeakInfo(var LeakData: TLeakStatus; var Traces: TList): Boolean;
|
||||
begin
|
||||
Result := false;
|
||||
if not FileExistsUTF8(fTRCFile) then Exit;
|
||||
try
|
||||
Trc := TStringList.Create;
|
||||
try
|
||||
Trc.LoadFromFile(fTrcFile);
|
||||
TrcIndex := 0;
|
||||
|
||||
DoParseTrc(Traces);
|
||||
LeakData.LeakCount := TraceInfo.Unfreedblocks;
|
||||
LeakData.LeakedMem := TraceInfo.UnfreedSize;
|
||||
LeakData.TotalMem := TraceInfo.AllocSize;
|
||||
Result := true;
|
||||
finally
|
||||
Trc.Free;
|
||||
Trc := nil;
|
||||
end;
|
||||
except
|
||||
Result := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TStackTrace }
|
||||
|
||||
constructor TStackTrace.Create;
|
||||
begin
|
||||
LeakCount := 1;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
64
components/leakview/leakview.lpk
Normal file
64
components/leakview/leakview.lpk
Normal file
@ -0,0 +1,64 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<Package Version="3">
|
||||
<Name Value="leakview"/>
|
||||
<Author Value="Dmitry 'skalogryz' Boyarintsev"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="8"/>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<CStyleOperator Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseLineInfoUnit Value="False"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Description Value="Leak View. allows fast navigation trough HeapTrc (and other?) leaks."/>
|
||||
<Version Major="1"/>
|
||||
<Files Count="4">
|
||||
<Item1>
|
||||
<Filename Value="heaptrcview.lfm"/>
|
||||
<Type Value="LFM"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="heaptrcview.lrs"/>
|
||||
<Type Value="LRS"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Filename Value="heaptrcview.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="HeapTrcView"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Filename Value="LeakInfo.pas"/>
|
||||
<UnitName Value="LeakInfo"/>
|
||||
</Item4>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="3">
|
||||
<Item1>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="FCL"/>
|
||||
<MinVersion Major="1" Valid="True"/>
|
||||
</Item3>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)/"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
21
components/leakview/leakview.pas
Normal file
21
components/leakview/leakview.pas
Normal file
@ -0,0 +1,21 @@
|
||||
{ This file was automatically created by Lazarus. do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit leakview;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
HeapTrcView, LeakInfo, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('HeapTrcView', @HeapTrcView.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('leakview', @Register);
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user