3 -- Grant of Unlimited Rights
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
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.
27 -- Check that if the evaluation of an entry_barrier condition
28 -- propagates an exception, the exception Program_Error
29 -- is propagated to all current callers of all entries of the
33 -- This test declares a protected object (PO) with two entries and
34 -- a 5 element entry family.
35 -- All the entries are always closed. However, one of the entries
36 -- (Oh_No) will get a constraint_error in its barrier_evaluation
37 -- whenever the global variable Blow_Up is true.
38 -- An array of tasks is created where the tasks wait on the various
39 -- entries of the protected object. Once all the tasks are waiting
40 -- the main procedure calls the entry Oh_No and causes an exception
41 -- to be propagated to all the tasks. The tasks record the fact
42 -- that they got the correct exception in global variables that
43 -- can be checked after the tasks complete.
47 -- 19 OCT 95 SAIC ACVC 2.1
55 Verbose
: constant Boolean := False;
56 Max_Tasks
: constant := 12;
58 -- note status and error conditions
59 Blocked_Entry_Taken
: Boolean := False;
60 In_Oh_No
: Boolean := False;
61 Task_Passed
: array (1..Max_Tasks
) of Boolean := (1..Max_Tasks
=> False);
64 Report
.Test
("C953001",
65 "Check that an exception in an entry_barrier condition" &
66 " causes Program_Error to be propagated to all current" &
67 " callers of all entries of the protected object");
69 declare -- test encapsulation
70 -- miscellaneous values
71 Cows
: Integer := Report
.Ident_Int
(1);
72 Came_Home
: Integer := Report
.Ident_Int
(2);
74 -- make the Barrier_Condition fail only when we want it to
75 Blow_Up
: Boolean := False;
77 function Barrier_Condition
return Boolean is
80 return 5 mod Report
.Ident_Int
(0) = 1;
84 end Barrier_Condition
;
86 subtype Family_Index
is Integer range 1..5;
91 entry Family
(Family_Index
);
95 entry Block1
when Report
.Ident_Int
(0) = Report
.Ident_Int
(1) is
97 Blocked_Entry_Taken
:= True;
100 -- barrier will get a Constraint_Error (divide by 0)
101 entry Oh_No
when Barrier_Condition
is
106 entry Family
(for Member
in Family_Index
) when Cows
= Came_Home
is
108 Blocked_Entry_Taken
:= True;
114 entry Take_Id
(Id
: Integer);
117 Bunch_of_Waiters
: array (1..Max_Tasks
) of Waiter
;
123 accept Take_Id
(Id
: Integer) do
127 Action
:= Me
mod (Family_Index
'Last + 1);
134 Report
.Failed
("no exception for task" & Integer'Image (Me
));
136 when Program_Error
=>
137 Task_Passed
(Me
) := True;
139 Report
.Comment
("pass for task" & Integer'Image (Me
));
142 Report
.Failed
("wrong exception raised in task" &
148 begin -- test encapsulation
149 for I
in 1..Max_Tasks
loop
150 Bunch_Of_Waiters
(I
).Take_Id
(I
);
153 -- give all the Waiters time to get queued
154 delay 2*ImpDef
.Clear_Ready_Queue
;
156 -- cause the protected object to fail
160 Report
.Failed
("no exception in call to PO.Oh_No");
162 when Constraint_Error
=>
163 Report
.Failed
("Constraint_Error instead of Program_Error");
164 when Program_Error
=>
166 Report
.Comment
("main exception passed");
169 Report
.Failed
("wrong exception in main");
171 end; -- test encapsulation
173 -- all the tasks have now completed.
174 -- check the flags for pass/fail info
175 if Blocked_Entry_Taken
then
176 Report
.Failed
("blocked entry taken");
179 Report
.Failed
("entry taken with exception in barrier");
181 for I
in 1..Max_Tasks
loop
182 if not Task_Passed
(I
) then
183 Report
.Failed
("task" & Integer'Image (I
) & " did not pass");