PageRenderTime 61ms CodeModel.GetById 30ms app.highlight 27ms RepoModel.GetById 2ms app.codeStats 0ms

/debugger/test/debugtestform.pp

http://github.com/graemeg/lazarus
Pascal | 323 lines | 260 code | 38 blank | 25 comment | 11 complexity | 14bd70e7901d4466f5b558e4a8dda6e8 MD5 | raw file
  1{ $Id$ }
  2{                        ----------------------------------------
  3                          debugtestform.pp  -  Debugger test app
  4                         ----------------------------------------
  5
  6 @created(Wed Feb 25st WET 2001)
  7 @lastmod($Date$)
  8 @author(Marc Weustink <marc@@dommelstein.net>)
  9
 10***************************************************************************
 11 *                                                                         *
 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.                                   *
 16 *                                                                         *
 17 ***************************************************************************/
 18}
 19unit debugtestform;
 20
 21{$mode objfpc}
 22{$H+}
 23
 24interface
 25
 26uses
 27  Classes, Graphics, Controls, Forms, Dialogs, LResources,
 28  Buttons, StdCtrls, Debugger, DbgOutputForm, BreakpointsDlg, 
 29  LocalsDlg, WatchesDlg, CallStackDlg;
 30
 31
 32type
 33  TDebugTestForm = class(TForm)
 34    cmdInit : TButton;
 35    cmdDone : TButton;
 36    cmdRun : TButton;
 37    cmdPause : TButton;
 38    cmdStop : TButton;
 39    cmdStep : TButton;
 40    cmdStepInto : TButton;
 41    cmdSetBreak : TButton;
 42    cmdResetBreak : TButton;
 43    lblFileName: TLabel;
 44    lblAdress: TLabel;
 45    lblSource: TLabel;
 46    lblLine: TLabel;
 47    lblFunc: TLabel;
 48    lblState: TLabel;
 49    lblBreak: TLabel;
 50    lblEvaluate: TLabel;
 51    lblTest: TLabel;
 52    txtLog: TMemo;
 53    cmdCommand: TButton;
 54    cmdClear: TButton;
 55    txtCommand: TEdit;
 56    txtFileName: TEdit;
 57    txtBreakFile: TEdit;
 58    txtBreakLine: TEdit;
 59    chkBreakEnable: TCheckBox;
 60    txtEvaluate: TEdit;
 61    lblEvalResult: TLabel;
 62    cmdEvaluate: TButton;
 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);
 78  private
 79    FDebugger: TDebugger;
 80    FOutputForm: TDBGOutputForm;
 81    FBreakpointDlg: TBreakpointsDlg;
 82    FLocalsDlg: TLocalsDlg;
 83    FWatchesDlg: TWatchesDlg;
 84    FCallStackDlg: TCallStackDlg;
 85    FDummy: Boolean;
 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);
 91  protected
 92    procedure Loaded; override;
 93  public
 94    destructor Destroy; override;
 95  published
 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
100  end;
101
102var
103  DebugTestFrm: TDebugTestForm;
104
105implementation
106
107uses
108  SysUtils,
109  GDBMIDebugger;
110
111procedure TDebugTestForm.Loaded;
112begin
113  inherited Loaded;
114
115  // Not yet through resources
116  //txtLog.Scrollbars := ssBoth;
117end;
118
119destructor TDebugTestForm.Destroy;
120begin
121  // This shouldn't be needed, but the OnDestroy event isn't called
122  inherited;
123//  FormDestroy(Self);
124end;
125
126procedure TDebugTestForm.FormCreate(Sender: TObject);
127begin
128  txtLog.Lines.Clear;
129  FDebugger := nil;
130  FBreakpointDlg := TBreakpointsDlg.Create(Application);
131  FBreakpointDlg.Show;
132
133  FLocalsDlg := TLocalsDlg.Create(Application);
134  FLocalsDlg.Show;
135
136  FWatchesDlg := TWatchesDlg.Create(Application);
137  FWatchesDlg.Show;
138
139  FOutputForm := TDBGOutputForm.Create(Application);
140  FOutputForm.Show;
141  
142  FCallStackDlg := TCallStackDlg.Create(Application);
143  FCallStackDlg.Show;
144end;
145
146procedure TDebugTestForm.FormDestroy(Sender: TObject);
147begin  
148  try
149    FBreakpointDlg.Debugger := nil;
150    FLocalsDlg.Debugger := nil;
151    FWatchesDlg.Debugger := nil;
152    FOutputForm.Debugger := nil;
153    FCallStackDlg.Debugger := nil;
154  except
155    on Exception do;
156  end;
157  FDebugger.Free;
158  FDebugger := nil;
159end;
160
161procedure TDebugTestForm.cmdInitClick(Sender: TObject);
162begin
163  if FDebugger = nil
164  then begin
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';
171
172    FBreakpointDlg.Debugger := FDebugger;
173    FLocalsDlg.Debugger := FDebugger;
174    FWatchesDlg.Debugger := FDebugger;
175    FOutputForm.Debugger := FDebugger;
176    FCallStackDlg.Debugger := FDebugger;   
177  end;
178  FDebugger.Init;
179  FDebugger.FileName := txtFileName.Text;
180end;
181
182procedure TDebugTestForm.cmdDoneClick(Sender: TObject);
183begin
184  if FDebugger <> nil
185  then begin
186    FDebugger.Done;
187    FBreakpointDlg.Debugger := nil;
188    FLocalsDlg.Debugger := nil;
189    FWatchesDlg.Debugger := nil;
190    FOutputForm.Debugger := nil;
191    FWatchesDlg.Debugger := nil;
192    FDebugger.Free;
193    FDebugger := nil;
194  end;
195end;
196
197procedure TDebugTestForm.cmdRunClick(Sender: TObject);
198begin
199  if FDebugger <> nil
200  then begin
201    FDebugger.FileName := txtFileName.Text;
202    FDebugger.Run;
203  end;
204end;
205
206procedure TDebugTestForm.cmdPauseClick(Sender: TObject);
207begin
208  if FDebugger <> nil
209  then begin
210    FDebugger.Pause;
211  end;
212end;
213
214procedure TDebugTestForm.cmdStepClick(Sender: TObject);
215begin
216  if FDebugger <> nil
217  then begin
218    FDebugger.StepOver;
219  end;
220end;
221
222procedure TDebugTestForm.cmdStepIntoClick(Sender: TObject);
223begin
224  if FDebugger <> nil
225  then begin
226    FDebugger.StepInto;
227  end;
228end;
229
230procedure TDebugTestForm.cmdStopClick(Sender: TObject);
231begin
232  if FDebugger <> nil
233  then begin
234    FDebugger.Stop;
235  end;
236end;
237
238procedure TDebugTestForm.cmdCommandClick(Sender: TObject);
239begin
240  TGDBMIDebugger(FDebugger).TestCmd(txtCommand.Text);
241end;
242
243procedure TDebugTestForm.cmdClearClick(Sender: TObject);
244begin
245  txtLog.Lines.Clear;
246end;
247
248procedure TDebugTestForm.cmdSetBreakClick(Sender: TObject);
249begin
250  FDebugger.Breakpoints.Add(txtBreakFile.Text, StrToIntDef(txtBreakLine.Text, 1));
251end;
252
253procedure TDebugTestForm.cmdResetBreakClick(Sender: TObject);
254begin
255  if FDebugger.Breakpoints.Count > 0
256  then FDebugger.Breakpoints[0].Free;
257end;
258
259procedure TDebugTestForm.chkBreakEnableClick(Sender: TObject);
260begin
261  if FDebugger.Breakpoints.Count > 0
262  then FDebugger.Breakpoints[0].Enabled := chkBreakEnable.Checked;
263end;
264
265procedure TDebugTestForm.cmdEvaluateClick(Sender: TObject);
266var
267  S: String;
268begin
269  FDebugger.Evaluate(txtEvaluate.Text, S);
270  lblEvalResult.Caption := S;
271end;
272
273procedure TDebugTestForm.OutputFormDestroy(Sender: TObject);
274begin
275  FOutputForm := nil;
276end;
277
278procedure TDebugTestForm.DBGOutput(Sender: TObject; const AText: String);
279begin
280  txtLog.Lines.Add(AText);
281end;
282
283procedure TDebugTestForm.DBGTargetOutput(Sender: TObject; const AText: String);
284begin
285  if FOutputForm <> nil
286  then FOutputForm.AddText(AText);
287end;
288
289procedure TDebugTestForm.DBGCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
290begin
291  lblAdress.Caption := Format('$%p', [ALocation.Adress]);
292  lblSource.Caption := ALocation.SrcFile;
293  lblLine.Caption := IntToStr(ALocation.SrcLine);
294  lblFunc.Caption := ALocation.FuncName;
295end;
296
297procedure TDebugTestForm.DBGState(Sender: TObject);
298var
299  n: Integer;
300begin
301  case FDebugger.State of
302    dsNone :lblState.Caption := 'dsNone ';
303    dsIdle :lblState.Caption := 'dsIdle ';
304    dsStop :lblState.Caption := 'dsStop ';
305    dsPause: begin
306      lblState.Caption := 'dsPause';
307      txtLog.Lines.Add('[locals]');
308      for n := 0 to FDebugger.Locals.Count - 1 do
309      begin
310        txtLog.Lines.Add(FDebugger.Locals.Names[n] + ':'+ FDebugger.Locals.Values[n]);
311      end;
312    end;
313    dsRun  :lblState.Caption := 'dsRun  ';
314    dsError:lblState.Caption := 'dsError';
315  else
316    lblState.Caption := '?';
317  end;
318end;
319
320initialization
321  {$I debugtestform.lrs}
322
323end.