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/] [ca/] [ca11d02.a] - Blame information for rev 154

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

Line No. Rev Author Line
1 149 jeremybenn
-- CA11D02.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 declared in a package can be raised by a
28
--      child of a child package.  Check that it can be renamed in the
29
--      child of the child package and raised with the correct effect.
30
--
31
-- TEST DESCRIPTION:
32
--      Declare a package which defines complex number abstraction with
33
--      user-defined exceptions (foundation code).
34
--
35
--      Add a public child package to the above package. Declare two
36
--      subprograms for the parent type.
37
--
38
--      Add a public grandchild package to the foundation package.  Declare
39
--      subprograms to raise exceptions.
40
--
41
--      In the main program, "with" the grandchild package, then check that
42
--      the exceptions are raised and handled as expected.  Ensure that
43
--      exceptions are:
44
--         1) raised in the public grandchild package and handled/reraised to
45
--            be handled by the main program.
46
--         2) raised and handled locally by the "others" handler in the
47
--            public grandchild package.
48
--         3) raised in the public grandchild and propagated to the main
49
--            program.
50
--
51
-- TEST FILES:
52
--      This test depends on the following foundation code:
53
--
54
--         FA11D00.A
55
--
56
--
57
-- CHANGE HISTORY:
58
--      06 Dec 94   SAIC    ACVC 2.0
59
--
60
--!
61
 
62
-- Child package of FA11D00.
63
 
64
package FA11D00.CA11D02_0 is     -- Basic_Complex
65
 
66
   function "+" (Left, Right : Complex_Type)
67
     return Complex_Type;                   -- Add two complex numbers.
68
 
69
   function "*" (Left, Right : Complex_Type)
70
     return Complex_Type;                   -- Multiply two complex numbers.
71
 
72
end FA11D00.CA11D02_0;     -- Basic_Complex
73
 
74
--=======================================================================--
75
 
76
package body FA11D00.CA11D02_0 is     -- Basic_Complex
77
 
78
   function "+" (Left, Right : Complex_Type) return Complex_Type is
79
   begin
80
      return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
81
   end "+";
82
   --------------------------------------------------------------
83
   function "*" (Left, Right : Complex_Type) return Complex_Type is
84
   begin
85
      return ( Real => (Left.Real * Right.Real),
86
               Imag => (Left.Imag * Right.Imag) );
87
   end "*";
88
 
89
end FA11D00.CA11D02_0;     -- Basic_Complex
90
 
91
--=======================================================================--
92
 
93
-- Child package of FA11D00.CA11D02_0.
94
-- Grandchild package of FA11D00.
95
 
96
package FA11D00.CA11D02_0.CA11D02_1 is     -- Array_Complex
97
 
98
   Inverse_Error : exception renames Divide_Error;   -- Reference to exception
99
                                                     -- in grandparent package.
100
   Array_Size    : constant := 2;
101
 
102
   type Complex_Array_Type is
103
      array (1 .. Array_Size) of Complex_Type;       -- Reference to type
104
                                                     -- in parent package.
105
 
106
   function Multiply (Left  : Complex_Array_Type;    -- Multiply two complex
107
                      Right : Complex_Array_Type)    -- arrays.
108
     return Complex_Array_Type;
109
 
110
   function Add (Left, Right : Complex_Array_Type)   -- Add two complex
111
     return Complex_Array_Type;                      -- arrays.
112
 
113
   procedure Inverse (Right : in     Complex_Array_Type;  -- Invert a complex
114
                      Left  : in out Complex_Array_Type); -- array.
115
 
116
end FA11D00.CA11D02_0.CA11D02_1;     -- Array_Complex
117
 
118
--=======================================================================--
119
 
120
with Report;
121
 
122
 
123
package body FA11D00.CA11D02_0.CA11D02_1 is     -- Array_Complex
124
 
125
   function Multiply (Left  : Complex_Array_Type;
126
                      Right : Complex_Array_Type)
127
     return Complex_Array_Type is
128
 
129
   -- This procedure will raise an exception depending on the input
130
   -- parameter.  The exception will be handled locally by the
131
   -- "others" handler.
132
 
133
      Result : Complex_Array_Type := (others => Zero);
134
 
135
      subtype Vector_Size is Positive range Left'Range;
136
 
137
   begin
138
      if Left = Result or else Right = Result then -- Do not multiply zero.
139
         raise Multiply_Error;                     -- Refence to exception in
140
                                                   -- grandparent package.
141
         Report.Failed ("Program control not transferred by raise");
142
      else
143
         for I in Vector_Size loop
144
           Result(I) := ( Left(I) * Right(I) );    -- Basic_Complex."*".
145
         end loop;
146
      end if;
147
      return (Result);
148
 
149
   exception
150
      when others =>
151
         Report.Comment ("Exception is handled by others in Multiplication");
152
         TC_Handled_In_Grandchild_Pkg_Func := true;
153
         return (Zero, Zero);
154
 
155
   end Multiply;
156
   --------------------------------------------------------------
157
   function Add (Left, Right : Complex_Array_Type)
158
     return Complex_Array_Type is
159
 
160
   -- This function will raise an exception depending on the input
161
   -- parameter.  The exception will be propagated and handled
162
   -- by the caller.
163
 
164
      Result : Complex_Array_Type := (others => Zero);
165
 
166
      subtype Vector_Size is Positive range Left'Range;
167
 
168
   begin
169
      if Left = Result or Right = Result then     -- Do not add zero.
170
         raise Add_Error;                         -- Refence to exception in
171
                                                  -- grandparent package.
172
         Report.Failed ("Program control not transferred by raise");
173
      else
174
         for I in Vector_Size loop
175
           Result(I) := ( Left(I) + Right(I) );   -- Basic_Complex."+".
176
         end loop;
177
      end if;
178
      return (Result);
179
 
180
   end Add;
181
   --------------------------------------------------------------
182
   procedure Inverse (Right : in     Complex_Array_Type;
183
                      Left  : in out Complex_Array_Type) is
184
 
185
   -- This function will raise an exception depending on the input
186
   -- parameter.  The exception will be handled/reraised to be
187
   -- handled by the caller.
188
 
189
      Result : Complex_Array_Type := (others => Zero);
190
 
191
      Array_With_Zero : boolean := false;
192
 
193
   begin
194
      for I in 1 .. Right'Length loop
195
        if Right(I) = Zero then      -- Check for zero.
196
          Array_With_Zero := true;
197
        end if;
198
      end loop;
199
 
200
      If Array_With_Zero then
201
         raise Inverse_Error;      -- Do not inverse zero.
202
         Report.Failed ("Program control not transferred by raise");
203
      else
204
         for I in 1 .. Array_Size loop
205
           Left(I).Real := - Right(I).Real;
206
           Left(I).Imag := - Right(I).Imag;
207
        end loop;
208
      end if;
209
 
210
   exception
211
      when Inverse_Error  =>
212
         TC_Handled_In_Grandchild_Pkg_Proc := true;
213
         Left := Result;
214
         raise;     -- Reraise the Inverse_Error exception in the subtest.
215
         Report.Failed ("Exception not reraised in handler");
216
 
217
      when others =>
218
         Report.Failed ("Unexpected exception in procedure Inverse");
219
   end Inverse;
220
 
221
end FA11D00.CA11D02_0.CA11D02_1;     -- Array_Complex
222
 
223
--=======================================================================--
224
 
225
with FA11D00.CA11D02_0.CA11D02_1;    -- Array_Complex,
226
                                     -- implicitly with Basic_Complex.
227
with Report;
228
 
229
procedure CA11D02 is
230
 
231
   package Complex_Pkg renames FA11D00;
232
   package Array_Complex_Pkg renames FA11D00.CA11D02_0.CA11D02_1;
233
 
234
   use Complex_Pkg;
235
   use Array_Complex_Pkg;
236
 
237
begin
238
 
239
   Report.Test ("CA11D02", "Check that an exception declared in a package " &
240
                "can be raised by a child of a child package");
241
 
242
   Multiply_Complex_Subtest:
243
   declare
244
      Operand_1  : Complex_Array_Type
245
                 := ( Complex (Int_Type (Report.Ident_Int (3)),
246
                      Int_Type (Report.Ident_Int (5))),
247
                      Complex (Int_Type (Report.Ident_Int (2)),
248
                      Int_Type (Report.Ident_Int (8))) );
249
      Operand_2  : Complex_Array_Type
250
                 := ( Complex (Int_Type (Report.Ident_Int (1)),
251
                      Int_Type (Report.Ident_Int (2))),
252
                      Complex (Int_Type (Report.Ident_Int (3)),
253
                      Int_Type (Report.Ident_Int (6))) );
254
      Operand_3  : Complex_Array_Type := ( Zero, Zero);
255
      Mul_Result : Complex_Array_Type
256
                 := ( Complex (Int_Type (Report.Ident_Int (3)),
257
                      Int_Type (Report.Ident_Int (10))),
258
                      Complex (Int_Type (Report.Ident_Int (6)),
259
                      Int_Type (Report.Ident_Int (48))) );
260
      Complex_No : Complex_Array_Type := (others => Zero);
261
 
262
   begin
263
      If (Multiply (Operand_1, Operand_2) /= Mul_Result) then
264
         Report.Failed ("Incorrect results from multiplication");
265
      end if;
266
 
267
      -- Error is raised and exception will be handled in grandchild package.
268
 
269
      Complex_No := Multiply (Operand_1, Operand_3);
270
 
271
      if Complex_No /= (Zero, Zero) then
272
         Report.Failed ("Exception was not raised in multiplication");
273
      end if;
274
 
275
   exception
276
      when Multiply_Error     =>
277
         Report.Failed ("Exception raised in multiplication and " &
278
                        "propagated to caller");
279
         TC_Handled_In_Grandchild_Pkg_Func := false;
280
              -- Improper exception handling in caller.
281
 
282
      when others =>
283
         Report.Failed ("Unexpected exception in multiplication");
284
         TC_Handled_In_Grandchild_Pkg_Func := false;
285
              -- Improper exception handling in caller.
286
 
287
   end Multiply_Complex_Subtest;
288
 
289
 
290
   Add_Complex_Subtest:
291
   declare
292
      Operand_1  : Complex_Array_Type
293
                 := ( Complex (Int_Type (Report.Ident_Int (2)),
294
                      Int_Type (Report.Ident_Int (7))),
295
                      Complex (Int_Type (Report.Ident_Int (5)),
296
                      Int_Type (Report.Ident_Int (8))) );
297
      Operand_2  : Complex_Array_Type
298
                 := ( Complex (Int_Type (Report.Ident_Int (4)),
299
                      Int_Type (Report.Ident_Int (1))),
300
                      Complex (Int_Type (Report.Ident_Int (2)),
301
                      Int_Type (Report.Ident_Int (3))) );
302
      Operand_3  : Complex_Array_Type := ( Zero, Zero);
303
      Add_Result : Complex_Array_Type
304
                 := ( Complex (Int_Type (Report.Ident_Int (6)),
305
                      Int_Type (Report.Ident_Int (8))),
306
                      Complex (Int_Type (Report.Ident_Int (7)),
307
                      Int_Type (Report.Ident_Int (11))) );
308
      Complex_No : Complex_Array_Type := (others => Zero);
309
 
310
   begin
311
      Complex_No := Add (Operand_1, Operand_2);
312
 
313
      If (Complex_No /= Add_Result) then
314
         Report.Failed ("Incorrect results from addition");
315
      end if;
316
 
317
      -- Error is raised in grandchild package and exception
318
      -- will be propagated to caller.
319
 
320
      Complex_No := Add (Operand_1, Operand_3);
321
 
322
      if Complex_No = Add_Result then
323
         Report.Failed ("Exception was not raised in addition");
324
      end if;
325
 
326
   exception
327
      when Add_Error =>
328
         TC_Propagated_To_Caller := true;  -- Exception is propagated.
329
 
330
      when others =>
331
         Report.Failed ("Unexpected exception in addition subtest");
332
         TC_Propagated_To_Caller := false;  -- Improper exception handling
333
                                            -- in caller.
334
   end Add_Complex_Subtest;
335
 
336
   Inverse_Complex_Subtest:
337
   declare
338
      Operand_1  : Complex_Array_Type
339
                 := ( Complex (Int_Type (Report.Ident_Int (1)),
340
                      Int_Type (Report.Ident_Int (5))),
341
                      Complex (Int_Type (Report.Ident_Int (3)),
342
                      Int_Type (Report.Ident_Int (11))) );
343
      Operand_3  : Complex_Array_Type
344
                 := ( Zero, Complex (Int_Type (Report.Ident_Int (3)),
345
                      Int_Type (Report.Ident_Int (6))) );
346
      Inv_Result : Complex_Array_Type
347
                 := ( Complex (Int_Type (Report.Ident_Int (-1)),
348
                      Int_Type (Report.Ident_Int (-5))),
349
                      Complex (Int_Type (Report.Ident_Int (-3)),
350
                      Int_Type (Report.Ident_Int (-11))) );
351
      Complex_No : Complex_Array_Type := (others => Zero);
352
 
353
   begin
354
      Inverse (Operand_1, Complex_No);
355
 
356
      if (Complex_No /= Inv_Result) then
357
         Report.Failed ("Incorrect results from inverse");
358
      end if;
359
 
360
      -- Error is raised in grandchild package and exception
361
      -- will be handled/reraised to caller.
362
 
363
      Inverse (Operand_3, Complex_No);
364
 
365
      Report.Failed ("Exception was not handled in inverse");
366
 
367
   exception
368
      when Inverse_Error =>
369
         if not TC_Handled_In_Grandchild_Pkg_Proc then
370
            Report.Failed ("Exception was not raised in inverse");
371
         else
372
            TC_Handled_In_Caller := true;  -- Exception is reraised from
373
                                           -- child package.
374
         end if;
375
 
376
      when others =>
377
         Report.Failed ("Unexpected exception in inverse");
378
         TC_Handled_In_Caller := false;
379
                -- Improper exception handling in caller.
380
 
381
   end Inverse_Complex_Subtest;
382
 
383
   if not (TC_Handled_In_Caller               and   -- Check to see that all
384
           TC_Handled_In_Grandchild_Pkg_Proc  and   -- exceptions were handled
385
           TC_Handled_In_Grandchild_Pkg_Func  and   -- in proper location.
386
           TC_Propagated_To_Caller)
387
   then
388
      Report.Failed ("Exceptions handled in incorrect locations");
389
   end if;
390
 
391
   Report.Result;
392
 
393
end CA11D02;

powered by: WebSVN 2.1.0

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