← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to debugger/test/Gdbmi/testbreakpoint.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
debugger/test/Gdbmi/testbreakpoint.pas
 
1
unit TestBreakPoint;
 
2
 
 
3
{$mode objfpc}{$H+}
 
4
 
 
5
interface
 
6
 
 
7
uses
 
8
  SysUtils, fpcunit, testutils, testregistry, TestGDBMIControl,
 
9
  TestBase, Debugger, GDBMIDebugger, LCLProc, TestWatches;
 
10
 
 
11
type
 
12
 
 
13
  { TTestBrkGDBMIDebugger }
 
14
 
 
15
  TTestBrkGDBMIDebugger = class(TGDBMIDebugger)
 
16
  public
 
17
    procedure TestInterruptTarget;
 
18
  end;
 
19
 
 
20
 
 
21
  { TTestBreakPoint }
 
22
 
 
23
  TTestBreakPoint = class(TGDBTestCase)
 
24
  private
 
25
    FCurLine: Integer;
 
26
    FCurFile: string;
 
27
    FBrkErr: TDBGBreakPoint;
 
28
  protected
 
29
    function DoGetFeedBack(Sender: TObject; const AText, AInfo: String;
 
30
      AType: TDBGFeedbackType; AButtons: TDBGFeedbackResults): TDBGFeedbackResult;
 
31
    function GdbClass: TGDBMIDebuggerClass; override;
 
32
    procedure DoCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
 
33
  published
 
34
    // Due to a linker error breakpoints can point to invalid addresses
 
35
    procedure TestStartMethod;
 
36
    procedure TestBadAddrBreakpoint;
 
37
    procedure TestInteruptWhilePaused;
 
38
  end;
 
39
 
 
40
implementation
 
41
 
 
42
procedure TTestBrkGDBMIDebugger.TestInterruptTarget;
 
43
begin
 
44
  InterruptTarget;
 
45
end;
 
46
 
 
47
{ TTestBrkGDBMIDebugger }
 
48
 
 
49
 
 
50
{ TTestBreakPoint }
 
51
 
 
52
procedure   TTestBreakPoint.DoCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
 
53
begin
 
54
  FCurFile := ALocation.SrcFile;
 
55
  FCurLine := ALocation.SrcLine;
 
56
end;
 
57
 
 
58
procedure TTestBreakPoint.TestStartMethod;
 
59
var
 
60
  dbg: TGDBMIDebugger;
 
61
  TestExeName, s: string;
 
62
  i: TGDBMIDebuggerStartBreak;
 
63
  IgnoreRes: String;
 
64
begin
 
65
  if SkipTest then exit;
 
66
  if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestBreakPoint')] then exit;
 
67
  if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('  TTestBreakPoint.StartMethod')] then exit;
 
68
 
 
69
  ClearTestErrors;
 
70
  FBrkErr := nil;
 
71
  TestCompile(AppDir + 'WatchesPrg.pas', TestExeName);
 
72
 
 
73
  for i := Low(TGDBMIDebuggerStartBreak) to high(TGDBMIDebuggerStartBreak) do begin
 
74
    WriteStr(s, i);
 
75
 
 
76
    try
 
77
      dbg := StartGDB(AppDir, TestExeName);
 
78
      dbg.OnCurrent  := @DoCurrent;
 
79
      TGDBMIDebuggerProperties(dbg.GetProperties).InternalStartBreak := i;
 
80
      with dbg.BreakPoints.Add('WatchesPrg.pas', BREAK_LINE_FOOFUNC) do begin
 
81
        InitialEnabled := True;
 
82
        Enabled := True;
 
83
      end;
 
84
 
 
85
      dbg.Run;
 
86
 
 
87
      IgnoreRes := '';
 
88
      case DebuggerInfo.Version of
 
89
        070400..070499: if i =  gdsbAddZero then IgnoreRes:= 'gdb 7.4.x does not work with gdsbAddZero';
 
90
      end;
 
91
 
 
92
      TestTrue(s+' not in error state 1', dbg.State <> dsError, 0, IgnoreRes);
 
93
          TestTrue(s+' at break', FCurLine = BREAK_LINE_FOOFUNC, 0, IgnoreRes);
 
94
 
 
95
      TGDBMIDebuggerProperties(dbg.GetProperties).InternalStartBreak := gdsbDefault;
 
96
    finally
 
97
      dbg.Done;
 
98
      CleanGdb;
 
99
      dbg.Free;
 
100
    end;
 
101
  end;
 
102
 
 
103
  AssertTestErrors;
 
104
end;
 
105
 
 
106
function   TTestBreakPoint.DoGetFeedBack(Sender: TObject; const AText, AInfo: String;
 
107
  AType: TDBGFeedbackType; AButtons: TDBGFeedbackResults): TDBGFeedbackResult;
 
108
begin
 
109
  Result := frOk;
 
110
  ReleaseRefAndNil(FBrkErr);
 
111
end;
 
112
 
 
113
function   TTestBreakPoint.GdbClass: TGDBMIDebuggerClass;
 
114
begin
 
115
  Result := TTestBrkGDBMIDebugger;
 
116
end;
 
117
 
 
118
procedure   TTestBreakPoint.TestBadAddrBreakpoint;
 
119
var
 
120
  TestExeName: string;
 
121
  dbg: TTestBrkGDBMIDebugger;
 
122
  i: LongInt;
 
123
begin
 
124
  if SkipTest then exit;
 
125
  if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestBreakPoint')] then exit;
 
126
  if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('  TTestBreakPoint.BadAddr')] then exit;
 
127
  ClearTestErrors;
 
128
  FBrkErr := nil;
 
129
 
 
130
  TestCompile(AppDir + 'WatchesPrg.pas', TestExeName);
 
131
  try
 
132
    dbg := TTestBrkGDBMIDebugger(StartGDB(AppDir, TestExeName));
 
133
    dbg.OnCurrent  := @DoCurrent;
 
134
    with dbg.BreakPoints.Add('WatchesPrg.pas', BREAK_LINE_FOOFUNC) do begin
 
135
      InitialEnabled := True;
 
136
      Enabled := True;
 
137
    end;
 
138
 
 
139
    dbg.OnFeedback  := @DoGetFeedBack;
 
140
 
 
141
    dbg.Run;
 
142
    // hit breakpoint
 
143
    FBrkErr := dbg.BreakPoints.Add(TDBGPtr(200));
 
144
    with FBrkErr do begin
 
145
      InitialEnabled := True;
 
146
      Enabled := True;
 
147
    end;
 
148
    TestTrue('not in error state 1', dbg.State <> dsError);
 
149
 
 
150
    i := FCurLine;
 
151
    dbg.StepOver;
 
152
    TestTrue('not in error state 2', dbg.State <> dsError);
 
153
    //TestTrue('gone next line 2', i <> FCurLine);
 
154
 
 
155
    i := FCurLine;
 
156
    dbg.StepOver;
 
157
    TestTrue('not in error state 3', dbg.State <> dsError);
 
158
    //TestTrue('gone next line 3', i <> FCurLine);
 
159
 
 
160
    i := FCurLine;
 
161
    dbg.StepOver;
 
162
    TestTrue('not in error state 4', dbg.State <> dsError);
 
163
    //TestTrue('gone next line 4', i <> FCurLine);
 
164
 
 
165
  finally
 
166
    dbg.Done;
 
167
    CleanGdb;
 
168
    dbg.Free;
 
169
  end;
 
170
  AssertTestErrors;
 
171
 
 
172
end;
 
173
 
 
174
procedure   TTestBreakPoint.TestInteruptWhilePaused;
 
175
var
 
176
  TestExeName, Err, IgnoreRes: string;
 
177
  dbg: TTestBrkGDBMIDebugger;
 
178
  i, m: LongInt;
 
179
begin
 
180
  if SkipTest then exit;
 
181
  if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestBreakPoint')] then exit;
 
182
  if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('  TTestBreakPoint.BadInterrupt')] then exit;
 
183
 
 
184
  (* Trigger a InterruptTarget while paused.
 
185
     Test if the app can continue, and reach it normal exit somehow (even if multiply interupts must be skipped)
 
186
  *)
 
187
 
 
188
  ClearTestErrors;
 
189
  FBrkErr := nil;
 
190
 
 
191
  TestCompile(AppDir + 'WatchesPrg.pas', TestExeName, '_wsleep', ' -dWITH_SLEEP ');
 
192
 
 
193
  try
 
194
    LogToFile(LineEnding+'######################  with pause -- 1 break  ########################'+LineEnding+LineEnding);
 
195
    Err := '';
 
196
    dbg := TTestBrkGDBMIDebugger(StartGDB(AppDir, TestExeName));
 
197
    dbg.OnCurrent  := @DoCurrent;
 
198
    with dbg.BreakPoints.Add('WatchesPrg.pas', BREAK_LINE_FOOFUNC) do begin
 
199
      InitialEnabled := True;
 
200
      Enabled := True;
 
201
    end;
 
202
 
 
203
    dbg.OnFeedback  := @DoGetFeedBack;
 
204
 
 
205
    dbg.Run;
 
206
    // at main break
 
207
    if dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC
 
208
    then Err := Err + 'Never reached breakpoint to start with';
 
209
    if dbg.State <> dsPause
 
210
    then Err := Err + 'Never entered dsPause to start with';
 
211
    //dbg.StepOver;
 
212
    //dbg.StepOver;
 
213
 
 
214
    LogToFile('##### INTERRUPT #####');
 
215
    dbg.TestInterruptTarget;
 
216
    dbg.Run;
 
217
    // at main break
 
218
    if dbg.State = dsError
 
219
    then Err := Err + 'Enterred dsError after 1st exec-continue';
 
220
    if dbg.State = dsStop
 
221
    then Err := Err + 'Enterred dsStop after 1st exec-continue';
 
222
 
 
223
    // try to skip to next break
 
224
    if (dbg.State = dsPause) and (dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC)
 
225
    then dbg.Run;
 
226
    if (dbg.State = dsPause) and (dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC)
 
227
    then dbg.Run;
 
228
 
 
229
    if dbg.State = dsError
 
230
    then Err := Err + 'Enterred dsError before reaching break the 2nd time';
 
231
    if dbg.State = dsStop
 
232
    then Err := Err + 'Enterred dsStop before reaching break the 2nd time';
 
233
    if dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC
 
234
    then Err := Err + 'Did not reached breakpoint for the 2nd time';
 
235
 
 
236
 
 
237
    dbg.Run;
 
238
    if (dbg.State = dsPause)
 
239
    then dbg.Run; // got the break really late
 
240
    if (dbg.State = dsPause)
 
241
    then dbg.Run; // got the break really late
 
242
 
 
243
    if dbg.State <> dsStop
 
244
    then Err := Err + 'Never reached final stop';
 
245
  finally
 
246
    TestEquals('Passed pause run', '', Err);
 
247
    dbg.Done;
 
248
    CleanGdb;
 
249
    dbg.Free;
 
250
  end;
 
251
 
 
252
 
 
253
  if TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('    TTestBreakPoint.BadInterrupt.All')] then begin
 
254
    try
 
255
      LogToFile(LineEnding+'######################  with pause -- 2 breaks  ########################'+LineEnding+LineEnding);
 
256
      Err := '';
 
257
      dbg := TTestBrkGDBMIDebugger(StartGDB(AppDir, TestExeName));
 
258
      dbg.OnCurrent  := @DoCurrent;
 
259
      with dbg.BreakPoints.Add('WatchesPrg.pas', BREAK_LINE_FOOFUNC) do begin
 
260
        InitialEnabled := True;
 
261
        Enabled := True;
 
262
      end;
 
263
      with dbg.BreakPoints.Add('WatchesPrg.pas', BREAK_LINE_FOOFUNC_NEST) do begin
 
264
        InitialEnabled := True;
 
265
        Enabled := True;
 
266
      end;
 
267
 
 
268
      dbg.OnFeedback  := @DoGetFeedBack;
 
269
 
 
270
      dbg.Run;
 
271
      // at nested break
 
272
      dbg.Run;
 
273
      // at main break
 
274
      if dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC
 
275
      then Err := Err + 'Never reached breakpoint to start with';
 
276
      if dbg.State <> dsPause
 
277
      then Err := Err + 'Never entered dsPause to start with';
 
278
      //dbg.StepOver;
 
279
      //dbg.StepOver;
 
280
 
 
281
      LogToFile('##### INTERRUPT #####');
 
282
      dbg.TestInterruptTarget;
 
283
      dbg.Run;
 
284
      // at main break
 
285
      if dbg.State = dsError
 
286
      then Err := Err + 'Enterred dsError after 1st exec-continue';
 
287
      if dbg.State = dsStop
 
288
      then Err := Err + 'Enterred dsStop after 1st exec-continue';
 
289
 
 
290
      // try to skip to next break
 
291
      if (dbg.State = dsPause) and (dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC_NEST)
 
292
      then dbg.Run;
 
293
      if (dbg.State = dsPause) and (dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC_NEST)
 
294
      then dbg.Run;
 
295
 
 
296
      if dbg.State = dsError
 
297
      then Err := Err + 'Enterred dsError before reaching nest break the 2nd time';
 
298
      if dbg.State = dsStop
 
299
      then Err := Err + 'Enterred dsStop before reaching nest break the 2nd time';
 
300
      if dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC_NEST
 
301
      then Err := Err + 'Did not reached best breakpoint for the 2nd time';
 
302
 
 
303
 
 
304
      dbg.Run;
 
305
      // try to skip to next break
 
306
      if (dbg.State = dsPause) and (dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC)
 
307
      then dbg.Run;
 
308
      if (dbg.State = dsPause) and (dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC)
 
309
      then dbg.Run;
 
310
 
 
311
      if dbg.State = dsError
 
312
      then Err := Err + 'Enterred dsError before reaching break the 2nd time';
 
313
      if dbg.State = dsStop
 
314
      then Err := Err + 'Enterred dsStop before reaching break the 2nd time';
 
315
      if dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC
 
316
      then Err := Err + 'Did not reached breakpoint for the 2nd time';
 
317
 
 
318
 
 
319
      dbg.Run;
 
320
      if (dbg.State = dsPause)
 
321
      then dbg.Run; // got the break really late
 
322
      if (dbg.State = dsPause)
 
323
      then dbg.Run; // got the break really late
 
324
 
 
325
      if dbg.State <> dsStop
 
326
      then Err := Err + 'Never reached final stop';
 
327
    finally
 
328
      TestEquals('Passed pause run 2 breaks', '', Err);
 
329
      dbg.Done;
 
330
      CleanGdb;
 
331
      dbg.Free;
 
332
    end;
 
333
  end;
 
334
 
 
335
  TestCompile(AppDir + 'WatchesPrg.pas', TestExeName);
 
336
 
 
337
 
 
338
  m := 1;
 
339
  if TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('    TTestBreakPoint.BadInterrupt.All')]
 
340
  then m := 5;  // run extra tests of Passed none-pause run
 
341
 
 
342
  Err := '';
 
343
  for i := 1 to m do begin
 
344
    try
 
345
      LogToFile(LineEnding+'######################  withOUT pause -- NO stepping  ########################'+LineEnding+LineEnding);
 
346
      dbg := TTestBrkGDBMIDebugger(StartGDB(AppDir, TestExeName));
 
347
      dbg.OnCurrent  := @DoCurrent;
 
348
      with dbg.BreakPoints.Add('WatchesPrg.pas', BREAK_LINE_FOOFUNC) do begin
 
349
        InitialEnabled := True;
 
350
        Enabled := True;
 
351
      end;
 
352
 
 
353
      dbg.OnFeedback  := @DoGetFeedBack;
 
354
 
 
355
      dbg.Run;
 
356
      // at main break
 
357
      if dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC
 
358
      then Err := Err + 'Never reached breakpoint to start with';
 
359
      if dbg.State <> dsPause
 
360
      then Err := Err + 'Never entered dsPause to start with';
 
361
      //dbg.StepOver;
 
362
      //dbg.StepOver;
 
363
 
 
364
      LogToFile('##### INTERRUPT #####');
 
365
      dbg.TestInterruptTarget;
 
366
      dbg.Run;
 
367
      // at main break
 
368
      if dbg.State = dsError
 
369
      then Err := Err + 'Enterred dsError after 1st exec-continue';
 
370
      if dbg.State = dsStop
 
371
      then Err := Err + 'Enterred dsStop after 1st exec-continue';
 
372
 
 
373
      // try to skip to next break
 
374
      if (dbg.State = dsPause) and (dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC)
 
375
      then dbg.Run;
 
376
      if (dbg.State = dsPause) and (dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC)
 
377
      then dbg.Run;
 
378
 
 
379
      if dbg.State = dsError
 
380
      then Err := Err + 'Enterred dsError before reaching break the 2nd time';
 
381
      if dbg.State = dsStop
 
382
      then Err := Err + 'Enterred dsStop before reaching break the 2nd time';
 
383
      if dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC
 
384
      then Err := Err + 'Did not reached breakpoint for the 2nd time';
 
385
 
 
386
 
 
387
      dbg.Run;
 
388
      if (dbg.State = dsPause)
 
389
      then dbg.Run; // got the break really late
 
390
      if (dbg.State = dsPause)
 
391
      then dbg.Run; // got the break really late
 
392
 
 
393
      if dbg.State <> dsStop
 
394
      then Err := Err + 'Never reached final stop';
 
395
    finally
 
396
      dbg.Done;
 
397
      CleanGdb;
 
398
      dbg.Free;
 
399
    end;
 
400
  end;
 
401
  IgnoreRes := '';
 
402
  case DebuggerInfo.Version of
 
403
    0..069999: IgnoreRes:= 'all gdb 6.x may or may not fail';
 
404
    070000: IgnoreRes:= 'gdb 7.0.0 may or may not fail';
 
405
    // 7.0.50 seems to always pass
 
406
    // 7.1.x seems to always pass
 
407
    // 7.2.x seems to always pass
 
408
    070300..070399: IgnoreRes:= 'gdb 7.3.x may or may not fail';
 
409
    070400..070499: IgnoreRes:= 'gdb 7.4.x may or may not fail';
 
410
  end;
 
411
  TestEquals('Passed none-pause run', '', Err, 0, IgnoreRes);
 
412
 
 
413
 
 
414
  if TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('    TTestBreakPoint.BadInterrupt.All')] then begin
 
415
 
 
416
    try
 
417
      LogToFile(LineEnding+'######################  withOUT pause -- with stepping  ########################'+LineEnding+LineEnding);
 
418
      Err := '';
 
419
      dbg := TTestBrkGDBMIDebugger(StartGDB(AppDir, TestExeName));
 
420
      dbg.OnCurrent  := @DoCurrent;
 
421
      with dbg.BreakPoints.Add('WatchesPrg.pas', BREAK_LINE_FOOFUNC) do begin
 
422
        InitialEnabled := True;
 
423
        Enabled := True;
 
424
      end;
 
425
 
 
426
      dbg.OnFeedback  := @DoGetFeedBack;
 
427
 
 
428
      dbg.Run;
 
429
      // at main break
 
430
      if dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC
 
431
      then Err := Err + 'Never reached breakpoint to start with';
 
432
      if dbg.State <> dsPause
 
433
      then Err := Err + 'Never entered dsPause to start with';
 
434
      dbg.StepOver;
 
435
      dbg.StepOver;
 
436
 
 
437
      LogToFile('##### INTERRUPT #####');
 
438
      dbg.TestInterruptTarget;
 
439
      dbg.Run;
 
440
      // at main break
 
441
      if dbg.State = dsError
 
442
      then Err := Err + 'Enterred dsError after 1st exec-continue';
 
443
      if dbg.State = dsStop
 
444
      then Err := Err + 'Enterred dsStop after 1st exec-continue';
 
445
 
 
446
      // try to skip to next break
 
447
      if (dbg.State = dsPause) and (dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC)
 
448
      then dbg.Run;
 
449
      if (dbg.State = dsPause) and (dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC)
 
450
      then dbg.Run;
 
451
 
 
452
      if dbg.State = dsError
 
453
      then Err := Err + 'Enterred dsError before reaching break the 2nd time';
 
454
      if dbg.State = dsStop
 
455
      then Err := Err + 'Enterred dsStop before reaching break the 2nd time';
 
456
      if dbg.GetLocation.SrcLine <> BREAK_LINE_FOOFUNC
 
457
      then Err := Err + 'Did not reached breakpoint for the 2nd time';
 
458
 
 
459
 
 
460
      dbg.Run;
 
461
      if (dbg.State = dsPause)
 
462
      then dbg.Run; // got the break really late
 
463
      if (dbg.State = dsPause)
 
464
      then dbg.Run; // got the break really late
 
465
 
 
466
      if dbg.State <> dsStop
 
467
      then Err := Err + 'Never reached final stop';
 
468
    finally
 
469
      TestEquals('Passed none-pause run with steps', '', Err);
 
470
      dbg.Done;
 
471
      CleanGdb;
 
472
      dbg.Free;
 
473
    end;
 
474
  end;
 
475
 
 
476
  AssertTestErrors;
 
477
end;
 
478
 
 
479
initialization
 
480
 
 
481
  RegisterDbgTest(TTestBreakPoint);
 
482
end.
 
483