1-- CA11D03.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--      client of a child of the package.  Check that it can be renamed in
29--      the client of the child of the package and raised with the correct
30--      effect.
31--
32-- TEST DESCRIPTION:
33--      Declare a package which defines complex number abstraction with
34--      user-defined exceptions (foundation code).
35--
36--      Add a public child package to the above package. Declare two
37--      subprograms for the parent type.
38--
39--      In the main program, "with" the child package, then check that
40--      an exception can be raised and handled as expected.
41--
42-- TEST FILES:
43--      This test depends on the following foundation code:
44--
45--         FA11D00.A
46--
47--
48-- CHANGE HISTORY:
49--      06 Dec 94   SAIC    ACVC 2.0
50--
51--!
52
53-- Child package of FA11D00.
54package FA11D00.CA11D03_0 is     -- Basic_Complex
55
56   function "+" (Left, Right : Complex_Type)
57     return Complex_Type;                   -- Add two complex numbers.
58
59   function "*" (Left, Right : Complex_Type)
60     return Complex_Type;                   -- Multiply two complex numbers.
61
62end FA11D00.CA11D03_0;     -- Basic_Complex
63
64--=======================================================================--
65
66package body FA11D00.CA11D03_0 is     -- Basic_Complex
67
68   function "+" (Left, Right : Complex_Type) return Complex_Type is
69   begin
70      return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
71   end "+";
72   --------------------------------------------------------------
73   function "*" (Left, Right : Complex_Type) return Complex_Type is
74   begin
75      return ( Real => (Left.Real * Right.Real),
76               Imag => (Left.Imag * Right.Imag) );
77   end "*";
78
79end FA11D00.CA11D03_0;     -- Basic_Complex
80
81--=======================================================================--
82
83with FA11D00.CA11D03_0;    -- Basic_Complex,
84                           -- implicitly with Complex_Definition.
85with Report;
86
87procedure CA11D03 is
88
89   package Complex_Pkg renames FA11D00;     -- Complex_Definition_Pkg
90   package Basic_Complex_Pkg renames FA11D00.CA11D03_0;   -- Basic_Complex
91
92   use Complex_Pkg;
93   use Basic_Complex_Pkg;
94
95   TC_Handled_In_Subtest_1,
96   TC_Handled_In_Subtest_2 : boolean := false;
97
98begin
99
100   Report.Test ("CA11D03", "Check that an exception declared in a package " &
101                "can be raised by a client of a child of the package");
102
103   Multiply_Complex_Subtest:
104   declare
105      Operand_1  : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)),
106                                   Int_Type (Report.Ident_Int (2)));
107                                   -- Referenced to function in parent package.
108      Operand_2  : Complex_Type := Complex (Int_Type (Report.Ident_Int (10)),
109                                   Int_Type (Report.Ident_Int (8)));
110      Mul_Res    : Complex_type := Complex (Int_Type (Report.Ident_Int (30)),
111                                   Int_Type (Report.Ident_Int (16)));
112      Complex_No : Complex_Type := Zero;  -- Zero is declared in parent package.
113   begin
114      Complex_No := Operand_1 * Operand_2;   -- Basic_Complex."*".
115      if Complex_No /= Mul_Res then
116         Report.Failed ("Incorrect results from multiplication");
117      end if;
118
119      -- Error is raised and exception will be handled.
120      if Complex_No = Mul_Res then
121         raise Multiply_Error;             -- Reference to exception in
122      end if;                              -- parent package.
123
124   exception
125      when Multiply_Error =>
126         TC_Handled_In_Subtest_1 := true;
127      when others =>
128         TC_Handled_In_Subtest_1 := false;  -- Improper exception handling.
129
130   end Multiply_Complex_Subtest;
131
132   Add_Complex_Subtest:
133   declare
134      Error_In_Client : exception renames Add_Error;
135                        -- Reference to exception in parent package.
136      Operand_1  : Complex_Type := Complex (Int_Type (Report.Ident_Int (2)),
137                                   Int_Type (Report.Ident_Int (7)));
138      Operand_2  : Complex_Type := Complex (Int_Type (Report.Ident_Int (-4)),
139                                   Int_Type (Report.Ident_Int (1)));
140      Add_Res    : Complex_type := Complex (Int_Type (Report.Ident_Int (-2)),
141                                   Int_Type (Report.Ident_Int (8)));
142      Complex_No : Complex_Type := One;   -- One is declared in parent
143                                          -- package.
144   begin
145      Complex_No := Operand_1 + Operand_2;   -- Basic_Complex."+".
146
147      if Complex_No /= Add_Res then
148         Report.Failed ("Incorrect results from multiplication");
149      end if;
150
151      -- Error is raised and exception will be handled.
152      if Complex_No = Add_Res then
153         raise Error_In_Client;
154      end if;
155
156   exception
157      when Error_In_Client =>
158         TC_Handled_In_Subtest_2 := true;
159
160      when others =>
161         TC_Handled_In_Subtest_2 := false;  -- Improper exception handling.
162
163   end Add_Complex_Subtest;
164
165   if not (TC_Handled_In_Subtest_1           and   -- Check to see that all
166           TC_Handled_In_Subtest_2)                -- exceptions were handled
167                                                   -- in the proper location.
168   then
169      Report.Failed ("Exceptions handled in incorrect locations");
170   end if;
171
172   Report.Result;
173
174end CA11D03;
175