summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/c9/c953001.a
blob: bc9c85f302f6b0c3d214cc1250b43cd8a7233b1e (plain)
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;