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/] [cb/] [cb20005.a] - Blame information for rev 149

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CB20005.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 exceptions are raised and properly handled locally in
28
--      protected operations.
29
--
30
-- TEST DESCRIPTION:
31
--      Declare a package with a protected type, including protected operation
32
--      declarations and private data, simulating a counting semaphore.
33
--      In the main procedure, perform calls on protected operations
34
--      of the protected object designed to induce the raising of exceptions.
35
--
36
--      Ensure that the exceptions are raised and handled locally in a
37
--      protected procedures and functions, and that in this case the
38
--      exceptions will not propagate to the calling unit.  Use specific
39
--      exception handlers in the protected functions.
40
--
41
--
42
--
43
-- CHANGE HISTORY:
44
--      06 Dec 94   SAIC    ACVC 2.0
45
--
46
--!
47
 
48
package CB20005_0 is               -- Package Semaphore.
49
 
50
   Handled_In_Function,
51
   Handled_In_Procedure : Boolean := False;
52
 
53
   Resource_Overflow,
54
   Resource_Underflow   : exception;
55
 
56
   protected type Counting_Semaphore (Max_Resources : Integer) is
57
      procedure Secure;
58
      function  Resource_Limit_Exceeded return Boolean;
59
      procedure Release;
60
   private
61
      Count : Integer := Max_Resources;
62
   end Counting_Semaphore;
63
 
64
end CB20005_0;
65
 
66
     --=================================================================--
67
 
68
with Report;
69
 
70
package body CB20005_0 is               -- Package Semaphore.
71
 
72
   protected body Counting_Semaphore is
73
 
74
      procedure Secure is
75
      begin
76
         if (Count = 0) then               -- No resources left to secure.
77
            raise Resource_Underflow;
78
            Report.Failed
79
              ("Program control not transferred by raise in Secure");
80
         else
81
            Count := Count - 1;             -- Avail resources decremented.
82
         end if;
83
      exception
84
         when Resource_Underflow =>         -- Exception handled locally in
85
            Handled_In_Procedure := True;   -- this protected operation.
86
         when others =>
87
            Report.Failed ("Unexpected exception raised in Secure");
88
      end Secure;
89
 
90
 
91
      function Resource_Limit_Exceeded return Boolean is
92
      begin
93
         if (Count > Max_Resources) then
94
            raise Resource_Overflow;       -- Exception used as control flow
95
                                           -- mechanism.
96
            Report.Failed
97
              ("Program control not transferred by raise in " &
98
               "Resource_Limit_Exceeded");
99
         else
100
            return (False);
101
         end if;
102
      exception
103
         when Resource_Overflow =>         -- Handle its own raised
104
            Handled_In_Function := True;   -- exception.
105
            return (True);
106
         when others =>
107
            Report.Failed
108
              ("Unexpected exception raised in Resource_Limit_Exceeded");
109
      end Resource_Limit_Exceeded;
110
 
111
 
112
      procedure Release is
113
      begin
114
         Count := Count + 1;               -- Count of resources available
115
                                           -- incremented.
116
         if Resource_Limit_Exceeded then   -- Call to protected operation
117
            Count := Count - 1;            -- function that raises/handles
118
         end if;                           -- an exception.
119
      exception
120
         when Resource_Overflow =>
121
            Handled_In_Function := False;
122
            Report.Failed ("Exception propagated to Function Release");
123
         when others =>
124
            Report.Failed ("Unexpected exception raised in Function Release");
125
      end Release;
126
 
127
 
128
   end Counting_Semaphore;
129
 
130
end CB20005_0;
131
 
132
 
133
     --=================================================================--
134
 
135
 
136
with CB20005_0;                           -- Package Semaphore.
137
with Report;
138
 
139
procedure CB20005 is
140
begin
141
 
142
   Report.Test ("CB20005", "Check that exceptions are raised and handled " &
143
                           "correctly in protected operations" );
144
 
145
   Test_Block:
146
   declare
147
 
148
      package Semaphore renames CB20005_0;
149
 
150
      Total_Resources_Available : constant := 1;
151
 
152
      Resources : Semaphore.Counting_Semaphore(Total_Resources_Available);
153
                                          -- An object of protected type.
154
 
155
   begin
156
 
157
      Allocate_Resources:
158
      declare
159
         Loop_Count : Integer := Total_Resources_Available + 1;
160
      begin
161
         for I in 1..Loop_Count loop -- Force exception.
162
            Resources.Secure;
163
         end loop;
164
      exception
165
         when Semaphore.Resource_Underflow =>
166
            Semaphore.Handled_In_Procedure := False; -- Excptn not handled
167
            Report.Failed                            -- in prot. operation.
168
              ("Resource_Underflow exception not handled " &
169
               "in Allocate_Resources");
170
         when others =>
171
            Report.Failed
172
              ("Exception unexpectedly raised during resource allocation");
173
      end Allocate_Resources;
174
 
175
 
176
      Deallocate_Resources:
177
      declare
178
         Loop_Count : Integer := Total_Resources_Available + 1;
179
      begin
180
         for I in 1..Loop_Count loop -- Force excptn.
181
            Resources.Release;
182
         end loop;
183
      exception
184
         when Semaphore.Resource_Overflow =>
185
            Semaphore.Handled_In_Function := False; -- Exception not handled
186
               Report.Failed                        -- in prot. operation.
187
                 ("Resource overflow not handled by function");
188
            when others =>
189
               Report.Failed
190
                 ("Exception raised during resource deallocation");
191
      end Deallocate_Resources;
192
 
193
 
194
      if not (Semaphore.Handled_In_Procedure and -- Incorrect excpt. handling
195
              Semaphore.Handled_In_Function)     -- in protected operations.
196
      then
197
         Report.Failed
198
           ("Improper exception handling by protected operations");
199
      end if;
200
 
201
 
202
   exception
203
      when others =>
204
         Report.Failed ("Exception raised and propagated in test");
205
 
206
   end Test_Block;
207
 
208
   Report.Result;
209
 
210
end CB20005;

powered by: WebSVN 2.1.0

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