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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c974010.a] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C974010.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 the abortable part of an asynchronous select statement
28
--      is not started if the triggering statement is a task entry call to
29
--      a task that has already terminated.
30
--
31
--      Check that Tasking_Error is properly propagated to the asynchronous
32
--      select statement and thus the sequence of statements of the triggering
33
--      alternative is not executed after the abortable part is left.
34
--
35
--      Check that Tasking_Error is re-raised immediately following the
36
--      asynchronous select.
37
--
38
-- TEST DESCRIPTION:
39
--
40
--      Use a small subset of the base Automated Teller Machine simulation
41
--      which is shown in greater detail in other tests of this series.
42
--      Declare a main procedure containing an asynchronous select with a task
43
--      entry call as triggering statement.  Ensure that the task is
44
--      terminated before the entry call.  Use stripped down versions of
45
--      the  called procedures to check the correct path in the test.
46
--
47
--
48
-- CHANGE HISTORY:
49
--      06 Dec 94   SAIC    ACVC 2.0
50
--
51
--!
52
 
53
package C974010_0 is  -- Automated teller machine abstraction.
54
 
55
 
56
   Transaction_Canceled : exception;
57
 
58
   type Key_Enum is (None, Cancel, Deposit, Withdraw);
59
 
60
   type Card_Number_Type is private;
61
   type Card_PIN_Type    is private;
62
   type ATM_Card_Type    is private;
63
 
64
   task type ATM_Keyboard_Task is
65
      entry Cancel_Pressed;
66
   end ATM_Keyboard_Task;
67
 
68
 
69
   procedure Validate_Card (Card : in ATM_Card_Type);
70
 
71
   procedure Perform_Transaction (Card : in ATM_Card_Type);
72
 
73
 
74
private
75
 
76
   type Card_Number_Type is range   1 .. 9999;
77
   type Card_PIN_Type    is range 100 ..  999;
78
 
79
   type ATM_Card_Type is record
80
      Number : Card_Number_Type;
81
      PIN    : Card_PIN_Type;
82
   end record;
83
 
84
end C974010_0;
85
 
86
 
87
     --==================================================================--
88
 
89
 
90
with Report;
91
package body C974010_0 is
92
 
93
 
94
 
95
   -- One of these gets created as "Keyboard" for each transaction
96
   --
97
   task body ATM_Keyboard_Task is
98
      TC_Suicide  : exception;
99
      Key_Pressed : Key_Enum := None;
100
   begin
101
      raise TC_Suicide;   -- Simulate early, unexpected termination
102
 
103
      accept Cancel_Pressed do        -- queued entry call.
104
         null;  --:::: user code for cancel
105
 
106
      end Cancel_Pressed;
107
 
108
   exception
109
      when TC_Suicide =>
110
         null;  -- This is the expected test behavior
111
      when others =>
112
          Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
113
   end ATM_Keyboard_Task;
114
 
115
   procedure Validate_Card (Card : in ATM_Card_Type) is
116
   begin
117
      Report.Failed ("Abortable part was executed");
118
   end Validate_Card;
119
 
120
 
121
   procedure Perform_Transaction (Card : in ATM_Card_Type) is
122
   begin
123
      Report.Failed ("Exception not re-raised immediately following " &
124
                     "asynchronous select");
125
   end Perform_Transaction;
126
 
127
 
128
end C974010_0;
129
 
130
 
131
     --==================================================================--
132
 
133
 
134
with Report;
135
with ImpDef;
136
 
137
with C974010_0;  -- Automated teller machine abstraction.
138
use  C974010_0;
139
 
140
procedure C974010 is
141
 
142
   Card_Data : ATM_Card_Type;
143
   TC_Tasking_Error_Handled : Boolean := false;
144
 
145
begin  -- Main program.
146
 
147
   Report.Test ("C974010", "Asynchronous Select: Trigger is a call to a " &
148
                           "task entry of a task that is already completed");
149
 
150
 
151
   declare
152
      -- Create the task for this transaction
153
      Keyboard : C974010_0.ATM_Keyboard_Task;
154
   begin
155
 
156
      -- Ensure the task is already completed before calling
157
      --
158
      while not Keyboard'terminated loop
159
         delay ImpDef.Minimum_Task_Switch;
160
      end loop;
161
 
162
      --                                    --
163
      -- Asynchronous select is tested here --
164
      --                                    --
165
 
166
      select
167
 
168
         Keyboard.Cancel_Pressed;
169
 
170
         raise Transaction_Canceled;  -- Should not be executed.
171
 
172
      then abort
173
 
174
         -- Since the triggering call is not queued the abortable part
175
         -- should not be executed.
176
         --
177
         Validate_Card (Card_Data);
178
 
179
      end select;
180
      --
181
      -- The propagated exception is re-raised here.
182
 
183
      Perform_Transaction(Card_Data); -- Should not be reached.
184
 
185
   exception
186
      when Transaction_Canceled =>
187
         Report.Failed ("Triggering alternative sequence of statements " &
188
                        "executed");
189
      when Tasking_Error =>
190
         -- This is the expected test path
191
         TC_Tasking_Error_Handled := true;
192
      when others       =>
193
         Report.Failed ("Wrong exception raised: ");
194
   end;
195
 
196
 
197
   if not TC_Tasking_Error_Handled then
198
      Report.Failed ("Tasking_Error not properly propagated");
199
   end if;
200
 
201
   Report.Result;
202
 
203
exception
204
   when Tasking_Error =>
205
        Report.Failed ("Tasking_Error propagated to wrong handler");
206
        Report.Result;
207
 
208
 
209
end C974010;

powered by: WebSVN 2.1.0

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