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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
program ExceptPrg; {$INLINE OFF}
{$IFDEF TEST_WITH_HPLUS}
{$H+}
{$ELSE}
{$H-}
{$ENDIF}
//{$DEFINE TEST_NO_EXCEPTION_TYPE}{$DEFINE TEST_NO_POINTER_VAR}{$DEFINE TEST_NO_EXCEPTION_TYPE}{$DEFINE TEST_NO_EXCEPTION_VAR}
uses sysutils;
{$IFnDEF TEST_NO_EXCEPTION_TYPE}
type
MyESome = class(Exception) end;
MyEOther = class(Exception) end;
{$ENDIF}
var
i: integer;
{$IFnDEF TEST_NO_POINTER_VAR}
p: pointer; // ensure pointer is in symbol info
{$ENDIF}
{$IFnDEF TEST_NO_STRING_VAR}
s: string[100];
{$ENDIF}
{$IFnDEF TEST_NO_EXCEPTION_VAR}
x: Exception;
{$ENDIF}
{$IFnDEF TEST_NO_EXCEPTION_TYPE}
procedure foo;
var a: string;
begin
a:= 'abc ΓΌΓΌ {[''[{ \n\t'#13#9'#';
raise MyESome.create(a);
end;
{$ENDIF}
{$IFDEF TEST_EXCEPTION_AT}
procedure Bar;
begin
raise Exception.create('at1') at
get_caller_addr(get_caller_frame(get_frame)),
get_caller_frame(get_caller_frame(get_frame));
end;
procedure Bar1;
begin
Bar();
end;
procedure Bar2;
begin
Bar1();
end;
procedure BarBar;
begin
raise Exception.create('at2') at
get_caller_addr(get_frame),
get_caller_frame(get_frame);
end;
procedure BarBar1;
begin
BarBar();
end;
procedure BarBar2;
begin
BarBar1();
end;
{$ENDIF}
{$IFDEF TEST_RUNERR}
{$R+}
procedure Run;
var a: array of integer;
begin
SetLength(a, 2);
a[0] := -2;
a[1] := a[length(a)-a[0]];
end;
procedure Run1;
begin
Run();
end;
{$ENDIF}
{$IFDEF TEST_ASSERT}
{$C+}
procedure check;
begin
Assert(false, 'denied');
end;
procedure check1;
begin
check();
end;
{$ENDIF}
begin
IsConsole := true; // dont show unhandled exceptions
{$IFnDEF TEST_NO_POINTER_VAR}
p := nil;
{$ENDIF}
//foo;
{$IFnDEF TEST_SKIP_EXCEPTION_1}
try
{$IFnDEF TEST_NO_EXCEPTION_VAR}
x := Exception.Create('foo');
raise x;
{$ELSE}
raise Exception.Create('foo');
{$ENDIF}
except
on e: Exception do begin
{$IFnDEF TEST_NO_STRING_VAR}
s := IntToStr(PtrInt(Pointer(e)));
Freemem(GetMem(1)); //writeln(e.Message + s);
{$ELSE}
Freemem(GetMem(1)); //writeln(e.Message);
{$ENDIF}
end;
end;
Freemem(GetMem(1));
{$ENDIF}
{$IFDEF TEST_EXCEPTION_AT}
try
Bar2();
except end;
try
BarBar2();
except end;
{$ENDIF}
{$IFDEF TEST_RUNERR}
Run1();
{$ENDIF}
{$IFDEF TEST_ASSERT}
check1();
{$ENDIF}
{$IFnDEF TEST_NO_EXCEPTION_TYPE}
foo;
{$ENDIF}
Freemem(GetMem(1));
end.
|
