1
{ $Id: debugtestform.pp 23967 2010-03-12 16:04:05Z vincents $ }
2
{ ----------------------------------------
3
debugtestform.pp - Debugger test app
4
----------------------------------------
6
@created(Wed Feb 25st WET 2001)
7
@lastmod($Date: 2010-03-12 16:04:05 +0000 (Fri, 12 Mar 2010) $)
8
@author(Marc Weustink <marc@@dommelstein.net>)
10
***************************************************************************
12
* This program is free software; you can redistribute it and/or modify *
13
* it under the terms of the GNU General Public License as published by *
14
* the Free Software Foundation; either version 2 of the License, or *
15
* (at your option) any later version. *
17
***************************************************************************/
27
Classes, Graphics, Controls, Forms, Dialogs, LResources,
28
Buttons, StdCtrls, Debugger, DebugOutputForm, BreakpointsDlg,
29
LocalsDlg, WatchesDlg, CallStackDlg;
33
TDebugTestForm = class(TForm)
40
cmdStepInto : TButton;
41
cmdSetBreak : TButton;
42
cmdResetBreak : TButton;
59
chkBreakEnable: TCheckBox;
61
lblEvalResult: TLabel;
63
procedure FormCreate(Sender: TObject);
64
procedure FormDestroy(Sender: TObject);
65
procedure cmdInitClick(Sender: TObject);
66
procedure cmdDoneClick(Sender: TObject);
67
procedure cmdRunClick(Sender: TObject);
68
procedure cmdPauseClick(Sender: TObject);
69
procedure cmdStopClick(Sender: TObject);
70
procedure cmdStepClick(Sender: TObject);
71
procedure cmdStepIntoClick(Sender: TObject);
72
procedure cmdCommandClick(Sender: TObject);
73
procedure cmdClearClick(Sender: TObject);
74
procedure cmdSetBreakClick(Sender: TObject);
75
procedure cmdResetBreakClick(Sender: TObject);
76
procedure cmdEvaluateClick(Sender: TObject);
77
procedure chkBreakEnableClick(Sender: TObject);
80
FOutputForm: TDBGOutputForm;
81
FBreakpointDlg: TBreakpointsDlg;
82
FLocalsDlg: TLocalsDlg;
83
FWatchesDlg: TWatchesDlg;
84
FCallStackDlg: TCallStackDlg;
86
procedure DBGState(Sender: TObject);
87
procedure DBGCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
88
procedure DBGOutput(Sender: TObject; const AText: String);
89
procedure DBGTargetOutput(Sender: TObject; const AText: String);
90
procedure OutputFormDestroy(Sender: TObject);
92
procedure Loaded; override;
94
destructor Destroy; override;
96
property Dummy: Boolean read FDummy write FDummy; // insert some dummies until fpcbug #1888 is fixed
97
property Dummy1: Boolean read FDummy write FDummy; // insert some dummies until fpcbug #1888 is fixed
98
property Dummy2: Boolean read FDummy write FDummy; // insert some dummies until fpcbug #1888 is fixed
99
property Dummy3: Boolean read FDummy write FDummy; // insert some dummies until fpcbug #1888 is fixed
103
DebugTestFrm: TDebugTestForm;
111
procedure TDebugTestForm.Loaded;
115
// Not yet through resources
116
//txtLog.Scrollbars := ssBoth;
119
destructor TDebugTestForm.Destroy;
121
// This shouldn't be needed, but the OnDestroy event isn't called
123
// FormDestroy(Self);
126
procedure TDebugTestForm.FormCreate(Sender: TObject);
130
FBreakpointDlg := TBreakpointsDlg.Create(Application);
133
FLocalsDlg := TLocalsDlg.Create(Application);
136
FWatchesDlg := TWatchesDlg.Create(Application);
139
FOutputForm := TDBGOutputForm.Create(Application);
142
FCallStackDlg := TCallStackDlg.Create(Application);
146
procedure TDebugTestForm.FormDestroy(Sender: TObject);
149
FBreakpointDlg.Debugger := nil;
150
FLocalsDlg.Debugger := nil;
151
FWatchesDlg.Debugger := nil;
152
FOutputForm.Debugger := nil;
153
FCallStackDlg.Debugger := nil;
161
procedure TDebugTestForm.cmdInitClick(Sender: TObject);
165
FDebugger := TGDBMIDebugger.Create('/usr/bin/gdb');
166
FDebugger.OnDbgOutput := @DBGOutput;
167
FDebugger.OnOutput := @DBGTargetOutput;
168
FDebugger.OnCurrent := @DBGCurrent;
169
FDebugger.OnState := @DBGState;
170
TDBGBreakPointGroup(FDebugger.BreakPointGroups.Add).Name := 'Default';
172
FBreakpointDlg.Debugger := FDebugger;
173
FLocalsDlg.Debugger := FDebugger;
174
FWatchesDlg.Debugger := FDebugger;
175
FOutputForm.Debugger := FDebugger;
176
FCallStackDlg.Debugger := FDebugger;
179
FDebugger.FileName := txtFileName.Text;
182
procedure TDebugTestForm.cmdDoneClick(Sender: TObject);
187
FBreakpointDlg.Debugger := nil;
188
FLocalsDlg.Debugger := nil;
189
FWatchesDlg.Debugger := nil;
190
FOutputForm.Debugger := nil;
191
FWatchesDlg.Debugger := nil;
197
procedure TDebugTestForm.cmdRunClick(Sender: TObject);
201
FDebugger.FileName := txtFileName.Text;
206
procedure TDebugTestForm.cmdPauseClick(Sender: TObject);
214
procedure TDebugTestForm.cmdStepClick(Sender: TObject);
222
procedure TDebugTestForm.cmdStepIntoClick(Sender: TObject);
230
procedure TDebugTestForm.cmdStopClick(Sender: TObject);
238
procedure TDebugTestForm.cmdCommandClick(Sender: TObject);
240
TGDBMIDebugger(FDebugger).TestCmd(txtCommand.Text);
243
procedure TDebugTestForm.cmdClearClick(Sender: TObject);
248
procedure TDebugTestForm.cmdSetBreakClick(Sender: TObject);
250
FDebugger.Breakpoints.Add(txtBreakFile.Text, StrToIntDef(txtBreakLine.Text, 1));
253
procedure TDebugTestForm.cmdResetBreakClick(Sender: TObject);
255
if FDebugger.Breakpoints.Count > 0
256
then FDebugger.Breakpoints[0].Free;
259
procedure TDebugTestForm.chkBreakEnableClick(Sender: TObject);
261
if FDebugger.Breakpoints.Count > 0
262
then FDebugger.Breakpoints[0].Enabled := chkBreakEnable.Checked;
265
procedure TDebugTestForm.cmdEvaluateClick(Sender: TObject);
271
FDebugger.Evaluate(txtEvaluate.Text, S, ATypeInfo);
272
lblEvalResult.Caption := S;
275
procedure TDebugTestForm.OutputFormDestroy(Sender: TObject);
280
procedure TDebugTestForm.DBGOutput(Sender: TObject; const AText: String);
282
txtLog.Lines.Add(AText);
285
procedure TDebugTestForm.DBGTargetOutput(Sender: TObject; const AText: String);
287
if FOutputForm <> nil
288
then FOutputForm.AddText(AText);
291
procedure TDebugTestForm.DBGCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
293
lblAdress.Caption := Format('$%p', [ALocation.Address]);
294
lblSource.Caption := ALocation.SrcFile;
295
lblLine.Caption := IntToStr(ALocation.SrcLine);
296
lblFunc.Caption := ALocation.FuncName;
299
procedure TDebugTestForm.DBGState(Sender: TObject);
303
case FDebugger.State of
304
dsNone :lblState.Caption := 'dsNone ';
305
dsIdle :lblState.Caption := 'dsIdle ';
306
dsStop :lblState.Caption := 'dsStop ';
308
lblState.Caption := 'dsPause';
309
txtLog.Lines.Add('[locals]');
310
for n := 0 to FDebugger.Locals.Count - 1 do
312
txtLog.Lines.Add(FDebugger.Locals.Names[n] + ':'+ FDebugger.Locals.Values[n]);
315
dsRun :lblState.Caption := 'dsRun ';
316
dsError:lblState.Caption := 'dsError';
318
lblState.Caption := '?';
323
{$I debugtestform.lrs}