1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
unit TestEnvironment;
{$mode objfpc}{$H+}
interface
uses
SysUtils, fpcunit, testutils, testregistry, TestBase, GDBMIDebugger, LCLProc,
DbgIntfDebuggerBase, TestDbgControl, TestDbgTestSuites, TestDbgConfig,
TestWatches;
const
BREAK_LINE_ENV1 = 10;
BREAK_LINE_ENV2 = 12;
type
{ TTestEnvironment }
TTestEnvironment = class(TGDBTestCase)
private
FCurLine: Integer;
protected
procedure DoCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
published
procedure TestEnv;
end;
implementation
var
ControlTestEnvironment: Pointer;
{ TTestEnvironment }
procedure TTestEnvironment.DoCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
begin
FCurLine := ALocation.SrcLine;
end;
procedure TTestEnvironment.TestEnv;
var
dbg: TGDBMIDebugger;
TestExeName, s: string;
IgnoreRes: String;
begin
if SkipTest then exit;
if not TestControlCanTest(ControlTestEnvironment) then exit;
ClearTestErrors;
TestCompile(AppDir + 'EnvPrg.pas', TestExeName);
IgnoreRes := '';
{$IFDEF Windows}
if (DebuggerInfo.Version > 060600) and
(DebuggerInfo.Version < 070400)
then
IgnoreRes := 'broken gdb';
{$ENDIF}
s := 'env value 1';
dbg := StartGDB(AppDir, TestExeName);
try
dbg.OnCurrent := @DoCurrent;
dbg.Environment.Add('ETEST1=ab123c');
with dbg.BreakPoints.Add('EnvPrg.pas', BREAK_LINE_ENV1) do begin
InitialEnabled := True;
Enabled := True;
end;
with dbg.BreakPoints.Add('EnvPrg.pas', BREAK_LINE_ENV2) do begin
InitialEnabled := True;
Enabled := True;
end;
dbg.Run;
TestTrue(s+' not in error state', dbg.State <> dsError, 0);
TestTrue(s+' at break', FCurLine = BREAK_LINE_ENV1, 0, IgnoreRes);
finally
dbg.Done;
CleanGdb;
dbg.Free;
end;
s := 'env value 2';
dbg := StartGDB(AppDir, TestExeName);
try
dbg.OnCurrent := @DoCurrent;
dbg.Environment.Add('ETEST1=xxx');
with dbg.BreakPoints.Add('EnvPrg.pas', BREAK_LINE_ENV1) do begin
InitialEnabled := True;
Enabled := True;
end;
with dbg.BreakPoints.Add('EnvPrg.pas', BREAK_LINE_ENV2) do begin
InitialEnabled := True;
Enabled := True;
end;
dbg.Run;
TestTrue(s+' not in error state', dbg.State <> dsError, 0);
TestTrue(s+' at break', FCurLine = BREAK_LINE_ENV2, 0);
finally
dbg.Done;
CleanGdb;
dbg.Free;
end;
AssertTestErrors;
end;
initialization
RegisterDbgTest(TTestEnvironment);
ControlTestEnvironment := TestControlRegisterTest('TTestEnvironment');
end.
|
