1-- CA11D03.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-- client of a child of the package. Check that it can be renamed in 29-- the client of the child of the package and raised with the correct 30-- effect. 31-- 32-- TEST DESCRIPTION: 33-- Declare a package which defines complex number abstraction with 34-- user-defined exceptions (foundation code). 35-- 36-- Add a public child package to the above package. Declare two 37-- subprograms for the parent type. 38-- 39-- In the main program, "with" the child package, then check that 40-- an exception can be raised and handled as expected. 41-- 42-- TEST FILES: 43-- This test depends on the following foundation code: 44-- 45-- FA11D00.A 46-- 47-- 48-- CHANGE HISTORY: 49-- 06 Dec 94 SAIC ACVC 2.0 50-- 51--! 52 53-- Child package of FA11D00. 54package FA11D00.CA11D03_0 is -- Basic_Complex 55 56 function "+" (Left, Right : Complex_Type) 57 return Complex_Type; -- Add two complex numbers. 58 59 function "*" (Left, Right : Complex_Type) 60 return Complex_Type; -- Multiply two complex numbers. 61 62end FA11D00.CA11D03_0; -- Basic_Complex 63 64--=======================================================================-- 65 66package body FA11D00.CA11D03_0 is -- Basic_Complex 67 68 function "+" (Left, Right : Complex_Type) return Complex_Type is 69 begin 70 return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) ); 71 end "+"; 72 -------------------------------------------------------------- 73 function "*" (Left, Right : Complex_Type) return Complex_Type is 74 begin 75 return ( Real => (Left.Real * Right.Real), 76 Imag => (Left.Imag * Right.Imag) ); 77 end "*"; 78 79end FA11D00.CA11D03_0; -- Basic_Complex 80 81--=======================================================================-- 82 83with FA11D00.CA11D03_0; -- Basic_Complex, 84 -- implicitly with Complex_Definition. 85with Report; 86 87procedure CA11D03 is 88 89 package Complex_Pkg renames FA11D00; -- Complex_Definition_Pkg 90 package Basic_Complex_Pkg renames FA11D00.CA11D03_0; -- Basic_Complex 91 92 use Complex_Pkg; 93 use Basic_Complex_Pkg; 94 95 TC_Handled_In_Subtest_1, 96 TC_Handled_In_Subtest_2 : boolean := false; 97 98begin 99 100 Report.Test ("CA11D03", "Check that an exception declared in a package " & 101 "can be raised by a client of a child of the package"); 102 103 Multiply_Complex_Subtest: 104 declare 105 Operand_1 : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)), 106 Int_Type (Report.Ident_Int (2))); 107 -- Referenced to function in parent package. 108 Operand_2 : Complex_Type := Complex (Int_Type (Report.Ident_Int (10)), 109 Int_Type (Report.Ident_Int (8))); 110 Mul_Res : Complex_type := Complex (Int_Type (Report.Ident_Int (30)), 111 Int_Type (Report.Ident_Int (16))); 112 Complex_No : Complex_Type := Zero; -- Zero is declared in parent package. 113 begin 114 Complex_No := Operand_1 * Operand_2; -- Basic_Complex."*". 115 if Complex_No /= Mul_Res then 116 Report.Failed ("Incorrect results from multiplication"); 117 end if; 118 119 -- Error is raised and exception will be handled. 120 if Complex_No = Mul_Res then 121 raise Multiply_Error; -- Reference to exception in 122 end if; -- parent package. 123 124 exception 125 when Multiply_Error => 126 TC_Handled_In_Subtest_1 := true; 127 when others => 128 TC_Handled_In_Subtest_1 := false; -- Improper exception handling. 129 130 end Multiply_Complex_Subtest; 131 132 Add_Complex_Subtest: 133 declare 134 Error_In_Client : exception renames Add_Error; 135 -- Reference to exception in parent package. 136 Operand_1 : Complex_Type := Complex (Int_Type (Report.Ident_Int (2)), 137 Int_Type (Report.Ident_Int (7))); 138 Operand_2 : Complex_Type := Complex (Int_Type (Report.Ident_Int (-4)), 139 Int_Type (Report.Ident_Int (1))); 140 Add_Res : Complex_type := Complex (Int_Type (Report.Ident_Int (-2)), 141 Int_Type (Report.Ident_Int (8))); 142 Complex_No : Complex_Type := One; -- One is declared in parent 143 -- package. 144 begin 145 Complex_No := Operand_1 + Operand_2; -- Basic_Complex."+". 146 147 if Complex_No /= Add_Res then 148 Report.Failed ("Incorrect results from multiplication"); 149 end if; 150 151 -- Error is raised and exception will be handled. 152 if Complex_No = Add_Res then 153 raise Error_In_Client; 154 end if; 155 156 exception 157 when Error_In_Client => 158 TC_Handled_In_Subtest_2 := true; 159 160 when others => 161 TC_Handled_In_Subtest_2 := false; -- Improper exception handling. 162 163 end Add_Complex_Subtest; 164 165 if not (TC_Handled_In_Subtest_1 and -- Check to see that all 166 TC_Handled_In_Subtest_2) -- exceptions were handled 167 -- in the proper location. 168 then 169 Report.Failed ("Exceptions handled in incorrect locations"); 170 end if; 171 172 Report.Result; 173 174end CA11D03; 175