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