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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CB41003.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 an exception occurrence can be saved into an object of
28
--      type Exception_Occurrence using the procedure Save_Occurrence.
29
--      Check that a saved exception occurrence can be used to reraise
30
--      another occurrence of the same exception using the procedure
31
--      Reraise_Occurrence.  Check that the function Save_Occurrence will
32
--      allocate a new object of type Exception_Occurrence_Access, and saves
33
--      the source exception to the new object which is returned as the
34
--      function result.
35
--
36
-- TEST DESCRIPTION:
37
--      This test verifies that an occurrence of an exception can be saved,
38
--      using either of two overloaded versions of Save_Occurrence.  The
39
--      procedure version of Save_Occurrence is used to save an occurrence
40
--      of a user defined exception into an object of type
41
--      Exception_Occurrence.  This object is then used as an input
42
--      parameter to procedure Reraise_Occurrence, the expected exception is
43
--      handled, and the exception id of the handled exception is compared
44
--      to the id of the originally raised exception.
45
--      The function version of Save_Occurrence returns a result of
46
--      Exception_Occurrence_Access, and is used to store the value of another
47
--      occurrence of the user defined exception.  The resulting access value
48
--      is dereferenced and used as an input to Reraise_Occurrence.  The
49
--      resulting exception is handled, and the exception id of the handled
50
--      exception is compared to the id of the originally raised exception.
51
--
52
--
53
-- CHANGE HISTORY:
54
--      06 Dec 94   SAIC    ACVC 2.0
55
--
56
--!
57
 
58
with Report;
59
with Ada.Exceptions;
60
 
61
procedure CB41003 is
62
 
63
begin
64
 
65
   Report.Test ("CB41003", "Check that an exception occurrence can "   &
66
                           "be saved into an object of type "          &
67
                           "Exception_Occurrence using the procedure " &
68
                           "Save_Occurrence");
69
 
70
   Test_Block:
71
   declare
72
 
73
      use Ada.Exceptions;
74
 
75
      User_Exception_1,
76
      User_Exception_2   : Exception;
77
 
78
      Saved_Occurrence   : Exception_Occurrence;
79
      Occurrence_Ptr     : Exception_Occurrence_Access;
80
 
81
      User_Message       : constant String :=   -- 200 character string.
82
        "The string returned by Exception_Message may be tr" &
83
        "uncated (to no less then 200 characters) by the Sa" &
84
        "ve_Occurrence procedure (not the function), the Re" &
85
        "raise_Occurrence proc, and the re-raise statement.";
86
 
87
   begin
88
 
89
      Raise_And_Save_Block_1 :
90
      begin
91
 
92
         -- This nested exception structure is designed to ensure that the
93
         -- appropriate exception occurrence is saved using the
94
         -- Save_Occurrence procedure.
95
 
96
         raise Program_Error;
97
         Report.Failed("Program_Error not raised");
98
 
99
      exception
100
         when Program_Error =>
101
 
102
            begin
103
               -- Use the procedure Raise_Exception, along with the 'Identity
104
               -- attribute to raise the first user defined exception.  Note
105
               -- that a 200 character message is included in the call.
106
 
107
               Raise_Exception(User_Exception_1'Identity, User_Message);
108
               Report.Failed("User_Exception_1 not raised");
109
 
110
            exception
111
               when Exc : User_Exception_1 =>
112
 
113
                  -- This exception occurrence is saved into a variable using
114
                  -- procedure Save_Occurrence.  This saved occurrence should
115
                  -- not be confused with the raised occurrence of
116
                  -- Program_Error above.
117
 
118
                  Save_Occurrence(Target => Saved_Occurrence, Source => Exc);
119
 
120
               when others =>
121
                  Report.Failed("Unexpected exception handled, expecting " &
122
                                "User_Exception_1");
123
            end;
124
 
125
         when others =>
126
            Report.Failed("Incorrect exception generated by raise statement");
127
 
128
      end Raise_And_Save_Block_1;
129
 
130
 
131
      Reraise_And_Handle_Saved_Exception_1 :
132
      begin
133
         -- Reraise the exception that was saved in the previous block.
134
 
135
         Reraise_Occurrence(X => Saved_Occurrence);
136
 
137
      exception
138
         when Exc : User_Exception_1 => -- Expected exception.
139
            -- Check the exception id of the handled id by using the
140
            -- Exception_Identity function, and compare with the id of the
141
            -- originally raised exception.
142
 
143
            if User_Exception_1'Identity /= Exception_Identity(Exc) then
144
               Report.Failed("Exception_Ids do not match - 1");
145
            end if;
146
 
147
            -- Check that the message associated with this exception occurrence
148
            -- has not been truncated (it was originally 200 characters).
149
 
150
            if User_Message /= Exception_Message(Exc) then
151
               Report.Failed("Exception messages do not match - 1");
152
            end if;
153
 
154
         when others =>
155
            Report.Failed
156
              ("Incorrect exception raised by Reraise_Occurrence - 1");
157
      end Reraise_And_Handle_Saved_Exception_1;
158
 
159
 
160
      Raise_And_Save_Block_2 :
161
      begin
162
 
163
         Raise_Exception(User_Exception_2'Identity, User_Message);
164
         Report.Failed("User_Exception_2 not raised");
165
 
166
      exception
167
         when Exc : User_Exception_2 =>
168
 
169
            -- This exception occurrence is saved into an access object
170
            -- using function Save_Occurrence.
171
 
172
            Occurrence_Ptr := Save_Occurrence(Source => Exc);
173
 
174
         when others =>
175
            Report.Failed("Unexpected exception handled, expecting " &
176
                          "User_Exception_2");
177
      end Raise_And_Save_Block_2;
178
 
179
 
180
      Reraise_And_Handle_Saved_Exception_2 :
181
      begin
182
         -- Reraise the exception that was saved in the previous block.
183
         -- Dereference the access object for use as input parameter.
184
 
185
         Reraise_Occurrence(X => Occurrence_Ptr.all);
186
 
187
      exception
188
         when Exc : User_Exception_2 => -- Expected exception.
189
            -- Check the exception id of the handled id by using the
190
            -- Exception_Identity function, and compare with the id of the
191
            -- originally raised exception.
192
 
193
            if User_Exception_2'Identity /= Exception_Identity(Exc) then
194
               Report.Failed("Exception_Ids do not match - 2");
195
            end if;
196
 
197
            -- Check that the message associated with this exception occurrence
198
            -- has not been truncated (it was originally 200 characters).
199
 
200
            if User_Message /= Exception_Message(Exc) then
201
               Report.Failed("Exception messages do not match - 2");
202
            end if;
203
 
204
         when others =>
205
            Report.Failed
206
              ("Incorrect exception raised by Reraise_Occurrence - 2");
207
       end Reraise_And_Handle_Saved_Exception_2;
208
 
209
 
210
       -- Another example of the use of saving an exception occurrence
211
       -- is demonstrated in the following block, where the ability to
212
       -- save an occurrence into a data structure, for later processing,
213
       -- is modeled.
214
 
215
       Store_And_Handle_Block:
216
       declare
217
 
218
          Exc_Number  : constant := 3;
219
          Exception_1,
220
          Exception_2,
221
          Exception_3 : exception;
222
 
223
          Exception_Storage : array (1..Exc_Number) of Exception_Occurrence;
224
          Messages          : array (1..Exc_Number) of String(1..9) :=
225
                                ("Message 1", "Message 2", "Message 3");
226
 
227
       begin
228
 
229
          Outer_Block:
230
          begin
231
 
232
             Inner_Block:
233
             begin
234
 
235
                for i in 1..Exc_Number loop
236
                   begin
237
 
238
                      begin
239
                         -- Exceptions all raised in a deep scope.
240
                         if i = 1 then
241
                            Raise_Exception(Exception_1'Identity, Messages(i));
242
                         elsif i = 2 then
243
                            Raise_Exception(Exception_2'Identity, Messages(i));
244
                         elsif i = 3 then
245
                            Raise_Exception(Exception_3'Identity, Messages(i));
246
                         end if;
247
                         Report.Failed("Exception not raised on loop #" &
248
                                       Integer'Image(i));
249
                      end;
250
                      Report.Failed("Exception not propagated on loop #" &
251
                                    Integer'Image(i));
252
                   exception
253
                      when Exc : others =>
254
 
255
                         -- Save each occurrence into a storage array for
256
                         -- later processing.
257
 
258
                         Save_Occurrence(Exception_Storage(i), Exc);
259
                   end;
260
                end loop;
261
 
262
             end Inner_Block;
263
          end Outer_Block;
264
 
265
          -- Raise the exceptions from the stored occurrences, and handle.
266
 
267
          for i in 1..Exc_Number loop
268
             begin
269
                Reraise_Occurrence(Exception_Storage(i));
270
                Report.Failed("No exception reraised for " &
271
                              "exception #" & Integer'Image(i));
272
             exception
273
                when Exc   : others =>
274
                   -- The following sequence of checks ensures that the
275
                   -- correct occurrence was stored, and the associated
276
                   -- exception was raised and handled in the proper order.
277
                   if i = 1 then
278
                      if Exception_1'Identity /= Exception_Identity(Exc) then
279
                         Report.Failed("Exception_1 not raised");
280
                      end if;
281
                   elsif i = 2 then
282
                      if Exception_2'Identity /= Exception_Identity(Exc) then
283
                         Report.Failed("Exception_2 not raised");
284
                      end if;
285
                   elsif i = 3 then
286
                      if Exception_3'Identity /= Exception_Identity(Exc) then
287
                         Report.Failed("Exception_3 not raised");
288
                      end if;
289
                   end if;
290
 
291
                   if Exception_Message(Exc) /= Messages(i) then
292
                      Report.Failed("Incorrect message associated with " &
293
                                    "exception #" & Integer'Image(i));
294
                   end if;
295
             end;
296
          end loop;
297
       exception
298
          when others =>
299
            Report.Failed("Unexpected exception in Store_And_Handle_Block");
300
       end Store_And_Handle_Block;
301
 
302
 
303
      Reraise_Out_Of_Scope:
304
      declare
305
 
306
         TC_Value      : constant := 5;
307
         The_Exception : exception;
308
         Saved_Exc_Occ : Exception_Occurrence;
309
 
310
         procedure Handle_It (Exc_Occ : in Exception_Occurrence) is
311
            Must_Be_Raised : exception;
312
         begin
313
            if Exception_Identity(Exc_Occ) = The_Exception'Identity then
314
               raise Must_Be_Raised;
315
               Report.Failed("Exception Must_Be_Raised was not raised");
316
            else
317
               Report.Failed("Incorrect exception handled in " &
318
                             "Procedure Handle_It");
319
            end if;
320
         end Handle_It;
321
 
322
      begin
323
 
324
         if Report.Ident_Int(5) = TC_Value then
325
            raise The_Exception;
326
         end if;
327
 
328
      exception
329
         when Exc : others =>
330
            Save_Occurrence (Saved_Exc_Occ, Exc);
331
            begin
332
               Handle_It(Saved_Exc_Occ);   -- Raise another exception, in a
333
            exception                      -- different scope.
334
               when others =>              -- Handle this new exception.
335
                  begin
336
                     Reraise_Occurrence (Saved_Exc_Occ);  -- Reraise the
337
                                                          -- original excptn.
338
                     Report.Failed("Saved Exception was not raised");
339
                  exception
340
                     when Exc_2 : others =>
341
                        if Exception_Identity (Exc_2) /=
342
                           The_Exception'Identity
343
                        then
344
                           Report.Failed
345
                             ("Incorrect exception occurrence reraised");
346
                        end if;
347
                  end;
348
            end;
349
      end Reraise_Out_Of_Scope;
350
 
351
 
352
   exception
353
      when others => Report.Failed ("Exception raised in Test_Block");
354
   end Test_Block;
355
 
356
   Report.Result;
357
 
358
end CB41003;

powered by: WebSVN 2.1.0

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