1-- CA11012.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 a child package of a library level instantiation 28-- of a generic can be the instantiation of a child package of 29-- the generic. Check that the child instance can use its parent's 30-- declarations and operations, including a formal type of the parent. 31-- 32-- TEST DESCRIPTION: 33-- Declare a generic package which simulates an integer complex 34-- abstraction. Declare a generic child package of this package 35-- which defines additional complex operations. 36-- 37-- Instantiate the first generic package, then instantiate the child 38-- generic package as a child unit of the first instance. In the main 39-- program, check that the operations in both instances perform as 40-- expected. 41-- 42-- 43-- CHANGE HISTORY: 44-- 06 Dec 94 SAIC ACVC 2.0 45-- 21 Dec 94 SAIC Corrected visibility errors for literals 46-- 27 Feb 97 PWB.CTA Added elaboration pragma at package CA11012_3 47--! 48 49generic -- Complex number abstraction. 50 type Int_Type is range <>; 51 52package CA11012_0 is 53 54 -- Simulate a generic complex number support package. Complex numbers 55 -- are treated as coordinates in the Cartesian plane. 56 57 type Complex_Type is private; 58 59 Zero : constant Complex_Type; -- Real number (0,0). 60 61 function Complex (Real, Imag : Int_Type) -- Create a complex 62 return Complex_Type; -- number. 63 64 function "-" (Right : Complex_Type) -- Invert a complex 65 return Complex_Type; -- number. 66 67 function "+" (Left, Right : Complex_Type) -- Add two complex 68 return Complex_Type; -- numbers. 69 70private 71 type Complex_Type is record 72 Real : Int_Type; 73 Imag : Int_Type; 74 end record; 75 76 Zero : constant Complex_Type := (Real => 0, Imag => 0); 77 78end CA11012_0; 79 80 --==================================================================-- 81 82package body CA11012_0 is 83 84 function Complex (Real, Imag : Int_Type) return Complex_Type is 85 begin 86 return (Real, Imag); 87 end Complex; 88 --------------------------------------------------------------- 89 function "-" (Right : Complex_Type) return Complex_Type is 90 begin 91 return (-Right.Real, -Right.Imag); 92 end "-"; 93 --------------------------------------------------------------- 94 function "+" (Left, Right : Complex_Type) return Complex_Type is 95 begin 96 return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) ); 97 end "+"; 98 99end CA11012_0; 100 101 --==================================================================-- 102 103-- Generic child of complex number package. Child must be generic since 104-- parent is generic. 105 106generic -- Complex additional operations 107 108package CA11012_0.CA11012_1 is 109 110 -- More operations on complex number. This child adds a layer of 111 -- functionality to the parent generic. 112 113 function Real_Part (Complex_No : Complex_Type) 114 return Int_Type; 115 116 function Imag_Part (Complex_No : Complex_Type) 117 return Int_Type; 118 119 function "*" (Factor : Int_Type; 120 C : Complex_Type) return Complex_Type; 121 122 function Vector_Magnitude (Complex_No : Complex_Type) 123 return Int_Type; 124 125end CA11012_0.CA11012_1; 126 127 --==================================================================-- 128 129package body CA11012_0.CA11012_1 is 130 131 function Real_Part (Complex_No : Complex_Type) return Int_Type is 132 begin 133 return (Complex_No.Real); 134 end Real_Part; 135 --------------------------------------------------------------- 136 function Imag_Part (Complex_No : Complex_Type) return Int_Type is 137 begin 138 return (Complex_No.Imag); 139 end Imag_Part; 140 --------------------------------------------------------------- 141 function "*" (Factor : Int_Type; 142 C : Complex_Type) return Complex_Type is 143 Result : Complex_Type := Zero; -- Zero is declared in parent, 144 -- Complex_Number 145 begin 146 for I in 1 .. abs (Factor) loop 147 Result := Result + C; -- Complex_Number "+" 148 end loop; 149 150 if Factor < 0 then 151 Result := - Result; -- Complex_Number "-" 152 end if; 153 154 return Result; 155 end "*"; 156 --------------------------------------------------------------- 157 function Vector_Magnitude (Complex_No : Complex_Type) 158 return Int_Type is -- Not a real vector magnitude. 159 begin 160 return (Complex_No.Real + Complex_No.Imag); 161 end Vector_Magnitude; 162 163end CA11012_0.CA11012_1; 164 165 --==================================================================-- 166 167package CA11012_2 is 168 169 subtype My_Integer is integer range -100 .. 100; 170 171 -- ... Various other types used by the application. 172 173end CA11012_2; 174 175-- No body for CA11012_2; 176 177 --==================================================================-- 178 179-- Declare instances of the generic complex packages for integer type. 180-- The instance of the child must itself be declared as a child of the 181-- instance of the parent. 182 183with CA11012_0; -- Complex number abstraction 184with CA11012_2; -- Package containing integer type 185pragma Elaborate (CA11012_0); 186package CA11012_3 is new CA11012_0 (Int_Type => CA11012_2.My_Integer); 187 188with CA11012_0.CA11012_1; -- Complex additional operations 189with CA11012_3; 190package CA11012_3.CA11012_4 is new CA11012_3.CA11012_1; 191 192 --==================================================================-- 193 194with CA11012_2; -- Package containing integer type 195with CA11012_3.CA11012_4; -- Complex abstraction + additional operations 196with Report; 197 198procedure CA11012 is 199 200 package My_Complex_Pkg renames CA11012_3; 201 202 package My_Complex_Operation renames CA11012_3.CA11012_4; 203 204 use My_Complex_Pkg, -- All user-defined 205 My_Complex_Operation; -- operators directly 206 -- visible. 207 Complex_One, Complex_Two : Complex_Type; 208 209begin 210 211 Report.Test ("CA11012", "Check that child instance can use its parent's " & 212 "declarations and operations, including a formal " & 213 "type of the parent"); 214 215 Correct_Range_Test: 216 declare 217 My_Literal : CA11012_2.My_Integer := -3; 218 219 begin 220 Complex_One := Complex (-4, 7); -- Operation from the generic 221 -- parent package. 222 223 Complex_Two := My_Literal * Complex_One; -- Operation from the generic 224 -- child package. 225 226 if Real_Part (Complex_Two) /= 12 -- Operation from the generic 227 or Imag_Part (Complex_Two) /= -21 -- child package. 228 then 229 Report.Failed ("Incorrect results from complex operation"); 230 end if; 231 232 end Correct_Range_Test; 233 234 --------------------------------------------------------------- 235 236 Out_Of_Range_Test: 237 declare 238 My_Vector : CA11012_2.My_Integer; 239 240 begin 241 Complex_One := Complex (70, 70); -- Operation from the generic 242 -- parent package. 243 My_Vector := Vector_Magnitude (Complex_One); 244 -- Operation from the generic child package. 245 246 Report.Failed ("Exception not raised in child package"); 247 248 exception 249 when Constraint_Error => 250 Report.Comment ("Exception is raised as expected"); 251 252 when others => 253 Report.Failed ("Others exception is raised"); 254 255 end Out_Of_Range_Test; 256 257 Report.Result; 258 259end CA11012; 260