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
|
-- C953001.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 if the evaluation of an entry_barrier condition
-- propagates an exception, the exception Program_Error
-- is propagated to all current callers of all entries of the
-- protected object.
--
-- TEST DESCRIPTION:
-- This test declares a protected object (PO) with two entries and
-- a 5 element entry family.
-- All the entries are always closed. However, one of the entries
-- (Oh_No) will get a constraint_error in its barrier_evaluation
-- whenever the global variable Blow_Up is true.
-- An array of tasks is created where the tasks wait on the various
-- entries of the protected object. Once all the tasks are waiting
-- the main procedure calls the entry Oh_No and causes an exception
-- to be propagated to all the tasks. The tasks record the fact
-- that they got the correct exception in global variables that
-- can be checked after the tasks complete.
--
--
-- CHANGE HISTORY:
-- 19 OCT 95 SAIC ACVC 2.1
--
--!
with Report;
with ImpDef;
procedure C953001 is
Verbose : constant Boolean := False;
Max_Tasks : constant := 12;
-- note status and error conditions
Blocked_Entry_Taken : Boolean := False;
In_Oh_No : Boolean := False;
Task_Passed : array (1..Max_Tasks) of Boolean := (1..Max_Tasks => False);
begin
Report.Test ("C953001",
"Check that an exception in an entry_barrier condition" &
" causes Program_Error to be propagated to all current" &
" callers of all entries of the protected object");
declare -- test encapsulation
-- miscellaneous values
Cows : Integer := Report.Ident_Int (1);
Came_Home : Integer := Report.Ident_Int (2);
-- make the Barrier_Condition fail only when we want it to
Blow_Up : Boolean := False;
function Barrier_Condition return Boolean is
begin
if Blow_Up then
return 5 mod Report.Ident_Int(0) = 1;
else
return False;
end if;
end Barrier_Condition;
subtype Family_Index is Integer range 1..5;
protected PO is
entry Block1;
entry Oh_No;
entry Family (Family_Index);
end PO;
protected body PO is
entry Block1 when Report.Ident_Int(0) = Report.Ident_Int(1) is
begin
Blocked_Entry_Taken := True;
end Block1;
-- barrier will get a Constraint_Error (divide by 0)
entry Oh_No when Barrier_Condition is
begin
In_Oh_No := True;
end Oh_No;
entry Family (for Member in Family_Index) when Cows = Came_Home is
begin
Blocked_Entry_Taken := True;
end Family;
end PO;
task type Waiter is
entry Take_Id (Id : Integer);
end Waiter;
Bunch_of_Waiters : array (1..Max_Tasks) of Waiter;
task body Waiter is
Me : Integer;
Action : Integer;
begin
accept Take_Id (Id : Integer) do
Me := Id;
end Take_Id;
Action := Me mod (Family_Index'Last + 1);
begin
if Action = 0 then
PO.Block1;
else
PO.Family (Action);
end if;
Report.Failed ("no exception for task" & Integer'Image (Me));
exception
when Program_Error =>
Task_Passed (Me) := True;
if Verbose then
Report.Comment ("pass for task" & Integer'Image (Me));
end if;
when others =>
Report.Failed ("wrong exception raised in task" &
Integer'Image (Me));
end;
end Waiter;
begin -- test encapsulation
for I in 1..Max_Tasks loop
Bunch_Of_Waiters(I).Take_Id (I);
end loop;
-- give all the Waiters time to get queued
delay 2*ImpDef.Clear_Ready_Queue;
-- cause the protected object to fail
begin
Blow_Up := True;
PO.Oh_No;
Report.Failed ("no exception in call to PO.Oh_No");
exception
when Constraint_Error =>
Report.Failed ("Constraint_Error instead of Program_Error");
when Program_Error =>
if Verbose then
Report.Comment ("main exception passed");
end if;
when others =>
Report.Failed ("wrong exception in main");
end;
end; -- test encapsulation
-- all the tasks have now completed.
-- check the flags for pass/fail info
if Blocked_Entry_Taken then
Report.Failed ("blocked entry taken");
end if;
if In_Oh_No then
Report.Failed ("entry taken with exception in barrier");
end if;
for I in 1..Max_Tasks loop
if not Task_Passed (I) then
Report.Failed ("task" & Integer'Image (I) & " did not pass");
end if;
end loop;
Report.Result;
end C953001;
|
