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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CB20006.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 (including
28
--      propagation by reraise) in 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
--      The exceptions raised are to be initially handled in the protected
37
--      operations, but this handling involves the reraise of the exception
38
--      and the propagation of the exception to the caller.
39
--
40
--      Ensure that the exceptions are raised, handled / reraised successfully
41
--      in protected procedures and functions.  Use "others" handlers in the
42
--      protected operations.
43
--
44
--
45
-- CHANGE HISTORY:
46
--      06 Dec 94   SAIC    ACVC 2.0
47
--
48
--!
49
 
50
package CB20006_0 is               -- Package Semaphore.
51
 
52
   Reraised_In_Function,
53
   Reraised_In_Procedure,
54
   Handled_In_Function_Caller,
55
   Handled_In_Procedure_Caller   : Boolean := False;
56
 
57
   Resource_Overflow,
58
   Resource_Underflow            : exception;
59
 
60
   protected type Counting_Semaphore (Max_Resources : Integer) is
61
      procedure Secure;
62
      function  Resource_Limit_Exceeded return Boolean;
63
      procedure Release;
64
   private
65
      Count : Integer := Max_Resources;
66
   end Counting_Semaphore;
67
 
68
end CB20006_0;
69
 
70
     --=================================================================--
71
 
72
with Report;
73
 
74
package body CB20006_0 is                 -- Package Semaphore.
75
 
76
   protected body Counting_Semaphore is
77
 
78
      procedure Secure is
79
      begin
80
         if (Count = 0) then              -- No resources left to secure.
81
            raise Resource_Underflow;
82
            Report.Failed
83
              ("Program control not transferred by raise in Procedure Secure");
84
         else
85
            Count := Count - 1;           -- Available resources decremented.
86
         end if;
87
      exception
88
         when Resource_Underflow =>
89
            Reraised_In_Procedure := True;
90
            raise;                        -- Exception propagated to caller.
91
            Report.Failed ("Exception not propagated to caller from Secure");
92
         when others =>
93
            Report.Failed ("Unexpected exception raised in Secure");
94
      end Secure;
95
 
96
 
97
      function Resource_Limit_Exceeded return Boolean is
98
      begin
99
         if (Count > Max_Resources) then
100
            raise Resource_Overflow;      -- Exception used as control flow
101
                                          -- mechanism.
102
            Report.Failed
103
              ("Specific raise did not alter program control" &
104
               " from Resource_Limit_Exceeded");
105
         else
106
            return (False);
107
         end if;
108
      exception
109
         when others =>
110
            Reraised_In_Function := True;
111
            raise;                         -- Exception propagated to caller.
112
            Report.Failed ("Exception not propagated to caller" &
113
                           " from Resource_Limit_Exceeded");
114
      end Resource_Limit_Exceeded;
115
 
116
 
117
      procedure Release is
118
      begin
119
         Count := Count + 1;               -- Count of resources available
120
                                           -- incremented.
121
         if Resource_Limit_Exceeded then   -- Call to protected operation
122
            Count := Count - 1;            -- function that raises/reraises
123
                                           -- an exception.
124
            Report.Failed("Resource limit exceeded");
125
         end if;
126
 
127
      exception
128
         when others =>
129
            raise;                         -- Reraised and propagated again.
130
             Report.Failed ("Exception not reraised by procedure Release");
131
      end Release;
132
 
133
 
134
   end Counting_Semaphore;
135
 
136
end CB20006_0;
137
 
138
 
139
     --=================================================================--
140
 
141
 
142
with CB20006_0;                           -- Package Semaphore.
143
with Report;
144
 
145
procedure CB20006 is
146
begin
147
 
148
   Report.Test ("CB20006", "Check that exceptions are raised and " &
149
                           "handled / reraised and propagated "    &
150
                           "correctly by protected operations" );
151
 
152
   Test_Block:
153
   declare
154
 
155
      package Semaphore renames CB20006_0;
156
 
157
      Total_Resources_Available : constant := 1;
158
 
159
      Resources : Semaphore.Counting_Semaphore (Total_Resources_Available);
160
                                             -- An object of protected type.
161
 
162
   begin
163
 
164
      Allocate_Resources:
165
      declare
166
         Loop_Count : Integer := Total_Resources_Available + 1;
167
      begin
168
         for I in 1..Loop_Count loop -- Force exception
169
            Resources.Secure;
170
         end loop;
171
         Report.Failed
172
           ("Exception not propagated from protected operation Secure");
173
      exception
174
         when Semaphore.Resource_Underflow =>        -- Exception propagated
175
           Semaphore.Handled_In_Procedure_Caller := True;  -- from protected
176
         when others =>                                    -- procedure.
177
           Semaphore.Handled_In_Procedure_Caller := False;
178
      end Allocate_Resources;
179
 
180
 
181
      Deallocate_Resources:
182
      declare
183
         Loop_Count : Integer := Total_Resources_Available + 1;
184
      begin
185
         for I in 1..Loop_Count loop -- Force exception
186
            Resources.Release;
187
         end loop;
188
         Report.Failed
189
           ("Exception not propagated from protected operation Release");
190
      exception
191
         when Semaphore.Resource_Overflow =>        -- Exception propagated
192
            Semaphore.Handled_In_Function_Caller := True; -- from protected
193
         when others =>                                   -- function.
194
            Semaphore.Handled_In_Function_Caller := False;
195
      end Deallocate_Resources;
196
 
197
 
198
      if not (Semaphore.Reraised_In_Procedure and
199
              Semaphore.Reraised_In_Function  and
200
              Semaphore.Handled_In_Procedure_Caller and
201
              Semaphore.Handled_In_Function_Caller)
202
      then                                       -- Incorrect excpt. handling
203
         Report.Failed                           -- in protected operations.
204
           ("Improper exception handling/reraising by protected operations");
205
      end if;
206
 
207
   exception
208
 
209
      when others =>
210
         Report.Failed ("Unexpected exception " &
211
                        " raised and propagated in test");
212
   end Test_Block;
213
 
214
   Report.Result;
215
 
216
 
217
end CB20006;

powered by: WebSVN 2.1.0

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