1-- C953001.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 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
30--      protected object.
31--
32-- TEST DESCRIPTION:
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.
44--
45--
46-- CHANGE HISTORY:
47--      19 OCT 95   SAIC    ACVC 2.1
48--
49--!
50
51
52with Report;
53with ImpDef;
54procedure C953001 is
55    Verbose : constant Boolean := False;
56    Max_Tasks : constant := 12;
57
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);
62
63begin
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");
68
69  declare -- test encapsulation
70    -- miscellaneous values
71    Cows : Integer := Report.Ident_Int (1);
72    Came_Home : Integer := Report.Ident_Int (2);
73
74    -- make the Barrier_Condition fail only when we want it to
75    Blow_Up : Boolean := False;
76
77    function Barrier_Condition return Boolean is
78    begin
79      if Blow_Up then
80         return 5 mod Report.Ident_Int(0) = 1;
81      else
82         return False;
83      end if;
84    end Barrier_Condition;
85
86    subtype Family_Index is Integer range 1..5;
87
88    protected PO is
89      entry Block1;
90      entry Oh_No;
91      entry Family (Family_Index);
92    end PO;
93
94    protected body PO is
95      entry Block1 when Report.Ident_Int(0) = Report.Ident_Int(1) is
96      begin
97        Blocked_Entry_Taken := True;
98      end Block1;
99
100      -- barrier will get a Constraint_Error (divide by 0)
101      entry Oh_No when Barrier_Condition is
102      begin
103        In_Oh_No := True;
104      end Oh_No;
105
106      entry Family (for Member in Family_Index) when Cows = Came_Home is
107      begin
108        Blocked_Entry_Taken := True;
109      end Family;
110    end PO;
111
112
113    task type Waiter is
114      entry Take_Id (Id : Integer);
115    end Waiter;
116
117    Bunch_of_Waiters : array (1..Max_Tasks) of Waiter;
118
119    task body Waiter is
120      Me : Integer;
121      Action : Integer;
122    begin
123      accept Take_Id (Id : Integer) do
124         Me := Id;
125      end Take_Id;
126
127      Action := Me mod (Family_Index'Last + 1);
128      begin
129        if Action = 0 then
130          PO.Block1;
131        else
132          PO.Family (Action);
133        end if;
134        Report.Failed ("no exception for task" & Integer'Image (Me));
135      exception
136         when Program_Error =>
137           Task_Passed (Me) := True;
138           if Verbose then
139             Report.Comment ("pass for task" & Integer'Image (Me));
140           end if;
141         when others =>
142           Report.Failed ("wrong exception raised in task" &
143                          Integer'Image (Me));
144      end;
145    end Waiter;
146
147
148  begin   -- test encapsulation
149    for I in 1..Max_Tasks loop
150      Bunch_Of_Waiters(I).Take_Id (I);
151    end loop;
152
153    -- give all the Waiters time to get queued
154    delay 2*ImpDef.Clear_Ready_Queue;
155
156    -- cause the protected object to fail
157    begin
158      Blow_Up := True;
159      PO.Oh_No;
160      Report.Failed ("no exception in call to PO.Oh_No");
161    exception
162      when Constraint_Error =>
163         Report.Failed ("Constraint_Error instead of Program_Error");
164      when Program_Error =>
165         if Verbose then
166           Report.Comment ("main exception passed");
167         end if;
168      when others =>
169         Report.Failed ("wrong exception in main");
170    end;
171  end;    -- test encapsulation
172
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");
177  end if;
178  if In_Oh_No then
179     Report.Failed ("entry taken with exception in barrier");
180  end if;
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");
184    end if;
185  end loop;
186
187  Report.Result;
188end C953001;
189