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
|
{ %skiptarget=go32v2 }
{ %OPT=-CE }
{$mode objfpc}
uses
sysutils;
const
Program_has_errors : boolean = false;
exception_called : boolean = false;
TestNumber : longint = 10000;
procedure test_exception(const s : string);
begin
if not(exception_called) then
begin
Writeln('Exception not called : ',s);
Program_has_errors := true;
end;
end;
var
i,j : longint;
e : extended;
exception_count,level : longint;
begin
j:=0;
i:=100;
try
exception_called:=false;
j := i div j;
except
on e : exception do
begin
Writeln('First integer exception called ',e.message);
exception_called:=true;
end;
end;
test_exception('First division by zero for integers');
try
exception_called:=false;
j := i div j;
except
on e : exception do
begin
Writeln('Second integer exception called ',e.message);
exception_called:=true;
end;
end;
test_exception('Second division by zero for integers');
try
exception_called:=false;
e:=i/j;
except
on e : exception do
begin
Writeln('First real exception called ',e.message);
exception_called:=true;
end;
end;
test_exception('First division by zero for reals');
try
exception_called:=false;
e:=i/j;
except
on e : exception do
begin
Writeln('Second real exception called ',e.message);
exception_called:=true;
end;
end;
test_exception('Second division by zero for reals');
try
exception_called:=false;
j := i div j;
except
on e : exception do
begin
Writeln('exception called ',e.message);
exception_called:=true;
end;
end;
test_exception('third division by zero for integers');
exception_count:=0;
level:=0;
for j:=1 to TestNumber do
begin
try
i:=0;
inc(level);
e:=j/i;
except
on e : exception do
begin
inc(exception_count);
if level>1 then
Writeln('exception overrun');
dec(level);
end;
end;
end;
if exception_count<>TestNumber then
begin
program_has_errors:=true;
Writeln('Could not generate ',TestNumber,' consecutive exceptions');
Writeln('Only ',exception_count,' exceptions were generated');
end
else
begin
Writeln(TestNumber,' consecutive exceptions generated successfully');
end;
try
exception_called:=false;
i := -1;
e := ln(i);
except
on e : exception do
begin
Writeln('exception called ',e.message);
exception_called:=true;
end;
end;
test_exception('ln(-1)');
if program_has_errors then
Halt(1);
end.
|
