|
111
|
1 -- CB20001.A
|
|
|
2 --
|
|
|
3 -- Grant of Unlimited Rights
|
|
|
4 --
|
|
|
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
|
|
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
|
|
7 -- unlimited rights in the software and documentation contained herein.
|
|
|
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
|
|
9 -- this public release, the Government intends to confer upon all
|
|
|
10 -- recipients unlimited rights equal to those held by the Government.
|
|
|
11 -- These rights include rights to use, duplicate, release or disclose the
|
|
|
12 -- released technical data and computer software in whole or in part, in
|
|
|
13 -- any manner and for any purpose whatsoever, and to have or permit others
|
|
|
14 -- to do so.
|
|
|
15 --
|
|
|
16 -- DISCLAIMER
|
|
|
17 --
|
|
|
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
|
|
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
|
|
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
|
|
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
|
|
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
|
|
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
|
|
|
24 --*
|
|
|
25 --
|
|
|
26 -- OBJECTIVE:
|
|
|
27 -- Check that exceptions can be handled in accept bodies, and that a
|
|
|
28 -- task object that has an exception handled in an accept body is still
|
|
|
29 -- viable for future use.
|
|
|
30 --
|
|
|
31 -- TEST DESCRIPTION:
|
|
|
32 -- Declare a task that has exception handlers within an accept
|
|
|
33 -- statement in the task body. Declare a task object, and make entry
|
|
|
34 -- calls with data that will cause various exceptions to be raised
|
|
|
35 -- by the accept statement. Ensure that the exceptions are:
|
|
|
36 -- 1) raised and handled locally in the accept body
|
|
|
37 -- 2) raised in the accept body and handled/reraised to be handled
|
|
|
38 -- by the task body
|
|
|
39 -- 3) raised in the accept body and propagated to the calling
|
|
|
40 -- procedure.
|
|
|
41 --
|
|
|
42 --
|
|
|
43 -- CHANGE HISTORY:
|
|
|
44 -- 06 Dec 94 SAIC ACVC 2.0
|
|
|
45 --
|
|
|
46 --!
|
|
|
47
|
|
|
48 with Report;
|
|
|
49
|
|
|
50 package CB20001_0 is
|
|
|
51
|
|
|
52 Incorrect_Data,
|
|
|
53 Location_Error,
|
|
|
54 Off_Screen_Data : exception;
|
|
|
55
|
|
|
56 TC_Handled_In_Accept,
|
|
|
57 TC_Reraised_In_Accept,
|
|
|
58 TC_Handled_In_Task_Block,
|
|
|
59 TC_Handled_In_Caller : boolean := False;
|
|
|
60
|
|
|
61 type Location_Type is range 0 .. 2000;
|
|
|
62
|
|
|
63 task type Submarine_Type is
|
|
|
64 entry Contact (Location : in Location_Type);
|
|
|
65 end Submarine_Type;
|
|
|
66
|
|
|
67 Current_Position : Location_Type := 0;
|
|
|
68
|
|
|
69 end CB20001_0;
|
|
|
70
|
|
|
71
|
|
|
72 --=================================================================--
|
|
|
73
|
|
|
74
|
|
|
75 package body CB20001_0 is
|
|
|
76
|
|
|
77
|
|
|
78 task body Submarine_Type is
|
|
|
79 begin
|
|
|
80 loop
|
|
|
81
|
|
|
82 Task_Block:
|
|
|
83 begin
|
|
|
84 select
|
|
|
85 accept Contact (Location : in Location_Type) do
|
|
|
86 if Location > 1000 then
|
|
|
87 raise Off_Screen_Data;
|
|
|
88 elsif (Location > 500) and (Location <= 1000) then
|
|
|
89 raise Location_Error;
|
|
|
90 elsif (Location > 100) and (Location <= 500) then
|
|
|
91 raise Incorrect_Data;
|
|
|
92 else
|
|
|
93 Current_Position := Location;
|
|
|
94 end if;
|
|
|
95 exception
|
|
|
96 when Off_Screen_Data =>
|
|
|
97 TC_Handled_In_Accept := True;
|
|
|
98 when Location_Error =>
|
|
|
99 TC_Reraised_In_Accept := True;
|
|
|
100 raise; -- Reraise the Location_Error exception
|
|
|
101 -- in the task block.
|
|
|
102 end Contact;
|
|
|
103 or
|
|
|
104 terminate;
|
|
|
105 end select;
|
|
|
106
|
|
|
107 exception
|
|
|
108
|
|
|
109 when Off_Screen_Data =>
|
|
|
110 TC_Handled_In_Accept := False;
|
|
|
111 Report.Failed ("Off_Screen_Data exception " &
|
|
|
112 "improperly handled in task block");
|
|
|
113
|
|
|
114 when Location_Error =>
|
|
|
115 TC_Handled_In_Task_Block := True;
|
|
|
116 end Task_Block;
|
|
|
117
|
|
|
118 end loop;
|
|
|
119
|
|
|
120 exception
|
|
|
121
|
|
|
122 when Location_Error | Off_Screen_Data =>
|
|
|
123 TC_Handled_In_Accept := False;
|
|
|
124 TC_Handled_In_Task_Block := False;
|
|
|
125 Report.Failed ("Exception improperly propagated out to task body");
|
|
|
126 when others =>
|
|
|
127 null;
|
|
|
128 end Submarine_Type;
|
|
|
129
|
|
|
130 end CB20001_0;
|
|
|
131
|
|
|
132
|
|
|
133 --=================================================================--
|
|
|
134
|
|
|
135
|
|
|
136 with CB20001_0;
|
|
|
137 with Report;
|
|
|
138 with ImpDef;
|
|
|
139
|
|
|
140 procedure CB20001 is
|
|
|
141
|
|
|
142 package Submarine_Tracking renames CB20001_0;
|
|
|
143
|
|
|
144 Trident : Submarine_Tracking.Submarine_Type; -- Declare task
|
|
|
145 Sonar_Contact : Submarine_Tracking.Location_Type;
|
|
|
146
|
|
|
147 TC_LEB_Error,
|
|
|
148 TC_Main_Handler_Used : Boolean := False;
|
|
|
149
|
|
|
150 begin
|
|
|
151
|
|
|
152 Report.Test ("CB20001", "Check that exceptions can be handled " &
|
|
|
153 "in accept bodies");
|
|
|
154
|
|
|
155
|
|
|
156 Off_Screen_Block:
|
|
|
157 begin
|
|
|
158 Sonar_Contact := 1500;
|
|
|
159 Trident.Contact (Sonar_Contact); -- Cause Off_Screen_Data exception
|
|
|
160 -- to be raised and handled in a task
|
|
|
161 -- accept body.
|
|
|
162 exception
|
|
|
163 when Submarine_Tracking.Off_Screen_Data =>
|
|
|
164 TC_Main_Handler_Used := True;
|
|
|
165 Report.Failed ("Off_Screen_Data exception improperly handled " &
|
|
|
166 "in calling procedure");
|
|
|
167 when others =>
|
|
|
168 Report.Failed ("Exception handled unexpectedly in " &
|
|
|
169 "Off_Screen_Block");
|
|
|
170 end Off_Screen_Block;
|
|
|
171
|
|
|
172
|
|
|
173 Location_Error_Block:
|
|
|
174 begin
|
|
|
175 Sonar_Contact := 700;
|
|
|
176 Trident.Contact (Sonar_Contact); -- Cause Location_Error exception
|
|
|
177 -- to be raised in task accept body,
|
|
|
178 -- propogated to a task block, and
|
|
|
179 -- handled there. Corresponding
|
|
|
180 -- exception propagated here also.
|
|
|
181 Report.Failed ("Expected exception not raised");
|
|
|
182 exception
|
|
|
183 when Submarine_Tracking.Location_Error =>
|
|
|
184 TC_LEB_Error := True;
|
|
|
185 when others =>
|
|
|
186 Report.Failed ("Exception handled unexpectedly in " &
|
|
|
187 "Location_Error_Block");
|
|
|
188 end Location_Error_Block;
|
|
|
189
|
|
|
190
|
|
|
191 Incorrect_Data_Block:
|
|
|
192 begin
|
|
|
193 Sonar_Contact := 200;
|
|
|
194 Trident.Contact (Sonar_Contact); -- Cause Incorrect_Data exception
|
|
|
195 -- to be raised in task accept body,
|
|
|
196 -- propogated to calling procedure.
|
|
|
197 Report.Failed ("Expected exception not raised");
|
|
|
198 exception
|
|
|
199 when Submarine_Tracking.Incorrect_Data =>
|
|
|
200 Submarine_Tracking.TC_Handled_In_Caller := True;
|
|
|
201 when others =>
|
|
|
202 Report.Failed ("Exception handled unexpectedly in " &
|
|
|
203 "Incorrect_Data_Block");
|
|
|
204 end Incorrect_Data_Block;
|
|
|
205
|
|
|
206
|
|
|
207 if TC_Main_Handler_Used or
|
|
|
208 not (Submarine_Tracking.TC_Handled_In_Caller and -- Check to see that
|
|
|
209 Submarine_Tracking.TC_Handled_In_Task_Block and -- all exceptions
|
|
|
210 Submarine_Tracking.TC_Handled_In_Accept and -- were handled in
|
|
|
211 Submarine_Tracking.TC_Reraised_In_Accept and -- proper locations.
|
|
|
212 TC_LEB_Error)
|
|
|
213 then
|
|
|
214 Report.Failed ("Exceptions handled in incorrect locations");
|
|
|
215 end if;
|
|
|
216
|
|
|
217 if Integer(Submarine_Tracking.Current_Position) /= 0 then
|
|
|
218 Report.Failed ("Variable incorrectly written in task processing");
|
|
|
219 end if;
|
|
|
220
|
|
|
221 delay ImpDef.Minimum_Task_Switch;
|
|
|
222 if Trident'Callable then
|
|
|
223 Report.Failed ("Task didn't terminate with exception propagation");
|
|
|
224 end if;
|
|
|
225
|
|
|
226 Report.Result;
|
|
|
227
|
|
|
228 end CB20001;
|
