mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-31 02:52:29 +02:00
MWE: = Moved and renamed debuggerforms so that they can be
modified by the ide
+ Added some parsing to evaluate complex expressions
not understood by the debugger
git-svn-id: trunk@3068 -
This commit is contained in:
marc
parent
66b50cd1e2
commit
baa8cff9f6
14
.gitattributes
vendored
14
.gitattributes
vendored
@ -67,11 +67,14 @@ components/synedit/synhighlighterxml.pas svneol=native#text/pascal
|
||||
components/synedit/synmacrorecorder.pas svneol=native#text/pascal
|
||||
components/synedit/synmemo.pas svneol=native#text/pascal
|
||||
components/synedit/syntextdrawer.pp svneol=native#text/pascal
|
||||
debugger/breakpointsdlg.lfm svneol=native#text/plain
|
||||
debugger/breakpointsdlg.lrs svneol=native#text/pascal
|
||||
debugger/breakpointsdlg.pp svneol=native#text/pascal
|
||||
debugger/callstackdlg.lfm svneol=native#text/plain
|
||||
debugger/callstackdlg.lrs svneol=native#text/pascal
|
||||
debugger/callstackdlg.pp svneol=native#text/pascal
|
||||
debugger/cmdlinedebugger.pp svneol=native#text/pascal
|
||||
debugger/dbgoutputform.lfm svneol=native#text/plain
|
||||
debugger/dbgoutputform.lrs svneol=native#text/pascal
|
||||
debugger/dbgoutputform.pp svneol=native#text/pascal
|
||||
debugger/dbgutils.pp svneol=native#text/pascal
|
||||
@ -79,23 +82,20 @@ debugger/debugger.pp svneol=native#text/pascal
|
||||
debugger/debuggerdlg.pp svneol=native#text/pascal
|
||||
debugger/gdbdebugger.pp svneol=native#text/pascal
|
||||
debugger/gdbmidebugger.pp svneol=native#text/pascal
|
||||
debugger/gdbtypeinfo.pp svneol=native#text/pascal
|
||||
debugger/localsdlg.lfm svneol=native#text/plain
|
||||
debugger/localsdlg.lrs svneol=native#text/pascal
|
||||
debugger/localsdlg.pp svneol=native#text/pascal
|
||||
debugger/processlist.pas svneol=native#text/pascal
|
||||
debugger/tbreakpointsdlg.lfm svneol=native#text/plain
|
||||
debugger/tcallstackdlg.lfm svneol=native#text/plain
|
||||
debugger/tdbgoutputform.lfm svneol=native#text/plain
|
||||
debugger/test/debugtest.pp svneol=native#text/pascal
|
||||
debugger/test/debugtestform.lrs svneol=native#text/pascal
|
||||
debugger/test/debugtestform.pp svneol=native#text/pascal
|
||||
debugger/test/examples/testcntr.pp svneol=native#text/pascal
|
||||
debugger/test/examples/testwait.pp svneol=native#text/pascal
|
||||
debugger/test/tdebugtesttorm.lfm svneol=native#text/plain
|
||||
debugger/tlocalsdlg.lfm svneol=native#text/plain
|
||||
debugger/twatchesdlg.lfm svneol=native#text/plain
|
||||
debugger/twatchpropertydlg.lfm svneol=native#text/plain
|
||||
debugger/watchesdlg.lfm svneol=native#text/plain
|
||||
debugger/watchesdlg.lrs svneol=native#text/pascal
|
||||
debugger/watchesdlg.pp svneol=native#text/pascal
|
||||
debugger/watchpropertydlg.lfm svneol=native#text/plain
|
||||
debugger/watchpropertydlg.lrs svneol=native#text/pascal
|
||||
debugger/watchpropertydlg.pp svneol=native#text/pascal
|
||||
designer/abstractcompiler.pp svneol=native#text/pascal
|
||||
|
||||
99
debugger/breakpointsdlg.lfm
Normal file
99
debugger/breakpointsdlg.lfm
Normal file
@ -0,0 +1,99 @@
|
||||
object BreakpointsDlg: TBreakpointsDlg
|
||||
CAPTION = 'Breakpoint list'
|
||||
CLIENTHEIGHT = 200
|
||||
CLIENTWIDTH = 500
|
||||
HORZSCROLLBAR.PAGE = 501
|
||||
VERTSCROLLBAR.PAGE = 201
|
||||
LEFT = 340
|
||||
HEIGHT = 200
|
||||
TOP = 117
|
||||
WIDTH = 500
|
||||
object lvBreakPoints: TLISTVIEW
|
||||
ALIGN = alclient
|
||||
ANCHORS = [aktop, akleft]
|
||||
COLUMNS = <
|
||||
item
|
||||
CAPTION = 'State'
|
||||
VISIBLE = True
|
||||
WIDTH = 50
|
||||
end
|
||||
item
|
||||
CAPTION = 'Filename/Address'
|
||||
VISIBLE = True
|
||||
WIDTH = 150
|
||||
end
|
||||
item
|
||||
CAPTION = 'Line/Length'
|
||||
VISIBLE = True
|
||||
WIDTH = 100
|
||||
end
|
||||
item
|
||||
CAPTION = 'Condition'
|
||||
VISIBLE = True
|
||||
WIDTH = 75
|
||||
end
|
||||
item
|
||||
CAPTION = 'Action'
|
||||
VISIBLE = True
|
||||
WIDTH = 50
|
||||
end
|
||||
item
|
||||
CAPTION = 'Pass Count'
|
||||
VISIBLE = True
|
||||
WIDTH = 100
|
||||
end
|
||||
item
|
||||
CAPTION = 'Group'
|
||||
VISIBLE = True
|
||||
WIDTH = 50
|
||||
end>
|
||||
MULTISELECT = True
|
||||
POPUPMENU = mnuPopup
|
||||
VIEWSTYLE = vsreport
|
||||
ONCLICK = lvBreakPointsClick
|
||||
ONSELECTITEM = lvBreakPointsSelectItem
|
||||
HEIGHT = 200
|
||||
WIDTH = 500
|
||||
end
|
||||
object mnuPopup: TPOPUPMENU
|
||||
left = 100
|
||||
top = 96
|
||||
object popAdd: TMENUITEM
|
||||
CAPTION = 'Add...'
|
||||
object popAddSourceBP: TMENUITEM
|
||||
CAPTION = '&Source breakpoint'
|
||||
ONCLICK = popAddSourceBPClick
|
||||
end
|
||||
end
|
||||
object N1: TMENUITEM
|
||||
CAPTION = '-'
|
||||
end
|
||||
object popProperties: TMENUITEM
|
||||
CAPTION = '&Properties'
|
||||
ONCLICK = popPropertiesClick
|
||||
end
|
||||
object popEnabled: TMENUITEM
|
||||
CAPTION = '&Enabled'
|
||||
ONCLICK = popEnabledClick
|
||||
end
|
||||
object popDelete: TMENUITEM
|
||||
CAPTION = '&Delete'
|
||||
ONCLICK = popDeleteClick
|
||||
end
|
||||
object N2: TMENUITEM
|
||||
CAPTION = '-'
|
||||
end
|
||||
object popDisableAll: TMENUITEM
|
||||
CAPTION = 'D&isable All'
|
||||
ONCLICK = popDisableAllClick
|
||||
end
|
||||
object popEnableAll: TMENUITEM
|
||||
CAPTION = '&Enable All'
|
||||
ONCLICK = popEnableAllClick
|
||||
end
|
||||
object popDeleteAll: TMENUITEM
|
||||
CAPTION = '&Delete All'
|
||||
ONCLICK = popDeleteAllClick
|
||||
end
|
||||
end
|
||||
end
|
||||
@ -1,25 +1,29 @@
|
||||
LazarusResources.Add('TBreakpointsDlg','FORMDATA',
|
||||
'TPF0'#15'TBreakpointsDlg'#14'BreakpointsDlg'#4'Left'#3'T'#1#3'Top'#2'u'#5
|
||||
+'Width'#3#244#1#6'Height'#3#200#0#7'Caption'#6#15'Breakpoint list'#0#9'TL'
|
||||
+'istView'#13'lvBreakPoints'#4'Left'#2#0#3'Top'#2#0#5'Width'#3#228#1#6'Hei'
|
||||
+'ght'#3#171#0#5'Align'#7#8'alClient'#7'Columns'#14#1#7'Caption'#6#5'State'
|
||||
+#5'Width'#2'2'#0#1#7'Caption'#6#16'Filename/Address'#5'Width'#3#150#0#0#1
|
||||
+#7'Caption'#6#11'Line/Length'#5'Width'#2'd'#0#1#7'Caption'#6#9'Condition'
|
||||
+#5'Width'#2'K'#0#1#7'Caption'#6#6'Action'#5'Width'#2'2'#0#1#7'Caption'#6
|
||||
+#10'Pass Count'#5'Width'#2'd'#0#1#7'Caption'#6#5'Group'#0#0#11'MultiSelec'
|
||||
+'t'#9#9'PopupMenu'#7#8'mnuPopup'#9'ViewStyle'#7#8'vsReport'#7'OnClick'#7
|
||||
+#18'lvBreakPointsClick'#12'OnSelectItem'#7#23'lvBreakPointsSelectItem'#0#0
|
||||
+#10'TPopupMenu'#8'mnuPopup'#4'Left'#2'd'#3'Top'#2'`'#0#9'TMenuItem'#6'pop'
|
||||
+'Add'#7'Caption'#6#6'Add...'#0#9'TMenuItem'#14'popAddSourceBP'#7'Caption'
|
||||
+#6#18'&Source breakpoint'#7'OnClick'#7#19'popAddSourceBPClick'#0#0#0#9'TM'
|
||||
+'enuItem'#2'N1'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#13'popProperties'#7'Ca'
|
||||
+'ption'#6#11'&Properties'#7'OnClick'#7#18'popPropertiesClick'#0#0#9'TMenu'
|
||||
+'Item'#10'popEnabled'#7'Caption'#6#8'&Enabled'#7'OnClick'#7#15'popEnabled'
|
||||
+'Click'#0#0#9'TMenuItem'#9'popDelete'#7'Caption'#6#7'&Delete'#7'OnClick'#7
|
||||
+#14'popDeleteClick'#0#0#9'TMenuItem'#2'N2'#7'Caption'#6#1'-'#0#0#9'TMenuI'
|
||||
+'tem'#13'popDisableAll'#7'Caption'#6#12'D&isable All'#7'OnClick'#7#18'pop'
|
||||
+'DisableAllClick'#0#0#9'TMenuItem'#12'popEnableAll'#7'Caption'#6#11'&Enab'
|
||||
+'le All'#7'OnClick'#7#17'popEnableAllClick'#0#0#9'TMenuItem'#12'popDelete'
|
||||
+'All'#7'Caption'#6#11'&Delete All'#7'OnClick'#7#17'popDeleteAllClick'#0#0
|
||||
+#0#0
|
||||
);
|
||||
{ This is an automatically generated lazarus resource file }
|
||||
|
||||
LazarusResources.Add('TBreakpointsDlg','FORMDATA',[
|
||||
'TPF0'#15'TBreakpointsDlg'#14'BreakpointsDlg'#7'CAPTION'#6#15'Breakpoint list'
|
||||
+#12'CLIENTHEIGHT'#3#200#0#11'CLIENTWIDTH'#3#244#1#18'HORZSCROLLBAR.PAGE'#3
|
||||
+#245#1#18'VERTSCROLLBAR.PAGE'#3#201#0#4'LEFT'#3'T'#1#6'HEIGHT'#3#200#0#3'TOP'
|
||||
+#2'u'#5'WIDTH'#3#244#1#0#9'TLISTVIEW'#13'lvBreakPoints'#5'ALIGN'#7#8'alclien'
|
||||
+'t'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'COLUMNS'#14#1#7'CAPTION'#6#5'State'
|
||||
+#7'VISIBLE'#9#5'WIDTH'#2'2'#0#1#7'CAPTION'#6#16'Filename/Address'#7'VISIBLE'
|
||||
+#9#5'WIDTH'#3#150#0#0#1#7'CAPTION'#6#11'Line/Length'#7'VISIBLE'#9#5'WIDTH'#2
|
||||
+'d'#0#1#7'CAPTION'#6#9'Condition'#7'VISIBLE'#9#5'WIDTH'#2'K'#0#1#7'CAPTION'#6
|
||||
+#6'Action'#7'VISIBLE'#9#5'WIDTH'#2'2'#0#1#7'CAPTION'#6#10'Pass Count'#7'VISI'
|
||||
+'BLE'#9#5'WIDTH'#2'd'#0#1#7'CAPTION'#6#5'Group'#7'VISIBLE'#9#5'WIDTH'#2'2'#0
|
||||
+#0#11'MULTISELECT'#9#9'POPUPMENU'#7#8'mnuPopup'#9'VIEWSTYLE'#7#8'vsreport'#7
|
||||
+'ONCLICK'#7#18'lvBreakPointsClick'#12'ONSELECTITEM'#7#23'lvBreakPointsSelect'
|
||||
+'Item'#6'HEIGHT'#3#200#0#5'WIDTH'#3#244#1#0#0#10'TPOPUPMENU'#8'mnuPopup'#4'l'
|
||||
+'eft'#2'd'#3'top'#2'`'#0#9'TMENUITEM'#6'popAdd'#7'CAPTION'#6#6'Add...'#0#9'T'
|
||||
+'MENUITEM'#14'popAddSourceBP'#7'CAPTION'#6#18'&Source breakpoint'#7'ONCLICK'
|
||||
+#7#19'popAddSourceBPClick'#0#0#0#9'TMENUITEM'#2'N1'#7'CAPTION'#6#1'-'#0#0#9
|
||||
+'TMENUITEM'#13'popProperties'#7'CAPTION'#6#11'&Properties'#7'ONCLICK'#7#18'p'
|
||||
+'opPropertiesClick'#0#0#9'TMENUITEM'#10'popEnabled'#7'CAPTION'#6#8'&Enabled'
|
||||
+#7'ONCLICK'#7#15'popEnabledClick'#0#0#9'TMENUITEM'#9'popDelete'#7'CAPTION'#6
|
||||
+#7'&Delete'#7'ONCLICK'#7#14'popDeleteClick'#0#0#9'TMENUITEM'#2'N2'#7'CAPTION'
|
||||
+#6#1'-'#0#0#9'TMENUITEM'#13'popDisableAll'#7'CAPTION'#6#12'D&isable All'#7'O'
|
||||
+'NCLICK'#7#18'popDisableAllClick'#0#0#9'TMENUITEM'#12'popEnableAll'#7'CAPTIO'
|
||||
+'N'#6#11'&Enable All'#7'ONCLICK'#7#17'popEnableAllClick'#0#0#9'TMENUITEM'#12
|
||||
+'popDeleteAll'#7'CAPTION'#6#11'&Delete All'#7'ONCLICK'#7#17'popDeleteAllClic'
|
||||
+'k'#0#0#0#0
|
||||
]);
|
||||
|
||||
@ -37,6 +37,7 @@ interface
|
||||
function GetLine(var ABuffer: String): String;
|
||||
function StripLN(const ALine: String): String;
|
||||
function GetPart(const ASkipTo, AnEnd: String; var ASource: String): String;
|
||||
function ConvertToCString(const AText: String): String;
|
||||
|
||||
const
|
||||
{$IFDEF WIN32}
|
||||
@ -110,10 +111,39 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function ConvertToCString(const AText: String): String;
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
Result := AText;
|
||||
n := 1;
|
||||
while n <= Length(Result) do
|
||||
begin
|
||||
case Result[n] of
|
||||
'''': begin
|
||||
if (n < Length(Result))
|
||||
and (Result[n + 1] = '''')
|
||||
then Delete(Result, n, 1)
|
||||
else Result[n] := '"';
|
||||
end;
|
||||
'"': begin
|
||||
Insert('"', Result, n);
|
||||
Inc(n);
|
||||
end;
|
||||
end;
|
||||
Inc(n);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.3 2003/05/22 23:08:19 marc
|
||||
MWE: = Moved and renamed debuggerforms so that they can be
|
||||
modified by the ide
|
||||
+ Added some parsing to evaluate complex expressions
|
||||
not understood by the debugger
|
||||
|
||||
Revision 1.2 2002/05/10 06:57:47 lazarus
|
||||
MG: updated licenses
|
||||
|
||||
|
||||
@ -37,8 +37,7 @@ unit GDBMIDebugger;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Process, Debugger, CmdLineDebugger;
|
||||
|
||||
Classes, Process, Debugger, CmdLineDebugger, GDBTypeInfo;
|
||||
|
||||
type
|
||||
TGDBMIProgramInfo = record
|
||||
@ -65,15 +64,16 @@ type
|
||||
function GDBStepInto: Boolean;
|
||||
function GDBRunTo(const ASource: String; const ALine: Integer): Boolean;
|
||||
function GDBJumpTo(const ASource: String; const ALine: Integer): Boolean;
|
||||
function ProcessResult(var ANewState: TDBGState; var AResultValues: String): Boolean;
|
||||
function ProcessResult(var ANewState: TDBGState; var AResultValues: String; const ANoMICommand: Boolean): Boolean;
|
||||
function ProcessRunning: Boolean;
|
||||
function ProcessStopped(const AParams: String): Boolean;
|
||||
function ExecuteCommand(const ACommand: String): Boolean; overload;
|
||||
function ExecuteCommand(const ACommand: String; var AResultValues: String): Boolean; overload;
|
||||
function ExecuteCommand(const ACommand: String; AValues: array of const): Boolean; overload;
|
||||
function ExecuteCommand(const ACommand: String; AValues: array of const; var AResultValues: String): Boolean; overload;
|
||||
function ExecuteCommand(const ACommand: String; AValues: array of const; var AResultState: TDBGState; var AResultValues: String): Boolean; overload;
|
||||
function ExecuteCommand(const ACommand: String; AValues: array of const; const AIgnoreError: Boolean; var AResultState: TDBGState; var AResultValues: String): Boolean; overload;
|
||||
function ExecuteCommand(const ACommand: String; const ANoMICommand: Boolean): Boolean; overload;
|
||||
function ExecuteCommand(const ACommand: String; var AResultValues: String; const ANoMICommand: Boolean): Boolean; overload;
|
||||
function ExecuteCommand(const ACommand: String; AValues: array of const; const ANoMICommand: Boolean): Boolean; overload;
|
||||
function ExecuteCommand(const ACommand: String; AValues: array of const; var AResultValues: String; const ANoMICommand: Boolean): Boolean; overload;
|
||||
function ExecuteCommand(const ACommand: String; AValues: array of const; var AResultState: TDBGState; var AResultValues: String; const ANoMICommand: Boolean): Boolean; overload;
|
||||
function ExecuteCommand(const ACommand: String; AValues: array of const; const AIgnoreError: Boolean; var AResultState: TDBGState; var AResultValues: String; const ANoMICommand: Boolean): Boolean; overload;
|
||||
function GetGDBTypeInfo(const AExpression: String): TGDBType;
|
||||
protected
|
||||
function ChangeFileName: Boolean; override;
|
||||
function CreateBreakPoints: TDBGBreakPoints; override;
|
||||
@ -158,8 +158,22 @@ type
|
||||
constructor Create(const ADebugger: TDebugger);
|
||||
end;
|
||||
|
||||
TGDBMIExpression = class(TObject)
|
||||
private
|
||||
FDebugger: TGDBMIDebugger;
|
||||
FOperator: String;
|
||||
FLeft: TGDBMIExpression;
|
||||
FRight: TGDBMIExpression;
|
||||
procedure CreateSubExpression(const AExpression: String);
|
||||
protected
|
||||
public
|
||||
constructor Create(const ADebugger: TGDBMIDebugger; const AExpression: String);
|
||||
destructor Destroy; override;
|
||||
function DumpExpression: String;
|
||||
function GetExpression(var AResult: String): Boolean;
|
||||
end;
|
||||
|
||||
function CreateValueList(AResultValues: String): TStringList;
|
||||
function CreateMIValueList(AResultValues: String): TStringList;
|
||||
var
|
||||
n: Integer;
|
||||
InString: Boolean;
|
||||
@ -245,6 +259,20 @@ begin
|
||||
then Result.Add(AResultValues);
|
||||
end;
|
||||
|
||||
function CreateValueList(AResultValues: String): TStringList;
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
Result := TStringList.Create;
|
||||
if AResultValues = '' then Exit;
|
||||
n := Pos(' = ', AResultValues);
|
||||
if n > 0
|
||||
then begin
|
||||
Delete(AResultValues, n, 1);
|
||||
Delete(AResultValues, n + 1, 1);
|
||||
end;
|
||||
Result.Add(AResultValues);
|
||||
end;
|
||||
|
||||
|
||||
{ =========================================================================== }
|
||||
@ -256,21 +284,21 @@ function TGDBMIDebugger.ChangeFileName: Boolean;
|
||||
// S: String;
|
||||
begin
|
||||
FHasSymbols := True; // True untilproven otherwise
|
||||
Result := ExecuteCommand('-file-exec-and-symbols %s', [FileName]) and inherited ChangeFileName;
|
||||
Result := ExecuteCommand('-file-exec-and-symbols %s', [FileName], False) and inherited ChangeFileName;
|
||||
|
||||
if Result and FHasSymbols
|
||||
then begin
|
||||
// Force setting language
|
||||
// Setting extensions dumps GDB (bug #508)
|
||||
ExecuteCommand('-gdb-set language pascal');
|
||||
ExecuteCommand('-gdb-set language pascal', False);
|
||||
(*
|
||||
ExecuteCommand('-gdb-set extension-language .lpr pascal');
|
||||
ExecuteCommand('-gdb-set extension-language .lpr pascal', False);
|
||||
if not FHasSymbols then Exit; // file-exec-and-symbols not allways result in no symbols
|
||||
ExecuteCommand('-gdb-set extension-language .lrs pascal');
|
||||
ExecuteCommand('-gdb-set extension-language .dpr pascal');
|
||||
ExecuteCommand('-gdb-set extension-language .pas pascal');
|
||||
ExecuteCommand('-gdb-set extension-language .pp pascal');
|
||||
ExecuteCommand('-gdb-set extension-language .inc pascal');
|
||||
ExecuteCommand('-gdb-set extension-language .lrs pascal', False);
|
||||
ExecuteCommand('-gdb-set extension-language .dpr pascal', False);
|
||||
ExecuteCommand('-gdb-set extension-language .pas pascal', False);
|
||||
ExecuteCommand('-gdb-set extension-language .pp pascal', False);
|
||||
ExecuteCommand('-gdb-set extension-language .inc pascal', False);
|
||||
*)
|
||||
end;
|
||||
end;
|
||||
@ -311,52 +339,52 @@ end;
|
||||
procedure TGDBMIDebugger.Done;
|
||||
begin
|
||||
if State = dsRun then GDBPause;
|
||||
ExecuteCommand('-gdb-exit');
|
||||
ExecuteCommand('-gdb-exit', False);
|
||||
inherited Done;
|
||||
end;
|
||||
|
||||
function TGDBMIDebugger.ExecuteCommand(const ACommand: String): Boolean;
|
||||
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; const ANoMICommand: Boolean): Boolean;
|
||||
var
|
||||
S: String;
|
||||
ResultState: TDBGState;
|
||||
begin
|
||||
Result := ExecuteCommand(ACommand, [], False, ResultState, S);
|
||||
Result := ExecuteCommand(ACommand, [], False, ResultState, S, ANoMICommand);
|
||||
end;
|
||||
|
||||
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; var AResultValues: String): Boolean;
|
||||
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; var AResultValues: String; const ANoMICommand: Boolean): Boolean;
|
||||
var
|
||||
ResultState: TDBGState;
|
||||
begin
|
||||
Result := ExecuteCommand(ACommand, [], False, ResultState, AResultValues);
|
||||
Result := ExecuteCommand(ACommand, [], False, ResultState, AResultValues, ANoMICommand);
|
||||
end;
|
||||
|
||||
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; AValues: array of const): Boolean;
|
||||
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; AValues: array of const; const ANoMICommand: Boolean): Boolean;
|
||||
var
|
||||
S: String;
|
||||
ResultState: TDBGState;
|
||||
begin
|
||||
Result := ExecuteCommand(ACommand, AValues, False, ResultState, S);
|
||||
Result := ExecuteCommand(ACommand, AValues, False, ResultState, S, ANoMICommand);
|
||||
end;
|
||||
|
||||
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; AValues: array of const; var AResultValues: String): Boolean;
|
||||
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; AValues: array of const; var AResultValues: String; const ANoMICommand: Boolean): Boolean;
|
||||
var
|
||||
ResultState: TDBGState;
|
||||
begin
|
||||
Result := ExecuteCommand(ACommand, AValues, False, ResultState, AResultValues);
|
||||
Result := ExecuteCommand(ACommand, AValues, False, ResultState, AResultValues, ANoMICommand);
|
||||
end;
|
||||
|
||||
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; AValues: array of const; var AResultState: TDBGState; var AResultValues: String): Boolean;
|
||||
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; AValues: array of const; var AResultState: TDBGState; var AResultValues: String; const ANoMICommand: Boolean): Boolean;
|
||||
begin
|
||||
Result := ExecuteCommand(ACommand, AValues, False, AResultState, AResultValues);
|
||||
Result := ExecuteCommand(ACommand, AValues, False, AResultState, AResultValues, ANoMICommand);
|
||||
end;
|
||||
|
||||
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; AValues: array of const; const AIgnoreError: Boolean; var AResultState: TDBGState; var AResultValues: String): Boolean;
|
||||
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; AValues: array of const; const AIgnoreError: Boolean; var AResultState: TDBGState; var AResultValues: String; const ANoMICommand: Boolean): Boolean;
|
||||
begin
|
||||
FCommandQueue.Add(ACommand);
|
||||
FCommandQueue.AddObject(ACommand, TObject(Integer(ANoMICommand)));
|
||||
if FCommandQueue.Count > 1 then Exit;
|
||||
repeat
|
||||
SendCmdLn(FCommandQueue[0], AValues);
|
||||
Result := ProcessResult(AResultState, AResultValues);
|
||||
Result := ProcessResult(AResultState, AResultValues, Boolean(Integer(FCommandQueue.Objects[0])));
|
||||
if Result
|
||||
then begin
|
||||
if (AResultState <> dsNone)
|
||||
@ -392,13 +420,20 @@ end;
|
||||
function TGDBMIDebugger.GDBEvaluate(const AExpression: String; var AResult: String): Boolean;
|
||||
var
|
||||
ResultState: TDBGState;
|
||||
ResultValues: String;
|
||||
S, ResultValues: String;
|
||||
ResultList: TStringList;
|
||||
Expression: TGDBMIExpression;
|
||||
begin
|
||||
Result := ExecuteCommand('-data-evaluate-expression %s', [AExpression], True, ResultState, ResultValues)
|
||||
Expression := TGDBMIExpression.Create(Self, AExpression);
|
||||
if not Expression.GetExpression(S)
|
||||
then S := AExpression;
|
||||
WriteLN('[GDBEval] AskExpr: ', AExpression, ' EvalExp:', S ,' Dump: ', Expression.DumpExpression);
|
||||
Expression.Free;
|
||||
|
||||
Result := ExecuteCommand('-data-evaluate-expression %s', [S], True, ResultState, ResultValues, False)
|
||||
and (ResultState <> dsError);
|
||||
|
||||
ResultList := CreateValueList(ResultValues);
|
||||
ResultList := CreateMIValueList(ResultValues);
|
||||
if ResultState = dsError
|
||||
then AResult := ResultList.Values['msg']
|
||||
else AResult := ResultList.Values['value'];
|
||||
@ -424,14 +459,14 @@ begin
|
||||
GDBStart;
|
||||
if State = dsPause
|
||||
then begin
|
||||
Result := ExecuteCommand('-exec-continue');
|
||||
Result := ExecuteCommand('-exec-continue', False);
|
||||
end
|
||||
else begin
|
||||
//error???
|
||||
end;
|
||||
end;
|
||||
dsPause: begin
|
||||
Result := ExecuteCommand('-exec-continue');
|
||||
Result := ExecuteCommand('-exec-continue', False);
|
||||
end;
|
||||
dsIdle: begin
|
||||
WriteLN('[WARNING] Debugger: Unable to run in idle state');
|
||||
@ -444,7 +479,7 @@ begin
|
||||
Result := False;
|
||||
if State in [dsRun, dsError] then Exit;
|
||||
|
||||
Result := ExecuteCommand('-exec-until %s:%d', [ASource, ALine]);
|
||||
Result := ExecuteCommand('-exec-until %s:%d', [ASource, ALine], False);
|
||||
end;
|
||||
|
||||
function TGDBMIDebugger.GDBStart: Boolean;
|
||||
@ -457,21 +492,35 @@ begin
|
||||
if FHasSymbols
|
||||
then begin
|
||||
if Arguments <>''
|
||||
then ExecuteCommand('-exec-arguments %s', [Arguments]);
|
||||
ExecuteCommand('-break-insert -t main');
|
||||
ExecuteCommand('-exec-run');
|
||||
then ExecuteCommand('-exec-arguments %s', [Arguments], False);
|
||||
ExecuteCommand('-break-insert -t main', False);
|
||||
ExecuteCommand('-exec-run', False);
|
||||
|
||||
// try to find PID
|
||||
|
||||
//(*
|
||||
SendCmdLn('info program', []);
|
||||
ReadLine; // skip repeated command
|
||||
S := ReadLine;
|
||||
FTargetPID := StrToIntDef(GetPart('child process ', '.', S), 0);
|
||||
if ProcessResult(ResultState, S)
|
||||
//*)
|
||||
// if ExecuteCommand('info program', [], True, ResultState, S, True)
|
||||
// then begin
|
||||
FTargetPID := StrToIntDef(GetPart('child process ', '.', S), 0);
|
||||
// if ResultState = dsNone
|
||||
// then SetState(dsPause)
|
||||
// else SetState(ResultState);
|
||||
// end
|
||||
// else FTargetPID := 0;
|
||||
|
||||
//(*
|
||||
if ProcessResult(ResultState, S, True)
|
||||
then begin
|
||||
if ResultState = dsNone
|
||||
then SetState(dsPause)
|
||||
else SetState(ResultState);
|
||||
end;
|
||||
//*)
|
||||
|
||||
end;
|
||||
end;
|
||||
Result := True;
|
||||
@ -484,7 +533,7 @@ begin
|
||||
Result := GDBStart;
|
||||
end;
|
||||
dsPause: begin
|
||||
Result := ExecuteCommand('-exec-step');
|
||||
Result := ExecuteCommand('-exec-step', False);
|
||||
end;
|
||||
else
|
||||
Result := False;
|
||||
@ -498,7 +547,7 @@ begin
|
||||
Result := GDBStart;
|
||||
end;
|
||||
dsPause: begin
|
||||
Result := ExecuteCommand('-exec-next');
|
||||
Result := ExecuteCommand('-exec-next', False);
|
||||
end;
|
||||
else
|
||||
Result := False;
|
||||
@ -523,12 +572,27 @@ begin
|
||||
then begin
|
||||
// not supported yet
|
||||
// ExecuteCommand('-exec-abort');
|
||||
ExecuteCommand('kill');
|
||||
ExecuteCommand('kill', True);
|
||||
SetState(dsStop); //assume stop until abort is supported;
|
||||
end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TGDBMIDebugger.GetGDBTypeInfo(const AExpression: String): TGDBType;
|
||||
var
|
||||
ResultState: TDBGState;
|
||||
ResultValues: String;
|
||||
begin
|
||||
if not ExecuteCommand('ptype %s', [AExpression], True, ResultState, ResultValues, True)
|
||||
or (ResultState = dsError)
|
||||
then begin
|
||||
Result := nil;
|
||||
end
|
||||
else begin
|
||||
Result := TGdbType.CreateFromValues(ResultValues);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGDBMIDebugger.GetSupportedCommands: TDBGCommands;
|
||||
begin
|
||||
Result := [dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak{, dcWatch}, dcLocal, dcEvaluate, dcModify]
|
||||
@ -551,7 +615,7 @@ begin
|
||||
if S <> ''
|
||||
then MessageDlg('Debugger', 'Initialization output: ' + LINE_END + S, mtInformation, [mbOK], 0);
|
||||
|
||||
ExecuteCommand('-gdb-set confirm off');
|
||||
ExecuteCommand('-gdb-set confirm off', False);
|
||||
inherited Init;
|
||||
end
|
||||
else begin
|
||||
@ -562,7 +626,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGDBMIDebugger.ProcessResult(var ANewState: TDBGState; var AResultValues: String): Boolean;
|
||||
function TGDBMIDebugger.ProcessResult(var ANewState: TDBGState; var AResultValues: String; const ANoMICommand: Boolean): Boolean;
|
||||
var
|
||||
S: String;
|
||||
begin
|
||||
@ -575,8 +639,14 @@ begin
|
||||
then begin
|
||||
case S[1] of
|
||||
'^': begin // result-record
|
||||
AResultValues := S;
|
||||
S := GetPart('^', ',', AResultValues);
|
||||
if ANoMICommand
|
||||
then begin
|
||||
S := GetPart('^', ',', S);
|
||||
end
|
||||
else begin
|
||||
AResultValues := S;
|
||||
S := GetPart('^', ',', AResultValues);
|
||||
end;
|
||||
if S = 'done'
|
||||
then begin
|
||||
Result := True;
|
||||
@ -605,6 +675,10 @@ begin
|
||||
FHasSymbols := False;
|
||||
WriteLN('WARNING: File ''',FileName, ''' has no debug symbols');
|
||||
end
|
||||
else if ANoMICommand
|
||||
then begin
|
||||
AResultValues := AResultValues + Copy(S, 3, Length(S) - 5) + LINE_END;
|
||||
end
|
||||
else begin
|
||||
WriteLN('[Debugger] Console output: ', S);
|
||||
end;
|
||||
@ -703,7 +777,7 @@ function TGDBMIDebugger.ProcessStopped(const AParams: String): Boolean;
|
||||
Frame: TStringList;
|
||||
Location: TDBGLocationRec;
|
||||
begin
|
||||
Frame := CreateValueList(AFrame);
|
||||
Frame := CreateMIValueList(AFrame);
|
||||
|
||||
Location.Adress := Pointer(StrToIntDef(Frame.Values['addr'], 0));
|
||||
Location.FuncName := Frame.Values['func'];
|
||||
@ -721,7 +795,7 @@ var
|
||||
BreakPoint: TGDBMIBreakPoint;
|
||||
begin
|
||||
Result := True;
|
||||
List := CreateValueList(AParams);
|
||||
List := CreateMIValueList(AParams);
|
||||
Reason := List.Values['reason'];
|
||||
if Reason = 'exited-normally'
|
||||
then begin
|
||||
@ -761,7 +835,7 @@ begin
|
||||
ProcessFrame(List.Values['frame']);
|
||||
end
|
||||
else begin
|
||||
ExecuteCommand('-exec-continue');
|
||||
ExecuteCommand('-exec-continue', False);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
@ -804,7 +878,7 @@ end;
|
||||
|
||||
procedure TGDBMIDebugger.TestCmd(const ACommand: String);
|
||||
begin
|
||||
ExecuteCommand(ACommand);
|
||||
ExecuteCommand(ACommand, False);
|
||||
end;
|
||||
|
||||
{ =========================================================================== }
|
||||
@ -822,7 +896,7 @@ begin
|
||||
if (FBreakID <> 0)
|
||||
and (Debugger <> nil)
|
||||
then begin
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-break-delete %d', [FBreakID]);
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-break-delete %d', [FBreakID], False);
|
||||
end;
|
||||
|
||||
inherited Destroy;
|
||||
@ -840,7 +914,7 @@ begin
|
||||
or (Debugger = nil)
|
||||
then Exit;
|
||||
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-break-%s %d', [CMD[Enabled], FBreakID]);
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-break-%s %d', [CMD[Enabled], FBreakID], False);
|
||||
end;
|
||||
|
||||
procedure TGDBMIBreakPoint.DoExpressionChange;
|
||||
@ -850,7 +924,7 @@ end;
|
||||
procedure TGDBMIBreakPoint.DoStateChange;
|
||||
begin
|
||||
inherited;
|
||||
if (Debugger.State = dsStop)
|
||||
if (Debugger.State in [dsStop, dsPause])
|
||||
and (FBreakID = 0)
|
||||
then SetBreakpoint;
|
||||
end;
|
||||
@ -872,9 +946,9 @@ var
|
||||
begin
|
||||
if Debugger = nil then Exit;
|
||||
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-break-insert %s:%d', [Source, Line], True, ResultState, S);
|
||||
ResultList := CreateValueList(S);
|
||||
BkptList := CreateValueList(ResultList.Values['bkpt']);
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-break-insert %s:%d', [Source, Line], True, ResultState, S, False);
|
||||
ResultList := CreateMIValueList(S);
|
||||
BkptList := CreateMIValueList(ResultList.Values['bkpt']);
|
||||
FBreakID := StrToIntDef(BkptList.Values['number'], 0);
|
||||
SetHitCount(StrToIntDef(BkptList.Values['times'], 0));
|
||||
SetValid(FBreakID <> 0);
|
||||
@ -902,10 +976,10 @@ var
|
||||
LocList, List: TStrings;
|
||||
Name: String;
|
||||
begin
|
||||
LocList := CreateValueList(AParams);
|
||||
LocList := CreateMIValueList(AParams);
|
||||
for n := 0 to LocList.Count - 1 do
|
||||
begin
|
||||
List := CreateValueList(LocList[n]);
|
||||
List := CreateMIValueList(LocList[n]);
|
||||
Name := List.Values['name'];
|
||||
if Name = 'this'
|
||||
then Name := 'Self';
|
||||
@ -984,8 +1058,8 @@ begin
|
||||
if Debugger = nil then Exit;
|
||||
if not FLocalsValid
|
||||
then begin
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-list-locals 1', S);
|
||||
List := CreateValueList(S);
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-list-locals 1', S, False);
|
||||
List := CreateMIValueList(S);
|
||||
AddLocals(List.Values['locals']);
|
||||
FreeAndNil(List);
|
||||
FLocalsValid := True;
|
||||
@ -1075,34 +1149,34 @@ begin
|
||||
if Debugger = nil then Exit;
|
||||
|
||||
Arguments := TStringList.Create;
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-list-arguments 1 %d %d', [AIndex, AIndex], S);
|
||||
List := CreateValueList(S);
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-list-arguments 1 %d %d', [AIndex, AIndex], S, False);
|
||||
List := CreateMIValueList(S);
|
||||
S := List.Values['stack-args'];
|
||||
FreeAndNil(List);
|
||||
List := CreateValueList(S);
|
||||
List := CreateMIValueList(S);
|
||||
S := List.Values['frame']; // all arguments
|
||||
FreeAndNil(List);
|
||||
List := CreateValueList(S);
|
||||
List := CreateMIValueList(S);
|
||||
S := List.Values['args'];
|
||||
FreeAndNil(List);
|
||||
|
||||
ArgList := CreateValueList(S);
|
||||
ArgList := CreateMIValueList(S);
|
||||
for n := 0 to ArgList.Count - 1 do
|
||||
begin
|
||||
List := CreateValueList(ArgList[n]);
|
||||
List := CreateMIValueList(ArgList[n]);
|
||||
Arguments.Add(List.Values['name'] + '=' + List.Values['value']);
|
||||
FreeAndNil(List);
|
||||
end;
|
||||
FreeAndNil(ArgList);
|
||||
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-list-frames %d %d', [AIndex, AIndex], S);
|
||||
List := CreateValueList(S);
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-list-frames %d %d', [AIndex, AIndex], S, False);
|
||||
List := CreateMIValueList(S);
|
||||
S := List.Values['stack'];
|
||||
FreeAndNil(List);
|
||||
List := CreateValueList(S);
|
||||
List := CreateMIValueList(S);
|
||||
S := List.Values['frame'];
|
||||
FreeAndNil(List);
|
||||
List := CreateValueList(S);
|
||||
List := CreateMIValueList(S);
|
||||
Result := TDBGCallStackEntry.Create(
|
||||
AIndex,
|
||||
Pointer(StrToIntDef(List.Values['addr'], 0)),
|
||||
@ -1133,8 +1207,8 @@ begin
|
||||
if Debugger = nil
|
||||
then FCount := 0
|
||||
else begin
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-info-depth', S);
|
||||
List := CreateValueList(S);
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-info-depth', S, False);
|
||||
List := CreateMIValueList(S);
|
||||
FCount := StrToIntDef(List.Values['depth'], 0);
|
||||
FreeAndNil(List);
|
||||
end;
|
||||
@ -1143,9 +1217,280 @@ begin
|
||||
Result := FCount;
|
||||
end;
|
||||
|
||||
{ =========================================================================== }
|
||||
{ TGDBMIExpression }
|
||||
{ =========================================================================== }
|
||||
|
||||
constructor TGDBMIExpression.Create(const ADebugger: TGDBMIDebugger; const AExpression: String);
|
||||
begin
|
||||
inherited Create;
|
||||
FDebugger := ADebugger;
|
||||
FLeft := nil;
|
||||
FRight := nil;
|
||||
CreateSubExpression(Trim(AExpression));
|
||||
end;
|
||||
|
||||
procedure TGDBMIExpression.CreateSubExpression(const AExpression: String);
|
||||
function CheckOperator(const APos: Integer; const AOperator: String): Boolean;
|
||||
var
|
||||
S: String;
|
||||
begin
|
||||
Result := False;
|
||||
if APos + Length(AOperator) > Length(AExpression) then Exit;
|
||||
if StrLIComp(@AExpression[APos], @AOperator[1], Length(AOperator)) <> 0 then Exit;
|
||||
if (APos > 1) and not (AExpression[APos - 1] in [' ', '(']) then Exit;
|
||||
if (APos + Length(AOperator) <= Length(AExpression)) and not (AExpression[APos + Length(AOperator)] in [' ', '(']) then Exit;
|
||||
|
||||
S := Copy(AExpression, 1, APos - 1);
|
||||
if S <> ''
|
||||
then FLeft := TGDBMIExpression.Create(FDebugger, S);
|
||||
S := Copy(AExpression, APos + Length(AOperator), MaxInt);
|
||||
if S <> ''
|
||||
then FRight := TGDBMIExpression.Create(FDebugger, S);
|
||||
FOperator := AOperator;
|
||||
Result := True;
|
||||
end;
|
||||
type
|
||||
TStringState = (ssNone, ssString, ssLeave);
|
||||
var
|
||||
n: Integer;
|
||||
S, LastWord: String;
|
||||
HookCount: Integer;
|
||||
InString: TStringState;
|
||||
Sub: TGDBMIExpression;
|
||||
begin
|
||||
HookCount := 0;
|
||||
InString := ssNone;
|
||||
LastWord := '';
|
||||
for n := 1 to Length(AExpression) do
|
||||
begin
|
||||
if AExpression[n] = ''''
|
||||
then begin
|
||||
case InString of
|
||||
ssNone: InString := ssString;
|
||||
ssString:InString := ssLeave;
|
||||
ssLeave: InString := ssString;
|
||||
end;
|
||||
S := S + AExpression[n];
|
||||
LastWord := '';
|
||||
Continue;
|
||||
end;
|
||||
if InString = ssString
|
||||
then begin
|
||||
S := S + AExpression[n];
|
||||
LastWord := '';
|
||||
Continue;
|
||||
end;
|
||||
InString := ssNone;
|
||||
|
||||
case AExpression[n] of
|
||||
'(', '[': begin
|
||||
if HookCount = 0
|
||||
then begin
|
||||
SetLength(S, Length(S) - Length(LastWord));
|
||||
if S <> ''
|
||||
then FLeft := TGDBMIExpression.Create(FDebugger, S);
|
||||
if LastWord = ''
|
||||
then begin
|
||||
FOperator := AExpression[n];
|
||||
end
|
||||
else begin
|
||||
FOperator := LastWord;
|
||||
FRight := TGDBMIExpression.Create(FDebugger, '');
|
||||
FRight.FOperator := AExpression[n];
|
||||
end;
|
||||
LastWord := '';
|
||||
S := '';
|
||||
end;
|
||||
Inc(HookCount);
|
||||
if HookCount = 1
|
||||
then Continue;
|
||||
end;
|
||||
')', ']': begin
|
||||
Dec(HookCount);
|
||||
if HookCount = 0
|
||||
then begin
|
||||
if S <> ''
|
||||
then begin
|
||||
if FRight = nil
|
||||
then FRight := TGDBMIExpression.Create(FDebugger, S)
|
||||
else FRight.FRight := TGDBMIExpression.Create(FDebugger, S);
|
||||
end;
|
||||
if n < Length(AExpression)
|
||||
then begin
|
||||
Sub := TGDBMIExpression.Create(FDebugger, '');
|
||||
Sub.FLeft := FLeft;
|
||||
Sub.FOperator := FOperator;
|
||||
Sub.FRight := FRight;
|
||||
FLeft := Sub;
|
||||
Sub := TGDBMIExpression.Create(FDebugger, Copy(AExpression, n + 1, MaxInt));
|
||||
if Sub.FLeft = nil
|
||||
then begin
|
||||
FOperator := Sub.FOperator;
|
||||
FRight := Sub.FRight;
|
||||
Sub.FRight := nil;
|
||||
Sub.Free;
|
||||
end
|
||||
else begin
|
||||
FOperator := '';
|
||||
FRight := Sub;
|
||||
end;
|
||||
end;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if HookCount = 0
|
||||
then begin
|
||||
case AExpression[n] of
|
||||
'-', '+', '*', '/', '^', '@', '=', ',': begin
|
||||
if S <> ''
|
||||
then FLeft := TGDBMIExpression.Create(FDebugger, S);
|
||||
S := Copy(AExpression, n + 1, MaxInt);
|
||||
if Trim(S) <> ''
|
||||
then FRight := TGDBMIExpression.Create(FDebugger, S);
|
||||
FOperator := AExpression[n];
|
||||
Exit;
|
||||
end;
|
||||
'a', 'A': begin
|
||||
if CheckOperator(n, 'and') then Exit;
|
||||
end;
|
||||
'o', 'O': begin
|
||||
if CheckOperator(n, 'or') then Exit;
|
||||
end;
|
||||
'm', 'M': begin
|
||||
if CheckOperator(n, 'mod') then Exit;
|
||||
end;
|
||||
'd', 'D': begin
|
||||
if CheckOperator(n, 'div') then Exit;
|
||||
end;
|
||||
'x', 'X': begin
|
||||
if CheckOperator(n, 'xor') then Exit;
|
||||
end;
|
||||
's', 'S': begin
|
||||
if CheckOperator(n, 'shl') then Exit;
|
||||
if CheckOperator(n, 'shr') then Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if AExpression[n] = ' '
|
||||
then LastWord := ''
|
||||
else LastWord := LastWord + AExpression[n];
|
||||
S := S + AExpression[n];
|
||||
end;
|
||||
if S = AExpression
|
||||
then FOperator := S
|
||||
else CreateSubExpression(S);
|
||||
end;
|
||||
|
||||
destructor TGDBMIExpression.Destroy;
|
||||
begin
|
||||
FreeAndNil(FRight);
|
||||
FreeAndNil(FLeft);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TGDBMIExpression.DumpExpression: String;
|
||||
// Mainly used for debugging purposes
|
||||
begin
|
||||
if FLeft = nil
|
||||
then Result := ''
|
||||
else Result := '«L:' + FLeft.DumpExpression + '»';
|
||||
|
||||
if FOperator = '('
|
||||
then Result := Result + '(«R:' + FRight.DumpExpression + '»)'
|
||||
else if FOperator = '['
|
||||
then Result := Result + '[«R:' + FRight.DumpExpression + '»]'
|
||||
else begin
|
||||
if (Length(FOperator) > 0)
|
||||
and (FOperator[1] = '''')
|
||||
then Result := Result + '«O:' + ConvertToCString(FOperator) + '»'
|
||||
else Result := Result + '«O:' + FOperator + '»';
|
||||
if FRight <> nil
|
||||
then Result := Result + '«R:' + FRight.DumpExpression + '»';
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGDBMIExpression.GetExpression(var AResult: String): Boolean;
|
||||
var
|
||||
ResultState: TDBGState;
|
||||
S, ResultValues: String;
|
||||
List: TStrings;
|
||||
GDBType: TGDBType;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if FLeft = nil
|
||||
then AResult := ''
|
||||
else begin
|
||||
if not FLeft.GetExpression(S) then Exit;
|
||||
AResult := S;
|
||||
end;
|
||||
|
||||
if FOperator = '('
|
||||
then begin
|
||||
if not FRight.GetExpression(S) then Exit;
|
||||
AResult := AResult + '(' + S + ')';
|
||||
end
|
||||
else if FOperator = '['
|
||||
then begin
|
||||
if not FRight.GetExpression(S) then Exit;
|
||||
AResult := AResult + '[' + S + ']';
|
||||
end
|
||||
else begin
|
||||
if (Length(FOperator) > 0)
|
||||
and (FOperator[1] = '''')
|
||||
then AResult := AResult + ConvertToCString(FOperator)
|
||||
else begin
|
||||
GDBType := FDebugger.GetGDBTypeInfo(FOperator);
|
||||
if GDBType = nil
|
||||
then begin
|
||||
// no type possible, use literal operator
|
||||
AResult := AResult + FOperator;
|
||||
end;
|
||||
|
||||
if not FDebugger.ExecuteCommand('ptype %s', [FOperator], True, ResultState, ResultValues, True) then Exit;
|
||||
if ResultState = dsError
|
||||
then begin
|
||||
// no type possible, use literal operator
|
||||
AResult := AResult + FOperator;
|
||||
end
|
||||
else begin
|
||||
WriteLN('PType result: ', ResultValues);
|
||||
List := CreateValueList(ResultValues);
|
||||
S := List.Values['type'];
|
||||
WriteLN('PType type: ', S);
|
||||
List.Free;
|
||||
if (S <> '') and (S[1] = '^') and (Pos('class', S) <> 0)
|
||||
then begin
|
||||
AResult := AResult + GetPart('^', ' ', S) + '(' + FOperator + ')';
|
||||
end
|
||||
else begin
|
||||
// no type possible or no class, use literal operator
|
||||
AResult := AResult + FOperator;
|
||||
end
|
||||
end;
|
||||
end;
|
||||
if FRight <> nil
|
||||
then begin
|
||||
if not FRight.GetExpression(S) then Exit;
|
||||
AResult := AResult + S;
|
||||
end;
|
||||
end;
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
end.
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.9 2003/05/22 23:08:19 marc
|
||||
MWE: = Moved and renamed debuggerforms so that they can be
|
||||
modified by the ide
|
||||
+ Added some parsing to evaluate complex expressions
|
||||
not understood by the debugger
|
||||
|
||||
Revision 1.8 2002/11/05 22:41:13 lazarus
|
||||
MWE:
|
||||
* Some minor debugger updates
|
||||
|
||||
606
debugger/gdbtypeinfo.pp
Normal file
606
debugger/gdbtypeinfo.pp
Normal file
@ -0,0 +1,606 @@
|
||||
{ $Id$ }
|
||||
{ ----------------------------------------------
|
||||
GDBTypeInfo.pp - Debugger helper class
|
||||
----------------------------------------------
|
||||
|
||||
@created(Wed Mar 29th WET 2003)
|
||||
@lastmod($Date$)
|
||||
@author(Marc Weustink <marc@@dommelstein.net>)
|
||||
|
||||
This unit contains a helper class for decoding PType output.
|
||||
|
||||
|
||||
***************************************************************************
|
||||
* *
|
||||
* This source is free software; you can redistribute it and/or modify *
|
||||
* it under the terms of the GNU General Public License as published by *
|
||||
* the Free Software Foundation; either version 2 of the License, or *
|
||||
* (at your option) any later version. *
|
||||
* *
|
||||
* This code is distributed in the hope that it will be useful, but *
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
||||
* General Public License for more details. *
|
||||
* *
|
||||
* A copy of the GNU General Public License is available on the World *
|
||||
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
||||
* obtain it by writing to the Free Software Foundation, *
|
||||
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
||||
* *
|
||||
***************************************************************************
|
||||
}
|
||||
unit GDBTypeInfo;
|
||||
{$mode objfpc}{$H+}
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
(*
|
||||
ptype = {
|
||||
family = "class" | "record" | "enum" | "set" | "procedure" | "function" | "simple" | "pointer"
|
||||
[ ancestor = "...", ]
|
||||
[ private = "[" ( "{" name = "...", type = ptype "}" )* "}," ]
|
||||
[ protected = "[" ( "{" name = "...", type = ptype "}" )* "}," ]
|
||||
[ public = "[" ( "{" name = "...", type = ptype "}" )* "},"]
|
||||
[ published = "[" ( "{" name = "...", type = ptype "}" )* "}," ]
|
||||
[ members = "[" ( "..." )* "]," | "[" ( "{" name = "...", type = "..." "}" )* "]," ]
|
||||
[ args = "[" ( "..." )* "]," ]
|
||||
[ result = "..." ]
|
||||
[ name = "..." ]
|
||||
[ type = "..." ]
|
||||
*)
|
||||
type
|
||||
TGDBSymbolKind = (skClass, skRecord, skEnum, skSet, skProcedure, skFunction, skSimple, skPointer);
|
||||
TGDBFieldLocation = (flPrivate, flProtected, flPublic, flPublished);
|
||||
TGDBFieldFlag = (ffVirtual);
|
||||
TGDBFieldFlags = set of TGDBFieldFlag;
|
||||
|
||||
TGDBType = class;
|
||||
TGDBField = class(TObject)
|
||||
private
|
||||
FName: String;
|
||||
FFlags: TGDBFieldFlags;
|
||||
FLocation: TGDBFieldLocation;
|
||||
FGDBType: TGDBType;
|
||||
protected
|
||||
public
|
||||
constructor Create;
|
||||
property Name: String read FName;
|
||||
property GDBType: TGDBType read FGDBType;
|
||||
property Location: TGDBFieldLocation read FLocation;
|
||||
property Flags: TGDBFieldFlags read FFlags;
|
||||
end;
|
||||
|
||||
TGDBFields = class(TObject)
|
||||
private
|
||||
FList: TList;
|
||||
function GetField(const AIndex: Integer): TGDBField;
|
||||
function GetCount: Integer;
|
||||
protected
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
property Count: Integer read GetCount;
|
||||
property Items[const AIndex: Integer]: TGDBField read GetField; default;
|
||||
end;
|
||||
|
||||
TGDBTypes = class(TObject)
|
||||
private
|
||||
FList: TList;
|
||||
function GetType(const AIndex: Integer): TGDBType;
|
||||
function GetCount: Integer;
|
||||
protected
|
||||
public
|
||||
constructor Create;
|
||||
constructor CreateFromCSV(AValues: String);
|
||||
destructor Destroy; override;
|
||||
property Count: Integer read GetCount;
|
||||
property Items[const AIndex: Integer]: TGDBType read GetType; default;
|
||||
end;
|
||||
|
||||
TGDBType = class(TObject)
|
||||
private
|
||||
FAncestor: String;
|
||||
FResult: TGDBType;
|
||||
FArguments: TGDBTypes;
|
||||
FFields: TGDBFields;
|
||||
FKind: TGDBSymbolKind;
|
||||
FMembers: TStrings;
|
||||
FTypeName: String;
|
||||
protected
|
||||
public
|
||||
constructor Create;
|
||||
constructor CreateFromValues(const AValues: String);
|
||||
property Ancestor: String read FAncestor;
|
||||
property Arguments: TGDBTypes read FArguments;
|
||||
property Fields: TGDBFields read FFields;
|
||||
property Kind: TGDBSymbolKind read FKind;
|
||||
property TypeName: String read FTypeName;
|
||||
property Members: TStrings read FMembers;
|
||||
property Result: TGDBType read FResult;
|
||||
end;
|
||||
|
||||
|
||||
function CreatePTypeValueList(AResultValues: String): TStringList;
|
||||
|
||||
implementation
|
||||
|
||||
function GetPart(const ASkipTo, AnEnd: array of String; var ASource: String): String;
|
||||
var
|
||||
n, i, idx, SkipLen: Integer;
|
||||
begin
|
||||
idx := 0;
|
||||
SkipLen := 0;
|
||||
if High(ASkipTo) <> -1
|
||||
then begin
|
||||
for n := Low(ASkipTo) to High(ASkipTo) do
|
||||
begin
|
||||
if ASkipTo[n] <> ''
|
||||
then begin
|
||||
i := Pos(ASkipTo[n], ASource);
|
||||
if (i > 0) and ((idx = 0) or (i < idx))
|
||||
then begin
|
||||
idx := i;
|
||||
SkipLen := Length(ASkipTo[n]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if idx = 0
|
||||
then begin
|
||||
Result := '';
|
||||
Exit;
|
||||
end;
|
||||
Delete(ASource, 1, idx + SkipLen - 1);
|
||||
end;
|
||||
|
||||
idx := 0;
|
||||
for n := Low(AnEnd) to High(AnEnd) do
|
||||
begin
|
||||
if AnEnd[n] <> ''
|
||||
then begin
|
||||
i := Pos(AnEnd[n], ASource);
|
||||
if (i > 0) and ((idx = 0) or (i < idx))
|
||||
then idx := i;
|
||||
end;
|
||||
end;
|
||||
|
||||
if idx = 0
|
||||
then begin
|
||||
Result := ASource;
|
||||
ASource := '';
|
||||
end
|
||||
else begin
|
||||
Result := Copy(ASource, 1, idx - 1);
|
||||
Delete(ASource, 1, idx - 1);
|
||||
end;
|
||||
end;
|
||||
|
||||
function CreatePTypeValueList(AResultValues: String): TStringList;
|
||||
var
|
||||
S, Line: String;
|
||||
Lines: TStringList;
|
||||
|
||||
procedure DoRecord;
|
||||
var
|
||||
n: Integer;
|
||||
S, Members: String;
|
||||
begin
|
||||
Result.Add('family=record');
|
||||
Members := '';
|
||||
|
||||
//concatinate all lines and skip last end
|
||||
S := '';
|
||||
for n := 0 to Lines.Count - 2 do
|
||||
S := S + Lines[n];
|
||||
|
||||
while S <> '' do
|
||||
begin
|
||||
if Members <> '' then Members := Members + ',';
|
||||
Members := Members + '{name=' + GetPart([' '], [' '], S);
|
||||
Members := Members + ',type=' + GetPart([' : '], [';'], S) + '}';
|
||||
end;
|
||||
Result.Add('members=[' + Members + ']');
|
||||
end;
|
||||
|
||||
procedure DoEnum;
|
||||
var
|
||||
n: Integer;
|
||||
S: String;
|
||||
begin
|
||||
Result.Add('family=enum');
|
||||
|
||||
S := GetPart(['('], [], Line);
|
||||
//concatinate all lines
|
||||
for n := 0 to Lines.Count - 1 do
|
||||
S := S + Lines[n];
|
||||
|
||||
S := GetPart([], [')'], S);
|
||||
Result.Add('members=[' + StringReplace(S, ' ', '', [rfReplaceAll]) + ']');
|
||||
end;
|
||||
|
||||
procedure DoProcedure;
|
||||
var
|
||||
n: Integer;
|
||||
S: String;
|
||||
begin
|
||||
Result.Add('family=procedure');
|
||||
|
||||
S := GetPart(['('], [''], Line);
|
||||
//concatinate all lines
|
||||
for n := 0 to Lines.Count - 1 do
|
||||
S := S + Lines[n];
|
||||
|
||||
S := GetPart([''], [')'], S);
|
||||
Result.Add('args=[' + StringReplace(S, ', ', ',', [rfReplaceAll]) + ']');
|
||||
end;
|
||||
|
||||
procedure DoFunction;
|
||||
var
|
||||
n: Integer;
|
||||
S, Args: String;
|
||||
begin
|
||||
Result.Add('family=function');
|
||||
|
||||
S := GetPart(['('], [], Line);
|
||||
//concatinate all lines
|
||||
for n := 0 to Lines.Count - 1 do
|
||||
S := S + Lines[n];
|
||||
|
||||
Args := GetPart([], [')'], S);
|
||||
S := GetPart([' : '], [], S);
|
||||
Result.Add('args=[' + StringReplace(Args, ', ', ',', [rfReplaceAll]) + ']');
|
||||
Result.Add('result=' + S);
|
||||
end;
|
||||
|
||||
procedure DoClass;
|
||||
begin
|
||||
Result.Add('family=class');
|
||||
Result.Add('ancestor=' + GetPart([': public '], [' '], Line));
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := TStringList.Create;
|
||||
if AResultValues = '' then Exit;
|
||||
|
||||
Lines := TStringList.Create;
|
||||
try
|
||||
Lines.Text := AResultValues;
|
||||
if Lines.Count = 0 then Exit;
|
||||
Line := Lines[0];
|
||||
Lines.Delete(0);
|
||||
|
||||
S := GetPart(['type = '], [' '], Line);
|
||||
if S = '' then Exit;
|
||||
if Pos(' = class ', Line) > 0
|
||||
then DoClass
|
||||
else if S[1] = '^'
|
||||
then begin
|
||||
Result.Add('family=pointer');
|
||||
Result.Add('type=' + GetPart(['^'], [' ='], S));
|
||||
end
|
||||
else if S = 'set'
|
||||
then begin
|
||||
Result.Add('family=set');
|
||||
Result.Add('type=' + Copy(Line, 5, Length(Line)));
|
||||
end
|
||||
else if S = 'procedure'
|
||||
then DoProcedure
|
||||
else if S = 'function'
|
||||
then DoFunction
|
||||
else if Pos(' = (', Line) > 0
|
||||
then DoEnum
|
||||
else if Pos(' = record', Line) > 0
|
||||
then DoRecord
|
||||
else begin
|
||||
Result.Add('family=simple');
|
||||
Result.Add('type=' + S);
|
||||
end;
|
||||
|
||||
finally
|
||||
Lines.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TGDBField }
|
||||
|
||||
constructor TGDBField.Create;
|
||||
begin
|
||||
FFlags := [];
|
||||
FGDBType := nil;
|
||||
FLocation := flPublic;
|
||||
end;
|
||||
|
||||
{ TGDBFields }
|
||||
|
||||
constructor TGDBFields.Create;
|
||||
begin
|
||||
FList := TList.Create;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
destructor TGDBFields.Destroy;
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
for n := 0 to Count - 1 do
|
||||
Items[n].Free;
|
||||
|
||||
FreeAndNil(FList);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TGDBFields.GetCount: Integer;
|
||||
begin
|
||||
Result := FList.Count;
|
||||
end;
|
||||
|
||||
function TGDBFields.GetField(const AIndex: Integer): TGDBField;
|
||||
begin
|
||||
Result := TGDBField(FList[AIndex]);
|
||||
end;
|
||||
|
||||
{ TGDBPType }
|
||||
|
||||
constructor TGDBType.Create;
|
||||
begin
|
||||
FResult := nil;
|
||||
FArguments := nil;
|
||||
FFields := nil;
|
||||
FMembers := nil;
|
||||
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
constructor TGDBType.CreateFromValues(const AValues: String);
|
||||
var
|
||||
S, Line: String;
|
||||
Lines: TStringList;
|
||||
|
||||
procedure DoRecord;
|
||||
var
|
||||
n: Integer;
|
||||
S: String;
|
||||
Field: TGDBField;
|
||||
begin
|
||||
FKind := skRecord;
|
||||
FFields := TGDBFields.Create;
|
||||
|
||||
//concatinate all lines and skip last end
|
||||
S := '';
|
||||
for n := 0 to Lines.Count - 2 do
|
||||
S := S + Lines[n];
|
||||
|
||||
while S <> '' do
|
||||
begin
|
||||
Field := TGDBField.Create;
|
||||
Field.FName := GetPart([' '], [' '], S);
|
||||
Field.FLocation := flPublic;
|
||||
Field.FGDBType := TGDBType.Create;
|
||||
Field.FGDBType.FKind := skSimple; // for now
|
||||
Field.FGDBType.FTypeName := GetPart([' : '], [';'], S);
|
||||
Delete(S, 1, 1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DoEnum;
|
||||
var
|
||||
n: Integer;
|
||||
S: String;
|
||||
begin
|
||||
FKind := skEnum;
|
||||
|
||||
S := GetPart(['('], [], Line);
|
||||
//concatinate all lines
|
||||
for n := 0 to Lines.Count - 1 do
|
||||
S := S + Lines[n];
|
||||
|
||||
S := GetPart([], [')'], S);
|
||||
FMembers := TStringList.Create;
|
||||
FMembers.Text := StringReplace(S, ' ', #13#10, [rfReplaceAll]);
|
||||
end;
|
||||
|
||||
procedure DoSet;
|
||||
var
|
||||
n: Integer;
|
||||
S: String;
|
||||
begin
|
||||
FKind := skSet;
|
||||
|
||||
S := Copy(Line, 5, Length(Line));
|
||||
for n := 0 to Lines.Count - 1 do
|
||||
S := S + Lines[n];
|
||||
|
||||
if Pos('=', S) = 0
|
||||
then FTypeName := S
|
||||
else begin
|
||||
S := GetPart(['('], [')'], S);
|
||||
FMembers := TStringList.Create;
|
||||
FMembers.Text := StringReplace(StringReplace(S, ',', #13#10, [rfReplaceAll]), ' ', '', [rfReplaceAll]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DoProcedure;
|
||||
var
|
||||
n: Integer;
|
||||
S: String;
|
||||
begin
|
||||
FKind := skProcedure;
|
||||
|
||||
S := GetPart(['('], [], Line);
|
||||
//concatinate all lines
|
||||
for n := 0 to Lines.Count - 1 do
|
||||
S := S + Lines[n];
|
||||
|
||||
S := GetPart([], [')'], S);
|
||||
FArguments := TGDBTypes.CreateFromCSV(S);
|
||||
end;
|
||||
|
||||
procedure DoFunction;
|
||||
var
|
||||
n: Integer;
|
||||
S: String;
|
||||
begin
|
||||
FKind := skFunction;
|
||||
|
||||
S := GetPart(['('], [], Line);
|
||||
//concatinate all lines
|
||||
for n := 0 to Lines.Count - 1 do
|
||||
S := S + Lines[n];
|
||||
|
||||
FArguments := TGDBTypes.CreateFromCSV(GetPart([], [')'], S));
|
||||
FResult := TGDBType.Create;
|
||||
FResult.FKind := skSimple; // for now
|
||||
FResult.FTypeName := GetPart([' : '], [], S);
|
||||
end;
|
||||
|
||||
procedure DoClass;
|
||||
var
|
||||
n: Integer;
|
||||
Field: TGDBField;
|
||||
S: String;
|
||||
Location: TGDBFieldLocation;
|
||||
begin
|
||||
FKind := skClass;
|
||||
FAncestor := GetPart([': public '], [' '], Line);
|
||||
FFields := TGDBFields.Create;
|
||||
|
||||
Location := flPublished;
|
||||
for n := 0 to Lines.Count - 2 do
|
||||
begin
|
||||
S := Lines[n];
|
||||
if S = '' then Continue;
|
||||
if S = ' private' then Location := flPrivate
|
||||
else if S = ' protected' then Location := flProtected
|
||||
else if S = ' public' then Location := flPublic
|
||||
else if S = ' published' then Location := flPublished
|
||||
else begin
|
||||
Field := TGDBField.Create;
|
||||
Field.FLocation := Location;
|
||||
Field.FGDBType := TGDBType.Create;
|
||||
FFields.FList.Add(Field);
|
||||
|
||||
if Pos(' procedure ', S) > 0
|
||||
then begin
|
||||
Field.FName := GetPart(['procedure '], [' ', ';'], S);
|
||||
Field.FGDBType.FKind := skProcedure;
|
||||
Field.FGDBType.FArguments := TGDBTypes.CreateFromCSV(GetPart(['('], [')'], S));
|
||||
if GetPart(['; '], [';'], S) = 'virtual'
|
||||
then Field.FFlags := [ffVirtual];
|
||||
end
|
||||
else if Pos(' function ', S) > 0
|
||||
then begin
|
||||
Field.FName := GetPart(['function '], [' ', ';'], S);
|
||||
Field.FGDBType.FKind := skFunction;
|
||||
Field.FGDBType.FArguments := TGDBTypes.CreateFromCSV(GetPart(['('], [')'], S));
|
||||
Field.FGDBType.FResult := TGDBType.Create;
|
||||
Field.FGDBType.FResult.FKind := skSimple; // for now
|
||||
Field.FGDBType.FResult.FTypeName := GetPart([' : '], [';'], S);
|
||||
if GetPart(['; '], [';'], S) = 'virtual'
|
||||
then Field.FFlags := [ffVirtual];
|
||||
end
|
||||
else begin
|
||||
Field.FName := GetPart([' '], [' '], S);
|
||||
Field.FGDBType.FKind := skSimple; // for now
|
||||
Field.FGDBType.FTypeName := GetPart([' : '], [';'], S);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
begin
|
||||
Create;
|
||||
|
||||
if AValues = '' then Exit;
|
||||
|
||||
Lines := TStringList.Create;
|
||||
try
|
||||
Lines.Text := AValues;
|
||||
if Lines.Count = 0 then Exit;
|
||||
|
||||
Line := Lines[0];
|
||||
Lines.Delete(0);
|
||||
|
||||
S := GetPart(['type = '], [' '], Line);
|
||||
if S = '' then Exit;
|
||||
if Pos(' = class ', Line) > 0
|
||||
then DoClass
|
||||
else if S[1] = '^'
|
||||
then begin
|
||||
FKind := skPointer;
|
||||
FTypeName := GetPart(['^'], [' ='], S);
|
||||
end
|
||||
else if S = 'set'
|
||||
then DoSet
|
||||
else if S = 'procedure'
|
||||
then DoProcedure
|
||||
else if S = 'function'
|
||||
then DoFunction
|
||||
else if Pos(' = (', Line) > 0
|
||||
then DoEnum
|
||||
else if Pos(' = record', Line) > 0
|
||||
then DoRecord
|
||||
else begin
|
||||
FKind := skSimple;
|
||||
FTypeName := S;
|
||||
end;
|
||||
|
||||
finally
|
||||
Lines.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TGDBPType }
|
||||
|
||||
constructor TGDBTypes.Create;
|
||||
begin
|
||||
FList := TList.Create;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
constructor TGDBTypes.CreateFromCSV(AValues: String);
|
||||
var
|
||||
GDBType: TGDBType;
|
||||
begin
|
||||
Create;
|
||||
while AValues <> '' do
|
||||
begin
|
||||
GDBType := TGDBType.Create;
|
||||
GDBType.FKind := skSimple;
|
||||
GDBType.FTypeName := GetPart([], [', '], AValues);
|
||||
FList.Add(GDBType);
|
||||
{if Length(AValues) >= 2 then} Delete(AValues, 1, 2);
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TGDBTypes.Destroy;
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
for n := 0 to Count - 1 do
|
||||
Items[n].Free;
|
||||
|
||||
FreeAndNil(FList);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TGDBTypes.GetCount: Integer;
|
||||
begin
|
||||
Result := Flist.Count;
|
||||
end;
|
||||
|
||||
function TGDBTypes.GetType(const AIndex: Integer): TGDBType;
|
||||
begin
|
||||
Result := TGDBType(FList[AIndex]);
|
||||
end;
|
||||
|
||||
end.
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.1 2003/05/22 23:08:19 marc
|
||||
MWE: = Moved and renamed debuggerforms so that they can be
|
||||
modified by the ide
|
||||
+ Added some parsing to evaluate complex expressions
|
||||
not understood by the debugger
|
||||
|
||||
}
|
||||
@ -1,88 +0,0 @@
|
||||
object BreakpointsDlg: TBreakpointsDlg
|
||||
Left = 340
|
||||
Top = 117
|
||||
Width = 500
|
||||
Height = 200
|
||||
Caption = 'Breakpoint list'
|
||||
object lvBreakPoints: TListView
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 484
|
||||
Height = 171
|
||||
Align = alClient
|
||||
Columns = <
|
||||
item
|
||||
Caption = 'State'
|
||||
Width = 50
|
||||
end
|
||||
item
|
||||
Caption = 'Filename/Address'
|
||||
Width = 150
|
||||
end
|
||||
item
|
||||
Caption = 'Line/Length'
|
||||
Width = 100
|
||||
end
|
||||
item
|
||||
Caption = 'Condition'
|
||||
Width = 75
|
||||
end
|
||||
item
|
||||
Caption = 'Action'
|
||||
Width = 50
|
||||
end
|
||||
item
|
||||
Caption = 'Pass Count'
|
||||
Width = 100
|
||||
end
|
||||
item
|
||||
Caption = 'Group'
|
||||
end>
|
||||
MultiSelect = True
|
||||
PopupMenu = mnuPopup
|
||||
ViewStyle = vsReport
|
||||
OnClick = lvBreakPointsClick
|
||||
OnSelectItem = lvBreakPointsSelectItem
|
||||
end
|
||||
object mnuPopup: TPopupMenu
|
||||
Left = 100
|
||||
Top = 96
|
||||
object popAdd: TMenuItem
|
||||
Caption = 'Add...'
|
||||
object popAddSourceBP: TMenuItem
|
||||
Caption = '&Source breakpoint'
|
||||
OnClick = popAddSourceBPClick
|
||||
end
|
||||
end
|
||||
object N1: TMenuItem
|
||||
Caption = '-'
|
||||
end
|
||||
object popProperties: TMenuItem
|
||||
Caption = '&Properties'
|
||||
OnClick = popPropertiesClick
|
||||
end
|
||||
object popEnabled: TMenuItem
|
||||
Caption = '&Enabled'
|
||||
OnClick = popEnabledClick
|
||||
end
|
||||
object popDelete: TMenuItem
|
||||
Caption = '&Delete'
|
||||
OnClick = popDeleteClick
|
||||
end
|
||||
object N2: TMenuItem
|
||||
Caption = '-'
|
||||
end
|
||||
object popDisableAll: TMenuItem
|
||||
Caption = 'D&isable All'
|
||||
OnClick = popDisableAllClick
|
||||
end
|
||||
object popEnableAll: TMenuItem
|
||||
Caption = '&Enable All'
|
||||
OnClick = popEnableAllClick
|
||||
end
|
||||
object popDeleteAll: TMenuItem
|
||||
Caption = '&Delete All'
|
||||
OnClick = popDeleteAllClick
|
||||
end
|
||||
end
|
||||
end
|
||||
@ -5,10 +5,11 @@ program debugtest;
|
||||
|
||||
|
||||
uses
|
||||
Classes, Forms, DebugTestForm, BreakpointsDlg, LocalsDlg;
|
||||
Classes, Forms, DebugTestForm, BreakpointsDlg, LocalsDlg,
|
||||
Interfaces, Unit1;
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TDebugTestForm, DebugTestForm1);
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TDebugTestForm, DebugTestFrm);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
@ -1,49 +1,75 @@
|
||||
LazarusResources.Add('TDebugTestForm','FORMDATA',
|
||||
'TPF0'#14'TDebugTestForm'#14'DebugTestForm1'#7'CAPTION'#6#13'DebugTestForm'
|
||||
+#4'LEFT'#2#25#6'HEIGHT'#3'@'#1#3'TOP'#2#25#5'WIDTH'#3'l'#2#8'OnCreate'#7
|
||||
+#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#0#6'TLabel'#11'lblFileName'
|
||||
+#4'Left'#2#8#3'Top'#2#8#5'WIDTH'#2'F'#7'Caption'#6#9'Filename:'#0#0#5'TEd'
|
||||
+'it'#11'txtFileName'#4'Left'#2'F'#3'Top'#2#8#5'Width'#3'%'#1#6'Height'#2
|
||||
+#24#4'Text'#6#17'examples/testcntr'#0#0#7'TBUTTON'#7'cmdInit'#7'CAPTION'#6
|
||||
+#4'Init'#4'LEFT'#2#10#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'#7'OnClick'
|
||||
+#7#12'cmdInitClick'#0#0#7'TBUTTON'#7'cmdDone'#7'CAPTION'#6#4'Done'#4'LEFT'
|
||||
+#2'F'#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'#7'OnClick'#7#12'cmdDoneCl'
|
||||
+'ick'#0#0#7'TBUTTON'#6'cmdRun'#7'CAPTION'#6#3'Run'#4'LEFT'#3#130#0#6'HEIG'
|
||||
+'HT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'#7'OnClick'#7#11'cmdRunClick'#0#0#7'T'
|
||||
+'BUTTON'#8'cmdPause'#7'CAPTION'#6#5'Pause'#4'LEFT'#3#190#0#6'HEIGHT'#2#25
|
||||
+#3'TOP'#2''''#5'WIDTH'#2'2'#7'OnClick'#7#13'cmdPauseClick'#0#0#7'TBUTTON'
|
||||
+#7'cmdStop'#7'CAPTION'#6#4'Stop'#4'LEFT'#3#250#0#6'HEIGHT'#2#25#3'TOP'#2
|
||||
+''''#5'WIDTH'#2'2'#7'OnClick'#7#12'cmdStopClick'#0#0#7'TBUTTON'#7'cmdStep'
|
||||
+#7'CAPTION'#6#4'Step'#4'LEFT'#3'6'#1#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'
|
||||
+#2'2'#7'OnClick'#7#12'cmdStepClick'#0#0#7'TBUTTON'#11'cmdStepInto'#7'CAPT'
|
||||
+'ION'#6#9'Step into'#4'LEFT'#3'r'#1#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2
|
||||
+'2'#7'OnClick'#7#16'cmdStepIntoClick'#0#0#6'TLabel'#8'lblState'#4'Left'#2
|
||||
+#8#3'Top'#3#165#0#5'WIDTH'#2'2'#0#0#6'TLabel'#9'lblAdress'#4'Left'#2':'#3
|
||||
+'Top'#3#165#0#5'WIDTH'#2'd'#0#0#6'TLabel'#9'lblSource'#4'Left'#3#166#0#3
|
||||
+'Top'#3#165#0#5'WIDTH'#2'd'#0#0#6'TLabel'#7'lblLine'#4'Left'#3#18#1#3'Top'
|
||||
+#3#165#0#5'WIDTH'#2'd'#0#0#6'TLabel'#7'lblFunc'#4'Left'#3'~'#1#3'Top'#3
|
||||
+#165#0#5'WIDTH'#2'd'#0#0#5'TMemo'#6'txtLog'#4'Left'#2#8#3'Top'#3#190#0#5
|
||||
+'Width'#3'X'#2#6'Height'#3#150#0#0#0#6'TLabel'#7'lblTest'#4'Left'#2#8#3'T'
|
||||
+'op'#2'G'#5'WIDTH'#2'F'#7'Caption'#6#5'Test:'#0#0#7'TButton'#10'cmdComman'
|
||||
+'d'#4'Left'#3':'#1#3'Top'#2'G'#5'Width'#2'2'#6'Height'#2#25#7'Caption'#6#3
|
||||
+'CMD'#7'OnClick'#7#15'cmdCommandClick'#0#0#7'TButton'#8'cmdCLear'#4'Left'
|
||||
+#3'w'#1#3'Top'#2'G'#5'Width'#2'2'#6'Height'#2#25#7'Caption'#6#5'Clear'#7
|
||||
+'OnClick'#7#13'cmdClearClick'#0#0#5'TEdit'#10'txtCommand'#4'Left'#2'F'#3
|
||||
+'Top'#2'G'#5'Width'#3#237#0#6'Height'#2#24#4'Text'#6#0#0#0#6'TLabel'#8'lb'
|
||||
+'lBreak'#4'Left'#2#8#3'Top'#3#132#0#5'WIDTH'#2'F'#7'Caption'#6#6'Break:'#0
|
||||
+#0#7'TButton'#11'cmdSetBreak'#4'Left'#3':'#1#3'Top'#3#132#0#5'Width'#2'2'
|
||||
+#6'Height'#2#25#7'Caption'#6#5'Set B'#7'OnClick'#7#16'cmdSetBreakClick'#0
|
||||
+#0#7'TButton'#13'cmdResetBreak'#4'Left'#3'w'#1#3'Top'#3#132#0#5'Width'#2
|
||||
+'2'#6'Height'#2#25#7'Caption'#6#5'Del B'#7'OnClick'#7#18'cmdResetBreakCli'
|
||||
+'ck'#0#0#9'TCheckBox'#14'chkBreakEnable'#4'Left'#3#180#1#3'Top'#3#132#0#5
|
||||
+'Width'#2'd'#6'Height'#2#25#7'Caption'#6#6'Enable'#7'OnClick'#7#19'chkBre'
|
||||
+'akEnableClick'#0#0#5'TEdit'#12'txtBreakFile'#4'Left'#2'F'#3'Top'#3#132#0
|
||||
+#5'Width'#3#150#0#6'Height'#2#24#4'Text'#6#11'testcntr.pp'#0#0#5'TEdit'#12
|
||||
+'txtBreakLine'#4'Left'#3#227#0#3'Top'#3#132#0#5'Width'#2'P'#6'Height'#2#24
|
||||
+#4'Text'#6#1'1'#0#0#6'TLabel'#11'lblEvaluate'#4'Left'#2#8#3'Top'#2'h'#5'W'
|
||||
+'IDTH'#2'F'#7'Caption'#6#9'Evaluate:'#0#0#5'TEdit'#11'txtEvaluate'#4'Left'
|
||||
+#2'F'#3'Top'#2'h'#5'Width'#3#237#0#0#0#7'TButton'#11'cmdEvaluate'#4'Left'
|
||||
+#3':'#1#3'Top'#2'h'#5'WIDTH'#2'2'#6'Height'#2#25#7'Caption'#6#4'Eval'#7'O'
|
||||
+'nClick'#7#16'cmdEvaluateClick'#0#0#6'TLabel'#13'lblEvalResult'#4'Left'#3
|
||||
+'w'#1#3'Top'#2'h'#5'WIDTH'#3#200#0#7'Caption'#6#3'---'#0#0#0
|
||||
);
|
||||
{ This is an automatically generated lazarus resource file }
|
||||
|
||||
LazarusResources.Add('TDebugTestForm','FORMDATA',[
|
||||
'TPF0'#14'TDebugTestForm'#13'DebugTestForm'#7'CAPTION'#6#13'DebugTestForm'#12
|
||||
+'CLIENTHEIGHT'#3'd'#1#11'CLIENTWIDTH'#3'l'#2#8'ONCREATE'#7#10'FormCreate'#9
|
||||
+'ONDESTROY'#7#11'FormDestroy'#18'HORZSCROLLBAR.PAGE'#3'm'#2#18'VERTSCROLLBAR'
|
||||
+'.PAGE'#3'e'#1#4'LEFT'#3#7#1#6'HEIGHT'#3'd'#1#3'TOP'#3'/'#1#5'WIDTH'#3'l'#2#0
|
||||
+#6'TLABEL'#11'lblFileName'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#9
|
||||
+'Filename:'#6'LAYOUT'#7#5'tltop'#4'LEFT'#2#8#6'HEIGHT'#2#17#3'TOP'#2#8#5'WID'
|
||||
+'TH'#2'F'#0#0#5'TEDIT'#11'txtFileName'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#4
|
||||
+'TEXT'#6'0/usr/src/lazarus/debugger/test/examples/testcntr'#8'TABORDER'#2#1#4
|
||||
+'LEFT'#2'F'#6'HEIGHT'#2#24#3'TOP'#2#8#5'WIDTH'#3#26#2#0#0#7'TBUTTON'#7'cmdIn'
|
||||
+'it'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#4'Init'#8'TABORDER'#2#2
|
||||
+#7'ONCLICK'#7#12'cmdInitClick'#4'LEFT'#2#10#6'HEIGHT'#2#25#3'TOP'#2''''#5'WI'
|
||||
+'DTH'#2'2'#0#0#7'TBUTTON'#7'cmdDone'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'CA'
|
||||
+'PTION'#6#4'Done'#8'TABORDER'#2#3#7'ONCLICK'#7#12'cmdDoneClick'#4'LEFT'#2'F'
|
||||
+#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'#0#0#7'TBUTTON'#6'cmdRun'#7'ANCHOR'
|
||||
+'S'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#3'Run'#8'TABORDER'#2#4#7'ONCLICK'#7
|
||||
+#11'cmdRunClick'#4'LEFT'#3#130#0#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'#0
|
||||
+#0#7'TBUTTON'#8'cmdPause'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#5
|
||||
+'Pause'#8'TABORDER'#2#5#7'ONCLICK'#7#13'cmdPauseClick'#4'LEFT'#3#190#0#6'HEI'
|
||||
+'GHT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'#0#0#7'TBUTTON'#7'cmdStop'#7'ANCHORS'#11
|
||||
+#5'aktop'#6'akleft'#0#7'CAPTION'#6#4'Stop'#8'TABORDER'#2#6#7'ONCLICK'#7#12'c'
|
||||
+'mdStopClick'#4'LEFT'#3#250#0#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'#0#0#7
|
||||
+'TBUTTON'#7'cmdStep'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#4'Step'
|
||||
+#8'TABORDER'#2#7#7'ONCLICK'#7#12'cmdStepClick'#4'LEFT'#3'6'#1#6'HEIGHT'#2#25
|
||||
+#3'TOP'#2''''#5'WIDTH'#2'2'#0#0#7'TBUTTON'#11'cmdStepInto'#7'ANCHORS'#11#5'a'
|
||||
+'ktop'#6'akleft'#0#7'CAPTION'#6#9'Step into'#8'TABORDER'#2#8#7'ONCLICK'#7#16
|
||||
+'cmdStepIntoClick'#4'LEFT'#3'r'#1#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'#0
|
||||
+#0#6'TLABEL'#8'lblState'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#6'LAYOUT'#7#5'tl'
|
||||
+'top'#4'LEFT'#2#8#6'HEIGHT'#2#17#3'TOP'#3#165#0#5'WIDTH'#2'2'#0#0#6'TLABEL'#9
|
||||
+'lblAdress'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#6'LAYOUT'#7#5'tltop'#4'LEFT'#2
|
||||
+':'#6'HEIGHT'#2#17#3'TOP'#3#165#0#5'WIDTH'#2'd'#0#0#6'TLABEL'#9'lblSource'#7
|
||||
+'ANCHORS'#11#5'aktop'#6'akleft'#0#6'LAYOUT'#7#5'tltop'#4'LEFT'#3#166#0#6'HEI'
|
||||
+'GHT'#2#17#3'TOP'#3#165#0#5'WIDTH'#2'd'#0#0#6'TLABEL'#7'lblLine'#7'ANCHORS'
|
||||
+#11#5'aktop'#6'akleft'#0#6'LAYOUT'#7#5'tltop'#4'LEFT'#3#18#1#6'HEIGHT'#2#17#3
|
||||
+'TOP'#3#165#0#5'WIDTH'#2'd'#0#0#6'TLABEL'#7'lblFunc'#7'ANCHORS'#11#5'aktop'#6
|
||||
+'akleft'#0#6'LAYOUT'#7#5'tltop'#4'LEFT'#3'~'#1#6'HEIGHT'#2#17#3'TOP'#3#165#0
|
||||
+#5'WIDTH'#2'd'#0#0#5'TMEMO'#6'txtLog'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#10
|
||||
+'SCROLLBARS'#7#6'ssboth'#8'WORDWRAP'#9#8'TABORDER'#2#14#4'LEFT'#2#8#6'HEIGHT'
|
||||
+#3#150#0#3'TOP'#3#192#0#5'WIDTH'#3'X'#2#0#0#6'TLABEL'#7'lblTest'#7'ANCHORS'
|
||||
+#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#5'Test:'#6'LAYOUT'#7#5'tltop'#4'LEFT'#2
|
||||
+#8#6'HEIGHT'#2#17#3'TOP'#2'G'#5'WIDTH'#2'F'#0#0#7'TBUTTON'#10'cmdCommand'#7
|
||||
+'ANCHORS'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#3'CMD'#8'TABORDER'#2#16#7'ONC'
|
||||
+'LICK'#7#15'cmdCommandClick'#4'LEFT'#3':'#1#6'HEIGHT'#2#25#3'TOP'#2'G'#5'WID'
|
||||
+'TH'#2'2'#0#0#7'TBUTTON'#8'cmdCLear'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'CA'
|
||||
+'PTION'#6#5'Clear'#8'TABORDER'#2#17#7'ONCLICK'#7#13'cmdClearClick'#4'LEFT'#3
|
||||
+'w'#1#6'HEIGHT'#2#25#3'TOP'#2'G'#5'WIDTH'#2'2'#0#0#5'TEDIT'#10'txtCommand'#7
|
||||
+'ANCHORS'#11#5'aktop'#6'akleft'#0#8'TABORDER'#2#18#4'LEFT'#2'F'#6'HEIGHT'#2
|
||||
+#24#3'TOP'#2'G'#5'WIDTH'#3#237#0#0#0#6'TLABEL'#8'lblBreak'#7'ANCHORS'#11#5'a'
|
||||
+'ktop'#6'akleft'#0#7'CAPTION'#6#6'Break:'#6'LAYOUT'#7#5'tltop'#4'LEFT'#2#8#6
|
||||
+'HEIGHT'#2#17#3'TOP'#3#132#0#5'WIDTH'#2'F'#0#0#7'TBUTTON'#11'cmdSetBreak'#7
|
||||
+'ANCHORS'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#5'Set B'#8'TABORDER'#2#20#7'O'
|
||||
+'NCLICK'#7#16'cmdSetBreakClick'#4'LEFT'#3':'#1#6'HEIGHT'#2#25#3'TOP'#3#132#0
|
||||
+#5'WIDTH'#2'2'#0#0#7'TBUTTON'#13'cmdResetBreak'#7'ANCHORS'#11#5'aktop'#6'akl'
|
||||
+'eft'#0#7'CAPTION'#6#5'Del B'#8'TABORDER'#2#21#7'ONCLICK'#7#18'cmdResetBreak'
|
||||
+'Click'#4'LEFT'#3'w'#1#6'HEIGHT'#2#25#3'TOP'#3#132#0#5'WIDTH'#2'2'#0#0#9'TCH'
|
||||
+'ECKBOX'#14'chkBreakEnable'#8'AUTOSIZE'#9#11'ALLOWGRAYED'#9#7'ANCHORS'#11#5
|
||||
+'aktop'#6'akleft'#0#7'CAPTION'#6#6'Enable'#10'DRAGCURSOR'#2#0#8'TABORDER'#2
|
||||
+#22#7'ONCLICK'#7#19'chkBreakEnableClick'#8'TABORDER'#2#22#4'LEFT'#3#180#1#6
|
||||
+'HEIGHT'#2#25#3'TOP'#3#132#0#5'WIDTH'#2'd'#0#0#5'TEDIT'#12'txtBreakFile'#7'A'
|
||||
+'NCHORS'#11#5'aktop'#6'akleft'#0#4'TEXT'#6#11'testcntr.pp'#8'TABORDER'#2#23#4
|
||||
+'LEFT'#2'F'#6'HEIGHT'#2#24#3'TOP'#3#132#0#5'WIDTH'#3#150#0#0#0#5'TEDIT'#12't'
|
||||
+'xtBreakLine'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#4'TEXT'#6#1'1'#8'TABORDER'#2
|
||||
+#24#4'LEFT'#3#227#0#6'HEIGHT'#2#24#3'TOP'#3#132#0#5'WIDTH'#2'P'#0#0#6'TLABEL'
|
||||
+#11'lblEvaluate'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#9'Evaluate:'
|
||||
+#6'LAYOUT'#7#5'tltop'#4'LEFT'#2#8#6'HEIGHT'#2#17#3'TOP'#2'h'#5'WIDTH'#2'F'#0
|
||||
,#0#5'TEDIT'#11'txtEvaluate'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#8'TABORDER'#2
|
||||
+#26#4'LEFT'#2'F'#6'HEIGHT'#2#23#3'TOP'#2'h'#5'WIDTH'#3#237#0#0#0#7'TBUTTON'
|
||||
+#11'cmdEvaluate'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#4'Eval'#8'T'
|
||||
+'ABORDER'#2#27#7'ONCLICK'#7#16'cmdEvaluateClick'#4'LEFT'#3':'#1#6'HEIGHT'#2
|
||||
+#25#3'TOP'#2'h'#5'WIDTH'#2'2'#0#0#6'TLABEL'#13'lblEvalResult'#7'ANCHORS'#11#5
|
||||
+'aktop'#6'akleft'#0#7'CAPTION'#6#3'---'#6'LAYOUT'#7#5'tltop'#4'LEFT'#3'w'#1#6
|
||||
+'HEIGHT'#2#17#3'TOP'#2'h'#5'WIDTH'#3#200#0#0#0#0
|
||||
]);
|
||||
|
||||
@ -100,7 +100,7 @@ type
|
||||
end;
|
||||
|
||||
var
|
||||
DebugTestForm1: TDebugTestForm;
|
||||
DebugTestFrm: TDebugTestForm;
|
||||
|
||||
implementation
|
||||
|
||||
@ -113,14 +113,14 @@ begin
|
||||
inherited Loaded;
|
||||
|
||||
// Not yet through resources
|
||||
txtLog.Scrollbars := ssBoth;
|
||||
//txtLog.Scrollbars := ssBoth;
|
||||
end;
|
||||
|
||||
destructor TDebugTestForm.Destroy;
|
||||
begin
|
||||
// This shouldn't be needed, but the OnDestroy event isn't called
|
||||
inherited;
|
||||
FormDestroy(Self);
|
||||
// FormDestroy(Self);
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.FormCreate(Sender: TObject);
|
||||
@ -323,6 +323,12 @@ initialization
|
||||
end.
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.9 2003/05/22 23:08:19 marc
|
||||
MWE: = Moved and renamed debuggerforms so that they can be
|
||||
modified by the ide
|
||||
+ Added some parsing to evaluate complex expressions
|
||||
not understood by the debugger
|
||||
|
||||
Revision 1.8 2002/04/30 15:57:40 lazarus
|
||||
MWE:
|
||||
+ Added callstack object and dialog
|
||||
|
||||
@ -7,14 +7,16 @@ uses
|
||||
var
|
||||
m, n, x : Cardinal;
|
||||
w: TWait;
|
||||
S: String;
|
||||
begin
|
||||
m :=0;
|
||||
x := 0;
|
||||
w := TWait.Create(2);
|
||||
while x < 3 do
|
||||
begin
|
||||
repeat
|
||||
Write(Format('[%.10d] ', [m]));
|
||||
repeat
|
||||
S := Format('[%.10d] ', [m]);
|
||||
Write(S);
|
||||
Inc(m);
|
||||
for n := 0 to 79 do
|
||||
begin
|
||||
|
||||
@ -4,6 +4,10 @@ interface
|
||||
|
||||
type
|
||||
TWait = class
|
||||
private
|
||||
FTime: TDateTime;
|
||||
FInt: Integer;
|
||||
public
|
||||
constructor Create(const ATime: Integer);
|
||||
procedure Wait(const ATime: Integer);
|
||||
end;
|
||||
@ -25,6 +29,8 @@ constructor TWait.Create(const ATime: Integer);
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
FTime := ATime;
|
||||
FInt := ATime;
|
||||
inherited Create;
|
||||
n := 0;
|
||||
while n < ATime do Inc(n); //something useles
|
||||
|
||||
@ -1,207 +0,0 @@
|
||||
object DebugTestForm1: TDebugTestForm
|
||||
CAPTION = 'DebugTestForm'
|
||||
LEFT = 25
|
||||
HEIGHT = 320
|
||||
TOP = 25
|
||||
WIDTH = 620
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
object lblFileName: TLabel
|
||||
Left = 8
|
||||
Top = 8
|
||||
WIDTH = 70
|
||||
Caption = 'Filename:'
|
||||
end
|
||||
object txtFileName: TEdit
|
||||
Left = 70
|
||||
Top = 8
|
||||
Width = 293
|
||||
Height = 24
|
||||
Text = 'examples/testcntr'
|
||||
end
|
||||
object cmdInit: TBUTTON
|
||||
CAPTION = 'Init'
|
||||
LEFT = 10
|
||||
HEIGHT = 25
|
||||
TOP = 39
|
||||
WIDTH = 50
|
||||
OnClick = cmdInitClick
|
||||
end
|
||||
object cmdDone: TBUTTON
|
||||
CAPTION = 'Done'
|
||||
LEFT = 70
|
||||
HEIGHT = 25
|
||||
TOP = 39
|
||||
WIDTH = 50
|
||||
OnClick = cmdDoneClick
|
||||
end
|
||||
object cmdRun: TBUTTON
|
||||
CAPTION = 'Run'
|
||||
LEFT = 130
|
||||
HEIGHT = 25
|
||||
TOP = 39
|
||||
WIDTH = 50
|
||||
OnClick = cmdRunClick
|
||||
end
|
||||
object cmdPause: TBUTTON
|
||||
CAPTION = 'Pause'
|
||||
LEFT = 190
|
||||
HEIGHT = 25
|
||||
TOP = 39
|
||||
WIDTH = 50
|
||||
OnClick = cmdPauseClick
|
||||
end
|
||||
object cmdStop: TBUTTON
|
||||
CAPTION = 'Stop'
|
||||
LEFT = 250
|
||||
HEIGHT = 25
|
||||
TOP = 39
|
||||
WIDTH = 50
|
||||
OnClick = cmdStopClick
|
||||
end
|
||||
object cmdStep: TBUTTON
|
||||
CAPTION = 'Step'
|
||||
LEFT = 310
|
||||
HEIGHT = 25
|
||||
TOP = 39
|
||||
WIDTH = 50
|
||||
OnClick = cmdStepClick
|
||||
end
|
||||
object cmdStepInto: TBUTTON
|
||||
CAPTION = 'Step into'
|
||||
LEFT = 370
|
||||
HEIGHT = 25
|
||||
TOP = 39
|
||||
WIDTH = 50
|
||||
OnClick = cmdStepIntoClick
|
||||
end
|
||||
object lblState: TLabel
|
||||
Left = 8
|
||||
Top = 165
|
||||
WIDTH = 50
|
||||
end
|
||||
object lblAdress: TLabel
|
||||
Left = 58
|
||||
Top = 165
|
||||
WIDTH = 100
|
||||
end
|
||||
object lblSource: TLabel
|
||||
Left = 166
|
||||
Top = 165
|
||||
WIDTH = 100
|
||||
end
|
||||
object lblLine: TLabel
|
||||
Left = 274
|
||||
Top = 165
|
||||
WIDTH = 100
|
||||
end
|
||||
object lblFunc: TLabel
|
||||
Left = 382
|
||||
Top = 165
|
||||
WIDTH = 100
|
||||
end
|
||||
object txtLog: TMemo
|
||||
Left = 8
|
||||
Top = 190
|
||||
Width = 600
|
||||
Height = 150
|
||||
end
|
||||
object lblTest: TLabel
|
||||
Left = 8
|
||||
Top = 71
|
||||
WIDTH = 70
|
||||
Caption = 'Test:'
|
||||
end
|
||||
object cmdCommand: TButton
|
||||
Left = 314
|
||||
Top = 71
|
||||
Width = 50
|
||||
Height = 25
|
||||
Caption = 'CMD'
|
||||
OnClick = cmdCommandClick
|
||||
end
|
||||
object cmdCLear: TButton
|
||||
Left = 375
|
||||
Top = 71
|
||||
Width = 50
|
||||
Height = 25
|
||||
Caption = 'Clear'
|
||||
OnClick = cmdClearClick
|
||||
end
|
||||
object txtCommand: TEdit
|
||||
Left = 70
|
||||
Top = 71
|
||||
Width = 237
|
||||
Height = 24
|
||||
Text = ''
|
||||
end
|
||||
object lblBreak: TLabel
|
||||
Left = 8
|
||||
Top = 132
|
||||
WIDTH = 70
|
||||
Caption = 'Break:'
|
||||
end
|
||||
object cmdSetBreak: TButton
|
||||
Left = 314
|
||||
Top = 132
|
||||
Width = 50
|
||||
Height = 25
|
||||
Caption = 'Set B'
|
||||
OnClick = cmdSetBreakClick
|
||||
end
|
||||
object cmdResetBreak: TButton
|
||||
Left = 375
|
||||
Top = 132
|
||||
Width = 50
|
||||
Height = 25
|
||||
Caption = 'Del B'
|
||||
OnClick = cmdResetBreakClick
|
||||
end
|
||||
object chkBreakEnable: TCheckBox
|
||||
Left = 436
|
||||
Top = 132
|
||||
Width = 100
|
||||
Height = 25
|
||||
Caption = 'Enable'
|
||||
OnClick = chkBreakEnableClick
|
||||
end
|
||||
object txtBreakFile: TEdit
|
||||
Left = 70
|
||||
Top = 132
|
||||
Width = 150
|
||||
Height = 24
|
||||
Text = 'testcntr.pp'
|
||||
end
|
||||
object txtBreakLine: TEdit
|
||||
Left = 227
|
||||
Top = 132
|
||||
Width = 80
|
||||
Height = 24
|
||||
Text = '1'
|
||||
end
|
||||
object lblEvaluate: TLabel
|
||||
Left = 8
|
||||
Top = 104
|
||||
WIDTH = 70
|
||||
Caption = 'Evaluate:'
|
||||
end
|
||||
object txtEvaluate: TEdit
|
||||
Left = 70
|
||||
Top = 104
|
||||
Width = 237
|
||||
end
|
||||
object cmdEvaluate: TButton
|
||||
Left = 314
|
||||
Top = 104
|
||||
WIDTH = 50
|
||||
Height = 25
|
||||
Caption = 'Eval'
|
||||
OnClick = cmdEvaluateClick
|
||||
end
|
||||
object lblEvalResult: TLabel
|
||||
Left = 375
|
||||
Top = 104
|
||||
WIDTH = 200
|
||||
Caption = '---'
|
||||
end
|
||||
end
|
||||
Loading…
Reference in New Issue
Block a user