OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c953001.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- 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
 
52
with Report;
53
with ImpDef;
54
procedure 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
 
63
begin
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;
188
end C953001;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.