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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
|
-- CB20001.A
--
-- Grant of Unlimited Rights
--
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
-- unlimited rights in the software and documentation contained herein.
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
-- this public release, the Government intends to confer upon all
-- recipients unlimited rights equal to those held by the Government.
-- These rights include rights to use, duplicate, release or disclose the
-- released technical data and computer software in whole or in part, in
-- any manner and for any purpose whatsoever, and to have or permit others
-- to do so.
--
-- DISCLAIMER
--
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
-- PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
-- Check that exceptions can be handled in accept bodies, and that a
-- task object that has an exception handled in an accept body is still
-- viable for future use.
--
-- TEST DESCRIPTION:
-- Declare a task that has exception handlers within an accept
-- statement in the task body. Declare a task object, and make entry
-- calls with data that will cause various exceptions to be raised
-- by the accept statement. Ensure that the exceptions are:
-- 1) raised and handled locally in the accept body
-- 2) raised in the accept body and handled/reraised to be handled
-- by the task body
-- 3) raised in the accept body and propagated to the calling
-- procedure.
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
with Report;
package CB20001_0 is
Incorrect_Data,
Location_Error,
Off_Screen_Data : exception;
TC_Handled_In_Accept,
TC_Reraised_In_Accept,
TC_Handled_In_Task_Block,
TC_Handled_In_Caller : boolean := False;
type Location_Type is range 0 .. 2000;
task type Submarine_Type is
entry Contact (Location : in Location_Type);
end Submarine_Type;
Current_Position : Location_Type := 0;
end CB20001_0;
--=================================================================--
package body CB20001_0 is
task body Submarine_Type is
begin
loop
Task_Block:
begin
select
accept Contact (Location : in Location_Type) do
if Location > 1000 then
raise Off_Screen_Data;
elsif (Location > 500) and (Location <= 1000) then
raise Location_Error;
elsif (Location > 100) and (Location <= 500) then
raise Incorrect_Data;
else
Current_Position := Location;
end if;
exception
when Off_Screen_Data =>
TC_Handled_In_Accept := True;
when Location_Error =>
TC_Reraised_In_Accept := True;
raise; -- Reraise the Location_Error exception
-- in the task block.
end Contact;
or
terminate;
end select;
exception
when Off_Screen_Data =>
TC_Handled_In_Accept := False;
Report.Failed ("Off_Screen_Data exception " &
"improperly handled in task block");
when Location_Error =>
TC_Handled_In_Task_Block := True;
end Task_Block;
end loop;
exception
when Location_Error | Off_Screen_Data =>
TC_Handled_In_Accept := False;
TC_Handled_In_Task_Block := False;
Report.Failed ("Exception improperly propagated out to task body");
when others =>
null;
end Submarine_Type;
end CB20001_0;
--=================================================================--
with CB20001_0;
with Report;
with ImpDef;
procedure CB20001 is
package Submarine_Tracking renames CB20001_0;
Trident : Submarine_Tracking.Submarine_Type; -- Declare task
Sonar_Contact : Submarine_Tracking.Location_Type;
TC_LEB_Error,
TC_Main_Handler_Used : Boolean := False;
begin
Report.Test ("CB20001", "Check that exceptions can be handled " &
"in accept bodies");
Off_Screen_Block:
begin
Sonar_Contact := 1500;
Trident.Contact (Sonar_Contact); -- Cause Off_Screen_Data exception
-- to be raised and handled in a task
-- accept body.
exception
when Submarine_Tracking.Off_Screen_Data =>
TC_Main_Handler_Used := True;
Report.Failed ("Off_Screen_Data exception improperly handled " &
"in calling procedure");
when others =>
Report.Failed ("Exception handled unexpectedly in " &
"Off_Screen_Block");
end Off_Screen_Block;
Location_Error_Block:
begin
Sonar_Contact := 700;
Trident.Contact (Sonar_Contact); -- Cause Location_Error exception
-- to be raised in task accept body,
-- propogated to a task block, and
-- handled there. Corresponding
-- exception propagated here also.
Report.Failed ("Expected exception not raised");
exception
when Submarine_Tracking.Location_Error =>
TC_LEB_Error := True;
when others =>
Report.Failed ("Exception handled unexpectedly in " &
"Location_Error_Block");
end Location_Error_Block;
Incorrect_Data_Block:
begin
Sonar_Contact := 200;
Trident.Contact (Sonar_Contact); -- Cause Incorrect_Data exception
-- to be raised in task accept body,
-- propogated to calling procedure.
Report.Failed ("Expected exception not raised");
exception
when Submarine_Tracking.Incorrect_Data =>
Submarine_Tracking.TC_Handled_In_Caller := True;
when others =>
Report.Failed ("Exception handled unexpectedly in " &
"Incorrect_Data_Block");
end Incorrect_Data_Block;
if TC_Main_Handler_Used or
not (Submarine_Tracking.TC_Handled_In_Caller and -- Check to see that
Submarine_Tracking.TC_Handled_In_Task_Block and -- all exceptions
Submarine_Tracking.TC_Handled_In_Accept and -- were handled in
Submarine_Tracking.TC_Reraised_In_Accept and -- proper locations.
TC_LEB_Error)
then
Report.Failed ("Exceptions handled in incorrect locations");
end if;
if Integer(Submarine_Tracking.Current_Position) /= 0 then
Report.Failed ("Variable incorrectly written in task processing");
end if;
delay ImpDef.Minimum_Task_Switch;
if Trident'Callable then
Report.Failed ("Task didn't terminate with exception propagation");
end if;
Report.Result;
end CB20001;
|
