1-- CA11D02.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-- child of a child package. Check that it can be renamed in the 29-- child of the child package and raised with the correct effect. 30-- 31-- TEST DESCRIPTION: 32-- Declare a package which defines complex number abstraction with 33-- user-defined exceptions (foundation code). 34-- 35-- Add a public child package to the above package. Declare two 36-- subprograms for the parent type. 37-- 38-- Add a public grandchild package to the foundation package. Declare 39-- subprograms to raise exceptions. 40-- 41-- In the main program, "with" the grandchild package, then check that 42-- the exceptions are raised and handled as expected. Ensure that 43-- exceptions are: 44-- 1) raised in the public grandchild package and handled/reraised to 45-- be handled by the main program. 46-- 2) raised and handled locally by the "others" handler in the 47-- public grandchild package. 48-- 3) raised in the public grandchild and propagated to the main 49-- program. 50-- 51-- TEST FILES: 52-- This test depends on the following foundation code: 53-- 54-- FA11D00.A 55-- 56-- 57-- CHANGE HISTORY: 58-- 06 Dec 94 SAIC ACVC 2.0 59-- 60--! 61 62-- Child package of FA11D00. 63 64package FA11D00.CA11D02_0 is -- Basic_Complex 65 66 function "+" (Left, Right : Complex_Type) 67 return Complex_Type; -- Add two complex numbers. 68 69 function "*" (Left, Right : Complex_Type) 70 return Complex_Type; -- Multiply two complex numbers. 71 72end FA11D00.CA11D02_0; -- Basic_Complex 73 74--=======================================================================-- 75 76package body FA11D00.CA11D02_0 is -- Basic_Complex 77 78 function "+" (Left, Right : Complex_Type) return Complex_Type is 79 begin 80 return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) ); 81 end "+"; 82 -------------------------------------------------------------- 83 function "*" (Left, Right : Complex_Type) return Complex_Type is 84 begin 85 return ( Real => (Left.Real * Right.Real), 86 Imag => (Left.Imag * Right.Imag) ); 87 end "*"; 88 89end FA11D00.CA11D02_0; -- Basic_Complex 90 91--=======================================================================-- 92 93-- Child package of FA11D00.CA11D02_0. 94-- Grandchild package of FA11D00. 95 96package FA11D00.CA11D02_0.CA11D02_1 is -- Array_Complex 97 98 Inverse_Error : exception renames Divide_Error; -- Reference to exception 99 -- in grandparent package. 100 Array_Size : constant := 2; 101 102 type Complex_Array_Type is 103 array (1 .. Array_Size) of Complex_Type; -- Reference to type 104 -- in parent package. 105 106 function Multiply (Left : Complex_Array_Type; -- Multiply two complex 107 Right : Complex_Array_Type) -- arrays. 108 return Complex_Array_Type; 109 110 function Add (Left, Right : Complex_Array_Type) -- Add two complex 111 return Complex_Array_Type; -- arrays. 112 113 procedure Inverse (Right : in Complex_Array_Type; -- Invert a complex 114 Left : in out Complex_Array_Type); -- array. 115 116end FA11D00.CA11D02_0.CA11D02_1; -- Array_Complex 117 118--=======================================================================-- 119 120with Report; 121 122 123package body FA11D00.CA11D02_0.CA11D02_1 is -- Array_Complex 124 125 function Multiply (Left : Complex_Array_Type; 126 Right : Complex_Array_Type) 127 return Complex_Array_Type is 128 129 -- This procedure will raise an exception depending on the input 130 -- parameter. The exception will be handled locally by the 131 -- "others" handler. 132 133 Result : Complex_Array_Type := (others => Zero); 134 135 subtype Vector_Size is Positive range Left'Range; 136 137 begin 138 if Left = Result or else Right = Result then -- Do not multiply zero. 139 raise Multiply_Error; -- Refence to exception in 140 -- grandparent package. 141 Report.Failed ("Program control not transferred by raise"); 142 else 143 for I in Vector_Size loop 144 Result(I) := ( Left(I) * Right(I) ); -- Basic_Complex."*". 145 end loop; 146 end if; 147 return (Result); 148 149 exception 150 when others => 151 Report.Comment ("Exception is handled by others in Multiplication"); 152 TC_Handled_In_Grandchild_Pkg_Func := true; 153 return (Zero, Zero); 154 155 end Multiply; 156 -------------------------------------------------------------- 157 function Add (Left, Right : Complex_Array_Type) 158 return Complex_Array_Type is 159 160 -- This function will raise an exception depending on the input 161 -- parameter. The exception will be propagated and handled 162 -- by the caller. 163 164 Result : Complex_Array_Type := (others => Zero); 165 166 subtype Vector_Size is Positive range Left'Range; 167 168 begin 169 if Left = Result or Right = Result then -- Do not add zero. 170 raise Add_Error; -- Refence to exception in 171 -- grandparent package. 172 Report.Failed ("Program control not transferred by raise"); 173 else 174 for I in Vector_Size loop 175 Result(I) := ( Left(I) + Right(I) ); -- Basic_Complex."+". 176 end loop; 177 end if; 178 return (Result); 179 180 end Add; 181 -------------------------------------------------------------- 182 procedure Inverse (Right : in Complex_Array_Type; 183 Left : in out Complex_Array_Type) is 184 185 -- This function will raise an exception depending on the input 186 -- parameter. The exception will be handled/reraised to be 187 -- handled by the caller. 188 189 Result : Complex_Array_Type := (others => Zero); 190 191 Array_With_Zero : boolean := false; 192 193 begin 194 for I in 1 .. Right'Length loop 195 if Right(I) = Zero then -- Check for zero. 196 Array_With_Zero := true; 197 end if; 198 end loop; 199 200 If Array_With_Zero then 201 raise Inverse_Error; -- Do not inverse zero. 202 Report.Failed ("Program control not transferred by raise"); 203 else 204 for I in 1 .. Array_Size loop 205 Left(I).Real := - Right(I).Real; 206 Left(I).Imag := - Right(I).Imag; 207 end loop; 208 end if; 209 210 exception 211 when Inverse_Error => 212 TC_Handled_In_Grandchild_Pkg_Proc := true; 213 Left := Result; 214 raise; -- Reraise the Inverse_Error exception in the subtest. 215 Report.Failed ("Exception not reraised in handler"); 216 217 when others => 218 Report.Failed ("Unexpected exception in procedure Inverse"); 219 end Inverse; 220 221end FA11D00.CA11D02_0.CA11D02_1; -- Array_Complex 222 223--=======================================================================-- 224 225with FA11D00.CA11D02_0.CA11D02_1; -- Array_Complex, 226 -- implicitly with Basic_Complex. 227with Report; 228 229procedure CA11D02 is 230 231 package Complex_Pkg renames FA11D00; 232 package Array_Complex_Pkg renames FA11D00.CA11D02_0.CA11D02_1; 233 234 use Complex_Pkg; 235 use Array_Complex_Pkg; 236 237begin 238 239 Report.Test ("CA11D02", "Check that an exception declared in a package " & 240 "can be raised by a child of a child package"); 241 242 Multiply_Complex_Subtest: 243 declare 244 Operand_1 : Complex_Array_Type 245 := ( Complex (Int_Type (Report.Ident_Int (3)), 246 Int_Type (Report.Ident_Int (5))), 247 Complex (Int_Type (Report.Ident_Int (2)), 248 Int_Type (Report.Ident_Int (8))) ); 249 Operand_2 : Complex_Array_Type 250 := ( Complex (Int_Type (Report.Ident_Int (1)), 251 Int_Type (Report.Ident_Int (2))), 252 Complex (Int_Type (Report.Ident_Int (3)), 253 Int_Type (Report.Ident_Int (6))) ); 254 Operand_3 : Complex_Array_Type := ( Zero, Zero); 255 Mul_Result : Complex_Array_Type 256 := ( Complex (Int_Type (Report.Ident_Int (3)), 257 Int_Type (Report.Ident_Int (10))), 258 Complex (Int_Type (Report.Ident_Int (6)), 259 Int_Type (Report.Ident_Int (48))) ); 260 Complex_No : Complex_Array_Type := (others => Zero); 261 262 begin 263 If (Multiply (Operand_1, Operand_2) /= Mul_Result) then 264 Report.Failed ("Incorrect results from multiplication"); 265 end if; 266 267 -- Error is raised and exception will be handled in grandchild package. 268 269 Complex_No := Multiply (Operand_1, Operand_3); 270 271 if Complex_No /= (Zero, Zero) then 272 Report.Failed ("Exception was not raised in multiplication"); 273 end if; 274 275 exception 276 when Multiply_Error => 277 Report.Failed ("Exception raised in multiplication and " & 278 "propagated to caller"); 279 TC_Handled_In_Grandchild_Pkg_Func := false; 280 -- Improper exception handling in caller. 281 282 when others => 283 Report.Failed ("Unexpected exception in multiplication"); 284 TC_Handled_In_Grandchild_Pkg_Func := false; 285 -- Improper exception handling in caller. 286 287 end Multiply_Complex_Subtest; 288 289 290 Add_Complex_Subtest: 291 declare 292 Operand_1 : Complex_Array_Type 293 := ( Complex (Int_Type (Report.Ident_Int (2)), 294 Int_Type (Report.Ident_Int (7))), 295 Complex (Int_Type (Report.Ident_Int (5)), 296 Int_Type (Report.Ident_Int (8))) ); 297 Operand_2 : Complex_Array_Type 298 := ( Complex (Int_Type (Report.Ident_Int (4)), 299 Int_Type (Report.Ident_Int (1))), 300 Complex (Int_Type (Report.Ident_Int (2)), 301 Int_Type (Report.Ident_Int (3))) ); 302 Operand_3 : Complex_Array_Type := ( Zero, Zero); 303 Add_Result : Complex_Array_Type 304 := ( Complex (Int_Type (Report.Ident_Int (6)), 305 Int_Type (Report.Ident_Int (8))), 306 Complex (Int_Type (Report.Ident_Int (7)), 307 Int_Type (Report.Ident_Int (11))) ); 308 Complex_No : Complex_Array_Type := (others => Zero); 309 310 begin 311 Complex_No := Add (Operand_1, Operand_2); 312 313 If (Complex_No /= Add_Result) then 314 Report.Failed ("Incorrect results from addition"); 315 end if; 316 317 -- Error is raised in grandchild package and exception 318 -- will be propagated to caller. 319 320 Complex_No := Add (Operand_1, Operand_3); 321 322 if Complex_No = Add_Result then 323 Report.Failed ("Exception was not raised in addition"); 324 end if; 325 326 exception 327 when Add_Error => 328 TC_Propagated_To_Caller := true; -- Exception is propagated. 329 330 when others => 331 Report.Failed ("Unexpected exception in addition subtest"); 332 TC_Propagated_To_Caller := false; -- Improper exception handling 333 -- in caller. 334 end Add_Complex_Subtest; 335 336 Inverse_Complex_Subtest: 337 declare 338 Operand_1 : Complex_Array_Type 339 := ( Complex (Int_Type (Report.Ident_Int (1)), 340 Int_Type (Report.Ident_Int (5))), 341 Complex (Int_Type (Report.Ident_Int (3)), 342 Int_Type (Report.Ident_Int (11))) ); 343 Operand_3 : Complex_Array_Type 344 := ( Zero, Complex (Int_Type (Report.Ident_Int (3)), 345 Int_Type (Report.Ident_Int (6))) ); 346 Inv_Result : Complex_Array_Type 347 := ( Complex (Int_Type (Report.Ident_Int (-1)), 348 Int_Type (Report.Ident_Int (-5))), 349 Complex (Int_Type (Report.Ident_Int (-3)), 350 Int_Type (Report.Ident_Int (-11))) ); 351 Complex_No : Complex_Array_Type := (others => Zero); 352 353 begin 354 Inverse (Operand_1, Complex_No); 355 356 if (Complex_No /= Inv_Result) then 357 Report.Failed ("Incorrect results from inverse"); 358 end if; 359 360 -- Error is raised in grandchild package and exception 361 -- will be handled/reraised to caller. 362 363 Inverse (Operand_3, Complex_No); 364 365 Report.Failed ("Exception was not handled in inverse"); 366 367 exception 368 when Inverse_Error => 369 if not TC_Handled_In_Grandchild_Pkg_Proc then 370 Report.Failed ("Exception was not raised in inverse"); 371 else 372 TC_Handled_In_Caller := true; -- Exception is reraised from 373 -- child package. 374 end if; 375 376 when others => 377 Report.Failed ("Unexpected exception in inverse"); 378 TC_Handled_In_Caller := false; 379 -- Improper exception handling in caller. 380 381 end Inverse_Complex_Subtest; 382 383 if not (TC_Handled_In_Caller and -- Check to see that all 384 TC_Handled_In_Grandchild_Pkg_Proc and -- exceptions were handled 385 TC_Handled_In_Grandchild_Pkg_Func and -- in proper location. 386 TC_Propagated_To_Caller) 387 then 388 Report.Failed ("Exceptions handled in incorrect locations"); 389 end if; 390 391 Report.Result; 392 393end CA11D02; 394