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/] [c940010.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C940010.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 an exception is raised during the execution of an
28
--      entry body it is propagated back to the caller
29
--
30
-- TEST DESCRIPTION:
31
--      Use a small fragment of code from the simulation of a freeway meter
32
--      used in c940007. Create three individual tasks which will be queued on
33
--      the entry as the barrier is set.  Release them one at a time.  A
34
--      procedure which is called within the entry has been modified for this
35
--      test to raise a different exception for each pass through.  Check that
36
--      all expected exceptions are raised and propagated.
37
--
38
--
39
-- CHANGE HISTORY:
40
--      06 Dec 94   SAIC    ACVC 2.0
41
--
42
--!
43
 
44
 
45
with Report;
46
with ImpDef;
47
 
48
procedure C940010 is
49
 
50
    TC_Failed_1 : Boolean := false;
51
 
52
begin
53
 
54
   Report.Test ("C940010", "Check that an exception raised in an entry " &
55
                        "body is propagated back to the caller");
56
 
57
   declare  -- encapsulate the test
58
 
59
      TC_Defined_Error : Exception;    -- User defined exception
60
      TC_Expected_Passage_Total : constant integer := 669;
61
      TC_Int                    : constant integer := 5;
62
 
63
      -- Carrier tasks. One is created for each vehicle arriving at each ramp
64
      task type Vehicle_31;            -- For Ramp_31
65
      type acc_Vehicle_31 is access Vehicle_31;
66
 
67
 
68
      --================================================================
69
      protected Ramp_31 is
70
 
71
         function Meter_in_Use_State return Boolean;
72
         procedure Add_Meter_Queue;
73
         procedure Subtract_Meter_Queue;
74
         entry Wait_at_Meter;
75
         procedure Pulse;
76
         --
77
         procedure TC_Passage (Pass_Point : Integer);
78
         function TC_Get_Passage_Total return integer;
79
         function TC_Get_Current_Exception return integer;
80
 
81
      private
82
 
83
         Release_One_Vehicle : Boolean := false;
84
         Meter_in_Use        : Boolean := true;  -- TC: set true for this test
85
         --
86
         TC_Multiplier       : integer := 1;
87
         TC_Passage_Total    : integer := 0;
88
         -- Use this to cycle through the required exceptions
89
         TC_Current_Exception : integer range 0..3 := 0;
90
 
91
      end Ramp_31;
92
      --================================================================
93
      protected body Ramp_31 is
94
 
95
 
96
         -- Trace the paths through the various routines by totaling the
97
         -- weighted call parameters
98
         procedure TC_Passage (Pass_Point : Integer) is
99
         begin
100
            TC_Passage_Total := TC_Passage_Total+(Pass_Point*TC_Multiplier);
101
         end TC_Passage;
102
 
103
         -- For the final check of the whole test
104
         function TC_Get_Passage_Total return integer is
105
         begin
106
            return TC_Passage_Total;
107
         end TC_Get_Passage_Total;
108
 
109
         function TC_Get_Current_Exception return integer is
110
         begin
111
            return TC_Current_Exception;
112
         end TC_Get_Current_Exception;
113
 
114
 
115
         -----------------
116
 
117
         function Meter_in_Use_State return Boolean is
118
         begin
119
            return Meter_in_Use;
120
         end Meter_in_Use_State;
121
 
122
         -- Simulate the effects of the regular signal pulse
123
         procedure Pulse is
124
         begin
125
            Release_one_Vehicle := true;
126
         end Pulse;
127
 
128
         -- Keep count of vehicles currently on meter queue - we can't use
129
         -- the 'count because we need the outcall trigger
130
         procedure Add_Meter_Queue is
131
         begin
132
            null;    --::: stub
133
         end Add_Meter_Queue;
134
 
135
         -- TC: This routine has been modified to raise the required
136
         --     exceptions
137
         procedure Subtract_Meter_Queue is
138
            TC_Pass_Point1 : constant integer := 10;
139
            TC_Pass_Point2 : constant integer := 20;
140
            TC_Pass_Point3 : constant integer := 30;
141
            TC_Pass_Point9 : constant integer := 1000;  -- error
142
         begin
143
            -- Cycle through the required exceptions, one per call
144
            TC_Current_Exception := TC_Current_Exception + 1;
145
            case TC_Current_Exception is
146
               when 1 =>
147
                     TC_Passage (TC_Pass_Point1);  -- note passage through here
148
                     raise Storage_Error;    -- PREDEFINED EXCEPTION
149
               when 2 =>
150
                     TC_Passage (TC_Pass_Point2);  -- note passage through here
151
                     raise TC_Defined_Error;    -- USER DEFINED EXCEPTION
152
               when 3 =>
153
                     TC_Passage (TC_Pass_Point3);  -- note passage through here
154
                     -- RUN TIME EXCEPTION (Constraint_Error)
155
                     -- Add the value 3 to 5 then try to assign it to an object
156
                     -- whose range is 0..3  - this causes the exception.
157
                     -- Disguise the values which cause the Constraint_Error
158
                     -- so that the optimizer will not eliminate this code
159
                     --    Note: the variable is checked at the end to ensure
160
                     --    that the actual assignment is attempted.  Also note
161
                     --    the value remains at 3 as the assignment does not
162
                     --    take place.  This is the value that is checked at
163
                     --    the end of the test.
164
                     -- Otherwise the optimizer could decide that the result
165
                     -- of the assignment was not used so why bother to do it?
166
                     TC_Current_Exception :=
167
                               Report.Ident_Int (TC_Current_Exception) +
168
                               Report.Ident_Int (TC_Int);
169
               when others =>
170
                     -- Set flag for Report.Failed which cannot be called from
171
                     -- within a Protected Object
172
                     TC_Failed_1 := True;
173
            end case;
174
 
175
            TC_Passage ( TC_Pass_Point9 );  -- note passage through here
176
         end Subtract_Meter_Queue;
177
 
178
         -- Here each Vehicle task queues itself awaiting release
179
         entry Wait_at_Meter when Release_One_Vehicle is
180
         -- Example of entry with barriers and persistent signal
181
            TC_Pass_Point : constant integer := 2;
182
         begin
183
            TC_Passage ( TC_Pass_Point );   -- note passage through here
184
            Release_One_Vehicle := false;   -- Consume the signal
185
            -- Decrement number of vehicles on ramp
186
            Subtract_Meter_Queue;  -- Call procedure from within entry body
187
         end Wait_at_Meter;
188
 
189
      end Ramp_31;
190
      --================================================================
191
 
192
      -- Carrier task. One is created for each vehicle arriving at Ramp_31
193
      task body Vehicle_31 is
194
         TC_Pass_Point_1 : constant integer := 100;
195
         TC_Pass_Point_2 : constant integer := 200;
196
         TC_Pass_Point_3 : constant integer := 300;
197
      begin
198
         if Ramp_31.Meter_in_Use_State then
199
            -- Increment count of number of vehicles on ramp
200
            Ramp_31.Add_Meter_Queue;    -- Call a protected procedure
201
                                          -- which is also called from within
202
            -- enter the meter queue
203
            Ramp_31.Wait_at_Meter;      -- Call a protected entry
204
            Report.Failed ("Exception not propagated back");
205
         end if;
206
         null;  --:::: call to the first in the series of the Ramp_Sensors
207
                --     this "passes" the vehicle from one sensor to the next
208
      exception
209
         when Storage_Error =>
210
               Ramp_31.TC_Passage ( TC_Pass_Point_1 );  -- note passage
211
         when TC_Defined_Error =>
212
               Ramp_31.TC_Passage ( TC_Pass_Point_2 );  -- note passage
213
         when Constraint_Error =>
214
               Ramp_31.TC_Passage ( TC_Pass_Point_3 );  -- note passage
215
         when others =>
216
               Report.Failed ("Unexpected exception in Vehicle Task");
217
      end Vehicle_31;
218
 
219
      -- Simulate the arrival of a vehicle at the Ramp_Receiver of Ramp_31
220
      -- and the generation of an accompanying carrier task
221
      procedure New_Arrival_31 is
222
         Next_Vehicle_Task_31: acc_Vehicle_31 := new Vehicle_31;
223
         TC_Pass_Point : constant integer := 1;
224
      begin
225
         Ramp_31.TC_Passage ( TC_Pass_Point );  -- Note passage through here
226
         null;  --::: stub
227
      end New_arrival_31;
228
 
229
 
230
 
231
   begin -- declare
232
 
233
      -- Test driver.  This is ALL test control code
234
 
235
      -- Create three independent tasks which will queue themselves on the
236
      -- entry.  Each task will get a different exception
237
      New_Arrival_31;
238
      New_Arrival_31;
239
      New_Arrival_31;
240
 
241
      delay ImpDef.Clear_Ready_Queue;
242
 
243
      -- Set the barrier condition of the entry true, releasing one task
244
      Ramp_31.Pulse;
245
      delay ImpDef.Clear_Ready_Queue;
246
 
247
      Ramp_31.Pulse;
248
      delay ImpDef.Clear_Ready_Queue;
249
 
250
      Ramp_31.Pulse;
251
      delay ImpDef.Clear_Ready_Queue;
252
 
253
      if (TC_Expected_Passage_Total /= Ramp_31.TC_Get_Passage_Total)  or
254
         -- Note: We are not really interested in this next check.  It is
255
         --       here to ensure the earlier statements which raised the
256
         --       Constraint_Error are not optimized out
257
         (Ramp_31.TC_Get_Current_Exception /= 3) then
258
            Report.Failed ("Unexpected paths taken");
259
      end if;
260
 
261
   end; -- declare
262
 
263
   if TC_Failed_1 then
264
      Report.Failed ("Bad path through Subtract_Meter_Queue");
265
   end if;
266
 
267
   Report.Result;
268
 
269
end C940010;

powered by: WebSVN 2.1.0

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