1-- CA11001.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 unit can be used to provide an alternate view and 28-- operations on a private type in its parent package. Check that a 29-- child unit can be a package. Check that a WITH of a child unit 30-- includes an implicit WITH of its ancestor unit. 31-- 32-- TEST DESCRIPTION: 33-- Declare a private type in a package specification. Declare 34-- subprograms for the type. 35-- 36-- Add a public child to the above package. Within the body of this 37-- package, access the private type. Declare operations to read and 38-- write to its parent private type. 39-- 40-- In the main program, "with" the child. Declare objects of the 41-- parent private type. Access the subprograms from both parent and 42-- child packages. 43-- 44-- 45-- CHANGE HISTORY: 46-- 06 Dec 94 SAIC ACVC 2.0 47-- 48--! 49 50package CA11001_0 is -- Cartesian_Complex 51-- This package represents a Cartesian view of a complex number. It contains 52-- a private type plus subprograms to construct and decompose a complex 53-- number. 54 55 type Complex_Int is range 0 .. 100; 56 57 type Complex_Type is private; 58 59 Constant_Complex : constant Complex_Type; 60 61 Complex_Error : exception; 62 63 procedure Cartesian_Assign (R, I : in Complex_Int; 64 C : out Complex_Type); 65 66 function Cartesian_Real_Part (C : Complex_Type) 67 return Complex_Int; 68 69 function Cartesian_Imag_Part (C : Complex_Type) 70 return Complex_Int; 71 72 function Complex (Real, Imaginary : Complex_Int) 73 return Complex_Type; 74 75private 76 type Complex_Type is -- Parent private type 77 record 78 Real, Imaginary : Complex_Int; 79 end record; 80 81 Constant_Complex : constant Complex_Type := (Real => 0, Imaginary => 0); 82 83end CA11001_0; -- Cartesian_Complex 84 85--=======================================================================-- 86 87package body CA11001_0 is -- Cartesian_Complex 88 89 procedure Cartesian_Assign (R, I : in Complex_Int; 90 C : out Complex_Type) is 91 begin 92 C.Real := R; 93 C.Imaginary := I; 94 end Cartesian_Assign; 95 ------------------------------------------------------------- 96 function Cartesian_Real_Part (C : Complex_Type) 97 return Complex_Int is 98 begin 99 return C.Real; 100 end Cartesian_Real_Part; 101 ------------------------------------------------------------- 102 function Cartesian_Imag_Part (C : Complex_Type) 103 return Complex_Int is 104 begin 105 return C.Imaginary; 106 end Cartesian_Imag_Part; 107 ------------------------------------------------------------- 108 function Complex (Real, Imaginary : Complex_Int) 109 return Complex_Type is 110 begin 111 return (Real, Imaginary); 112 end Complex; 113 114end CA11001_0; -- Cartesian_Complex 115 116--=======================================================================-- 117 118package CA11001_0.CA11001_1 is -- Polar_Complex 119-- This public child provides a different view of the private type from its 120-- parent. It provides a polar view by the provision of subprograms which 121-- construct and decompose a complex number. 122 123 procedure Polar_Assign (R, Theta : in Complex_Int; 124 C : out Complex_Type); 125 -- Complex_Type is a 126 -- record of CA11001_0 127 128 function Polar_Real_Part (C: Complex_Type) return Complex_Int; 129 130 function Polar_Imag_Part (C: Complex_Type) return Complex_Int; 131 132 function Equals_Const (Num : Complex_Type) return Boolean; 133 134end CA11001_0.CA11001_1; -- Polar_Complex 135 136--=======================================================================-- 137 138package body CA11001_0.CA11001_1 is -- Polar_Complex 139 140 function Cos (Angle : Complex_Int) return Complex_Int is 141 Num : constant Complex_Int := 2; 142 begin 143 return (Angle * Num); -- not true Cosine function 144 end Cos; 145 ------------------------------------------------------------- 146 function Sine (Angle : Complex_Int) return Complex_Int is 147 begin 148 return 1; -- not true Sine function 149 end Sine; 150 ------------------------------------------------------------- 151 function Sqrt (Num : Complex_Int) 152 return Complex_Int is 153 begin 154 return (Num); -- not true Square root function 155 end Sqrt; 156 ------------------------------------------------------------- 157 function Tan (Angle : Complex_Int) return Complex_Int is 158 begin 159 return Angle; -- not true Tangent function 160 end Tan; 161 ------------------------------------------------------------- 162 procedure Polar_Assign (R, Theta : in Complex_Int; 163 C : out Complex_Type) is 164 begin 165 if R = 0 and Theta = 0 then 166 raise Complex_Error; 167 end if; 168 C.Real := R * Cos (Theta); 169 C.Imaginary := R * Sine (Theta); 170 end Polar_Assign; 171 ------------------------------------------------------------- 172 function Polar_Real_Part (C: Complex_Type) return Complex_Int is 173 begin 174 return Sqrt ((Cartesian_Imag_Part (C)) ** 2 + 175 (Cartesian_Real_Part (C)) ** 2); 176 end Polar_Real_Part; 177 ------------------------------------------------------------- 178 function Polar_Imag_Part (C: Complex_Type) return Complex_Int is 179 begin 180 return (Tan (Cartesian_Imag_Part (C) / 181 Cartesian_Real_Part (C))); 182 end Polar_Imag_Part; 183 ------------------------------------------------------------- 184 function Equals_Const (Num : Complex_Type) return Boolean is 185 begin 186 return Num.Real = Constant_Complex.Real and 187 Num.Imaginary = Constant_Complex.Imaginary; 188 end Equals_Const; 189 190end CA11001_0.CA11001_1; -- Polar_Complex 191 192--=======================================================================-- 193 194with CA11001_0.CA11001_1; -- Polar_Complex 195with Report; 196 197procedure CA11001 is 198 199 Complex_No : CA11001_0.Complex_Type; -- Complex_Type is a 200 -- record of CA11001_0 201 202 Complex_5x2 : CA11001_0.Complex_Type := CA11001_0.Complex (5, 2); 203 204 Int_2 : CA11001_0.Complex_Int 205 := CA11001_0.Complex_Int (Report.Ident_Int (2)); 206 207begin 208 209 Report.Test ("CA11001", "Check that a child unit can be used " & 210 "to provide an alternate view and operations " & 211 "on a private type in its parent package"); 212 213 Basic_View_Subtest: 214 215 begin 216 -- Assign using Cartesian coordinates. 217 CA11001_0.Cartesian_Assign 218 (CA11001_0.Complex_Int (Report.Ident_Int (1)), Int_2, Complex_No); 219 220 -- Read back in Polar coordinates. 221 -- Polar values are surrogates used in checking for correct 222 -- subprogram calls. 223 if CA11001_0."/=" (CA11001_0.CA11001_1.Polar_Real_Part (Complex_No), 224 CA11001_0.Cartesian_Real_Part (Complex_5x2)) and CA11001_0."/=" 225 (CA11001_0.CA11001_1.Polar_Imag_Part (Complex_No), 226 CA11001_0.Cartesian_Imag_Part (Complex_5x2)) then 227 Report.Failed ("Incorrect Cartesian result"); 228 end if; 229 230 end Basic_View_Subtest; 231 ------------------------------------------------------------- 232 Alternate_View_Subtest: 233 begin 234 -- Assign using Polar coordinates. 235 CA11001_0.CA11001_1.Polar_Assign 236 (Int_2, CA11001_0.Complex_Int (Report.Ident_Int (3)), Complex_No); 237 238 -- Read back in Cartesian coordinates. 239 if CA11001_0."/=" (CA11001_0.Cartesian_Real_Part 240 (Complex_No), CA11001_0.Complex_Int (Report.Ident_Int (12))) or 241 CA11001_0."/=" (CA11001_0.Cartesian_Imag_Part (Complex_No), Int_2) 242 then 243 Report.Failed ("Incorrect Polar result"); 244 end if; 245 end Alternate_View_Subtest; 246 ------------------------------------------------------------- 247 Other_Subtest: 248 begin 249 -- Assign using Polar coordinates. 250 CA11001_0.CA11001_1.Polar_Assign 251 (CA11001_0.Complex_Int (Report.Ident_Int (0)), Int_2, Complex_No); 252 253 -- Compare with Complex_Num in CA11001_0. 254 if not CA11001_0.CA11001_1.Equals_Const (Complex_No) 255 then 256 Report.Failed ("Incorrect result"); 257 end if; 258 end Other_Subtest; 259 ------------------------------------------------------------- 260 Exception_Subtest: 261 begin 262 -- Raised parent's exception. 263 CA11001_0.CA11001_1.Polar_Assign 264 (CA11001_0.Complex_Int (Report.Ident_Int (0)), 265 CA11001_0.Complex_Int (Report.Ident_Int (0)), Complex_No); 266 Report.Failed ("Exception was not raised"); 267 exception 268 when CA11001_0.Complex_Error => 269 null; 270 when others => 271 Report.Failed ("Unexpected exception raised in test"); 272 end Exception_Subtest; 273 274 Report.Result; 275 276end CA11001; 277