1-- 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
64package 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
72end FA11D00.CA11D02_0;     -- Basic_Complex
73
74--=======================================================================--
75
76package 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
89end FA11D00.CA11D02_0;     -- Basic_Complex
90
91--=======================================================================--
92
93-- Child package of FA11D00.CA11D02_0.
94-- Grandchild package of FA11D00.
95
96package 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
116end FA11D00.CA11D02_0.CA11D02_1;     -- Array_Complex
117
118--=======================================================================--
119
120with Report;
121
122
123package 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
221end FA11D00.CA11D02_0.CA11D02_1;     -- Array_Complex
222
223--=======================================================================--
224
225with FA11D00.CA11D02_0.CA11D02_1;    -- Array_Complex,
226                                     -- implicitly with Basic_Complex.
227with Report;
228
229procedure 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
237begin
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
393end CA11D02;
394