1-- CA11D013.AM 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 raise an exception that is declared in 28-- parent. 29-- 30-- TEST DESCRIPTION: 31-- Declare a package which defines complex number abstraction with 32-- user-defined exceptions (foundation code). 33-- 34-- Add a public child package to the above package. Declare two 35-- subprograms for the parent type. Each of the subprograms raises a 36-- different exception, based on the value of an input parameter. 37-- 38-- Add a public child procedure to the foundation package. This 39-- procedure raises an exception based on the value of an input 40-- parameter. 41-- 42-- Add a public child function to the foundation package. This 43-- function raises an exception based on the value of an input 44-- parameter. 45-- 46-- In the main program, "with" the child packages, then check that 47-- the exceptions are raised and handled as expected. Ensure that 48-- exceptions are: 49-- 1) raised in the public child package and handled/reraised to 50-- be handled by the main program. 51-- 2) raised and handled locally in the public child package. 52-- 3) raised and handled locally by "others" in the public child 53-- procedure. 54-- 4) raised in the public child function and propagated to the 55-- main program. 56-- 57-- TEST FILES: 58-- The following files comprise this test: 59-- 60-- FA11D00.A 61-- CA11D010.A 62-- CA11D011.A 63-- CA11D012.A 64-- => CA11D013.AM 65-- 66-- 67-- CHANGE HISTORY: 68-- 06 Dec 94 SAIC ACVC 2.0 69-- 70--! 71 72with FA11D00.CA11D010; -- Add_Subtract_Complex 73with FA11D00.CA11D011; -- Multiply_Complex 74with FA11D00.CA11D012; -- Divide_Complex 75 76with Report; 77 78 79procedure CA11D013 is 80 81 package Complex_Pkg renames FA11D00; 82 package Add_Subtract_Complex_Pkg renames FA11D00.CA11D010; 83 use Complex_Pkg; 84 85begin 86 87 Report.Test ("CA11D013", "Check that a child unit can raise an " & 88 "exception that is declared in parent"); 89 90 91 Add_Complex_Subtest: 92 declare 93 First : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)), 94 Int_Type (Report.Ident_Int (7))); 95 Second : Complex_Type := Complex (Int_Type (Report.Ident_Int (5)), 96 Int_Type (Report.Ident_Int (3))); 97 Add_Result : Complex_Type := Complex (Int_Type (Report.Ident_Int (8)), 98 Int_Type (Report.Ident_Int (10))); 99 Third : Complex_Type := Complex (Int_Type(Report.Ident_Int(-100)), 100 Int_Type (Report.Ident_Int (100))); 101 Complex_Num : Complex_Type := Zero; 102 103 begin 104 Add_Subtract_Complex_Pkg.Add (First, Second, Complex_Num); 105 106 if (Complex_Num /= Add_Result) then 107 Report.Failed ("Incorrect results from addition"); 108 end if; 109 110 -- Error is raised in child package and exception 111 -- will be handled/reraised to caller. 112 113 Add_Subtract_Complex_Pkg.Add (First, Third, Complex_Num); 114 115 -- Error was not raised in child package. 116 Report.Failed ("Exception was not reraised in addition"); 117 118 exception 119 when Add_Error => 120 if not TC_Handled_In_Child_Pkg_Proc then 121 Report.Failed ("Exception was not raised in addition"); 122 else 123 TC_Handled_In_Caller := true; -- Exception is reraised from 124 -- child package. 125 end if; 126 127 when others => 128 Report.Failed ("Unexpected exception in addition subtest"); 129 TC_Handled_In_Caller := false; -- Improper exception handling 130 -- in caller. 131 132 end Add_Complex_Subtest; 133 134 135 Subtract_Complex_Subtest: 136 declare 137 First : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)), 138 Int_Type (Report.Ident_Int (6))); 139 Second : Complex_Type := Complex (Int_Type (Report.Ident_Int (5)), 140 Int_Type (Report.Ident_Int (7))); 141 Sub_Result : Complex_Type := Complex (Int_Type (Report.Ident_Int (2)), 142 Int_Type (Report.Ident_Int (1))); 143 Third : Complex_Type := Complex (Int_Type(Report.Ident_Int(-200)), 144 Int_Type (Report.Ident_Int (1))); 145 Complex_Num : Complex_Type; 146 147 begin 148 Complex_Num := Add_Subtract_Complex_Pkg.Subtract (Second, First); 149 150 if (Complex_Num /= Sub_Result) then 151 Report.Failed ("Incorrect results from subtraction"); 152 end if; 153 154 -- Error is raised and exception will be handled in child package. 155 Complex_Num := Add_Subtract_Complex_Pkg.Subtract (Second, Third); 156 157 exception 158 when Subtract_Error => 159 Report.Failed ("Exception raised in subtraction and " & 160 "propagated to caller"); 161 TC_Handled_In_Child_Pkg_Func := false; -- Improper exception handling 162 -- in caller. 163 164 when others => 165 Report.Failed ("Unexpected exception in subtraction subtest"); 166 TC_Handled_In_Child_Pkg_Func := false; -- Improper exception handling 167 -- in caller. 168 169 end Subtract_Complex_Subtest; 170 171 172 Multiply_Complex_Subtest: 173 declare 174 First : Complex_Type := Complex (Int_Type(Report.Ident_Int(3)), 175 Int_Type (Report.Ident_Int (4))); 176 Second : Complex_Type := Complex (Int_Type(Report.Ident_Int(5)), 177 Int_Type (Report.Ident_Int (3))); 178 Mult_Result : Complex_Type := Complex(Int_Type(Report.Ident_Int(15)), 179 Int_Type(Report.Ident_Int (12))); 180 Third : Complex_Type := Complex(Int_Type(Report.Ident_Int(10)), 181 Int_Type(Report.Ident_Int (-10))); 182 Complex_Num : Complex_Type; 183 184 begin 185 CA11D011 (First, Second, Complex_Num); 186 187 if (Complex_Num /= Mult_Result) then 188 Report.Failed ("Incorrect results from multiplication"); 189 end if; 190 191 -- Error is raised and exception will be handled in child package. 192 CA11D011 (First, Third, Complex_Num); 193 194 exception 195 when Multiply_Error => 196 Report.Failed ("Exception raised in multiplication and " & 197 "propagated to caller"); 198 TC_Handled_In_Child_Sub := false; -- Improper exception handling 199 -- in caller. 200 201 when others => 202 Report.Failed ("Unexpected exception in multiplication subtest"); 203 TC_Handled_In_Child_Sub := false; -- Improper exception handling 204 -- in caller. 205 end Multiply_Complex_Subtest; 206 207 208 Divide_Complex_Subtest: 209 declare 210 First : Complex_Type := Complex (Int_Type (Report.Ident_Int(10)), 211 Int_Type (Report.Ident_Int (15))); 212 Second : Complex_Type := Complex (Int_Type(Report.Ident_Int(5)), 213 Int_Type (Report.Ident_Int (3))); 214 Div_Result : Complex_Type := Complex (Int_Type(Report.Ident_Int(2)), 215 Int_Type (Report.Ident_Int (5))); 216 Third : Complex_Type := Complex (Int_Type(Report.Ident_Int(-10)), 217 Int_Type (Report.Ident_Int (0))); 218 Complex_Num : Complex_Type := Zero; 219 220 begin 221 Complex_Num := CA11D012 (First, Second); 222 223 if (Complex_Num /= Div_Result) then 224 Report.Failed ("Incorrect results from division"); 225 end if; 226 227 -- Error is raised in child package; exception will be 228 -- propagated to caller. 229 Complex_Num := CA11D012 (Second, Third); 230 231 -- Error was not raised in child package. 232 Report.Failed ("Exception was not raised in division subtest "); 233 234 exception 235 when Divide_Error => 236 TC_Propagated_To_Caller := true; -- Exception is propagated. 237 238 when others => 239 Report.Failed ("Unexpected exception in division subtest"); 240 TC_Propagated_To_Caller := false; -- Improper exception handling 241 -- in caller. 242 end Divide_Complex_Subtest; 243 244 245 if not (TC_Handled_In_Caller and -- Check to see that all 246 TC_Handled_In_Child_Pkg_Proc and -- exceptions were handled in 247 TC_Handled_In_Child_Pkg_Func and -- the proper locations. 248 TC_Handled_In_Child_Sub and 249 TC_Propagated_To_Caller) 250 then 251 Report.Failed ("Exceptions handled in incorrect locations"); 252 end if; 253 254 Report.Result; 255 256end CA11D013; 257