1-- CC70A01.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 the visible part of a generic formal package includes the
28--      first list of basic declarative items of the package specification.
29--      Check for a generic package which declares a formal package with (<>)
30--      as its actual part.
31--
32-- TEST DESCRIPTION:
33--      The "first list of basic declarative items" of a package specification
34--      is the visible part of the package. Thus, the declarations in the
35--      visible part of the actual instance corresponding to a formal
36--      package are available in the generic which declares the formal package.
37--
38--      Declare a generic package which simulates a complex integer abstraction
39--      (foundation code).
40--
41--      Declare a second, library-level generic package which utilizes the
42--      first generic package as a generic formal package (with a (<>)
43--      actual_part). In the second generic package, declare objects, types,
44--      and operations in terms of the objects, types, and operations declared
45--      in the first generic package.
46--
47--      In the main program, instantiate the first generic package, then
48--      instantiate the second generic package and pass the first instance
49--      to it as a generic actual parameter. Check that the operations in
50--      the second instance perform as expected.
51--
52--
53-- CHANGE HISTORY:
54--      06 Dec 94   SAIC    ACVC 2.0
55--
56--!
57
58with FC70A00;         -- Generic complex integer operations.
59
60generic               -- Generic complex matrix operations.
61   with package Complex_Package is new FC70A00 (<>);
62package CC70A01_0 is
63
64   type Complex_Matrix_Type is                        -- 1st index is matrix
65      array (Positive range <>, Positive range <>)    -- row, 2nd is column.
66        of Complex_Package.Complex_Type;
67   Dimension_Mismatch : exception;
68
69
70   function Identity_Matrix (Size : Positive)         -- Create identity matrix
71     return Complex_Matrix_Type;                      -- of specified size.
72
73   function "*" (Left  : Complex_Matrix_Type;         -- Multiply two complex
74                 Right : Complex_Matrix_Type)         -- matrices.
75     return Complex_Matrix_Type;
76
77end CC70A01_0;
78
79
80     --==================================================================--
81
82
83package body CC70A01_0 is  -- Generic complex matrix operations.
84
85   use Complex_Package;
86
87               --==============================================--
88
89   function Inner_Product (Left, Right : Complex_Matrix_Type;
90                           Row, Column : Positive)    -- Compute inner product
91     return Complex_Package.Complex_Type is           -- for matrix-multiply.
92
93      Result : Complex_Type := Zero;
94      subtype Vector_Size is Positive range Left'Range(2);
95
96   begin  -- Inner_Product.
97      for I in Vector_Size loop
98         Result := Result +                           -- Complex_Package."+".
99                   (Left(Row, I) * Right(I, Column)); -- Complex_Package."*".
100      end loop;
101      return (Result);
102   end Inner_Product;
103
104               --==============================================--
105
106   function Identity_Matrix (Size : Positive) return Complex_Matrix_Type is
107      Result : Complex_Matrix_Type (1 .. Size, 1 .. Size) :=
108               (others => (others => Zero));          -- Zeroes everywhere...
109   begin
110      for I in 1 .. Size loop
111         Result (I, I) := One;                        -- Ones on the diagonal.
112      end loop;
113      return (Result);
114   end Identity_Matrix;
115
116               --==============================================--
117
118   function "*" (Left  : Complex_Matrix_Type; Right : Complex_Matrix_Type)
119     return Complex_Matrix_Type is
120
121      subtype Rows    is Positive range Left'Range(1);
122      subtype Columns is Positive range Right'Range(2);
123
124      Result : Complex_Matrix_Type(Rows, Columns);
125   begin
126      if Left'Length(2) /= Right'Length(1) then       -- # columns of Left must
127                                                      -- match # rows of Right.
128         raise Dimension_Mismatch;
129      else
130         for I in Rows loop
131            for J in Columns loop
132                Result(I, J) := Inner_Product (Left, Right, I, J);
133            end loop;
134         end loop;
135         return (Result);
136      end if;
137   end "*";
138
139end CC70A01_0;
140
141
142     --==================================================================--
143
144
145with Report;
146
147with FC70A00;    -- Generic complex integer operations.
148with CC70A01_0;  -- Generic complex matrix operations.
149
150procedure CC70A01 is
151
152   type My_Integer is range -100 .. 100;
153
154   package My_Complex_Package is new FC70A00   (My_Integer);
155   package My_Matrix_Package  is new CC70A01_0 (My_Complex_Package);
156
157   use My_Complex_Package,                                -- All user-defined
158       My_Matrix_Package;                                 -- operators directly
159                                                          -- visible.
160
161   subtype Matrix_2x2 is Complex_Matrix_Type (1 .. 2, 1 .. 2);
162   subtype Matrix_2x3 is Complex_Matrix_Type (1 .. 2, 1 .. 3);
163
164   function C (Real, Imag : My_Integer) return Complex_Type renames Complex;
165
166begin  -- Main program.
167
168   Report.Test ("CC70A01", "Check that the visible part of a generic " &
169                "formal package includes the first list of basic " &
170                "declarative items of the package specification. Check " &
171                "for a generic package where formal package has (<>) " &
172                "actual part");
173
174   declare
175      Identity_2x2 : Matrix_2x2 := Identity_Matrix (Size => 2);
176      Operand_2x3  : Matrix_2x3 := ( ( C(1, 2), C(3, 6), C(5, 1) ),
177                                     ( C(0, 3), C(7, 9), C(3, 4) ) );
178      Result_2x3   : Matrix_2x3 := ( others => ( others => Zero ) );
179   begin
180
181      begin -- Block #1.
182         Result_2x3 := Identity_2x2 * Operand_2x3; -- Should return
183                                                   -- Operand_2x3.
184         if (Result_2x3 /= Operand_2x3) then
185            Report.Failed ("Incorrect results from matrix multiplication");
186         end if;
187      exception
188         when others =>
189            Report.Failed ("Unexpected exception raised - Block #1");
190      end;  -- Block #1.
191
192
193      begin -- Block #2.
194         Result_2x3 := Operand_2x3 * Identity_2x2;  -- Can't multiply 2x3
195                                                    -- by 2x2.
196         Report.Failed ("Exception Dimension_Mismatch not raised");
197      exception
198         when Dimension_Mismatch =>
199            null;
200         when others             =>
201            Report.Failed ("Unexpected exception raised - Block #2");
202      end;  -- Block #2.
203
204   end;
205
206   Report.Result;
207
208end CC70A01;
209