1-- CB41004.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 Raise_Exception and Reraise_Occurrence have no effect in 28-- the case of Null_Id or Null_Occurrence. Check that Exception_Message, 29-- Exception_Identity, Exception_Name, and Exception_Information raise 30-- Constraint_Error for a Null_Occurrence input parameter. 31-- Check that calling the Save_Occurrence subprograms with the 32-- Null_Occurrence input parameter saves the Null_Occurrence to the 33-- appropriate target object, and does not raise Constraint_Error. 34-- Check that Null_Id is the default initial value of type Exception_Id. 35-- 36-- TEST DESCRIPTION: 37-- This test performs a series of calls to many of the subprograms 38-- defined in package Ada.Exceptions, using either Null_Id or 39-- Null_Occurrence (based on their parameter profile). In the cases of 40-- Raise_Exception and Reraise_Occurrence, these null input values 41-- should result in no exceptions being raised, and Constraint_Error 42-- should not be raised in response to these calls. Test failure will 43-- result if any exception is raised in these cases. 44-- For the Save_Occurrence subprograms, calling them with the 45-- Null_Occurrence input parameter does not raise Constraint_Error, but 46-- simply results in the Null_Occurrence being saved into the appropriate 47-- target (either a Exception_Occurrence out parameter, or as an 48-- Exception_Occurrence_Access value). 49-- In the cases of the other mentioned subprograms, calls performed with 50-- a Null_Occurrence input parameter must result in Constraint_Error 51-- being raised. This exception will be handled, with test failure the 52-- result if the exception is not raised. 53-- 54-- 55-- CHANGE HISTORY: 56-- 06 Dec 94 SAIC ACVC 2.0 57-- 08 Dec 00 RLB Removed Exception_Identity subtest, pending 58-- resolution of AI95-00241. 59-- 29 Mar 07 RLB Replaced Exception_Identity subtest, repaired 60-- Raise_Exception subtest for AI95-00446. 61--! 62 63with Report; 64with Ada.Exceptions; 65 66procedure CB41004 is 67begin 68 69 Report.Test ("CB41004", "Check that Null_Id and Null_Occurrence input " & 70 "parameters have the appropriate effect when " & 71 "used in calls of the subprograms found in " & 72 "package Ada.Exceptions"); 73 74 Test_Block: 75 declare 76 77 use Ada.Exceptions; 78 79 -- No initial values given for these two declarations; they default 80 -- to Null_Id and Null_Occurrence respectively. 81 A_Null_Exception_Id : Ada.Exceptions.Exception_Id; 82 A_Null_Exception_Occurrence : Ada.Exceptions.Exception_Occurrence; 83 84 TC_Flag : Boolean := False; 85 86 begin 87 88 -- Verify that Null_Id is the default initial value of type 89 -- Exception_Id. 90 91 if not (A_Null_Exception_Id = Ada.Exceptions.Null_Id) then 92 Report.Failed("The default initial value of an object of type " & 93 "Exception_Id was not Null_Id"); 94 end if; 95 96 97 -- Verify that Raise_Exception has no effect in the case of Null_Id. 98 -- Modified by AI-446. 99 begin 100 Ada.Exceptions.Raise_Exception(A_Null_Exception_Id); 101 Report.Comment( 102 "No exception raised by procedure Raise_Exception " & 103 "when called with a Null_Id input parameter - compatible with " & 104 "original Ada95"); 105 exception 106 when Constraint_Error => null; -- OK, expected exception. 107 Report.Comment( 108 "Constraint_Error exception raised by procedure Raise_Exception " & 109 "when called with a Null_Id input parameter - compatible with " & 110 "AI95-00446"); 111 when others => 112 Report.Failed( 113 "Unexpected exception raised by procedure Raise_Exception " & 114 "when called with a Null_Id input parameter"); 115 end; 116 117 TC_Flag := False; 118 119 120 -- Verify that Reraise_Occurrence has no effect in the case of 121 -- Null_Occurrence. 122 begin 123 Ada.Exceptions.Reraise_Occurrence(A_Null_Exception_Occurrence); 124 TC_Flag := True; 125 exception 126 when others => 127 Report.Failed 128 ("Exception raised by procedure Reraise_Occurrence " & 129 "when called with a Null_Occurrence input parameter"); 130 end; 131 132 if not TC_Flag then 133 Report.Failed("Incorrect processing following the call to " & 134 "Reraise_Occurrence with a Null_Occurrence " & 135 "input parameter"); 136 end if; 137 138 139 -- Verify that function Exception_Message raises Constraint_Error for 140 -- a Null_Occurrence input parameter. 141 begin 142 declare 143 Msg : constant String := 144 Ada.Exceptions.Exception_Message(A_Null_Exception_Occurrence); 145 begin 146 Report.Failed 147 ("Constraint_Error not raised by Function Exception_Message " & 148 "when called with a Null_Occurrence input parameter"); 149 end; 150 exception 151 when Constraint_Error => null; -- OK, expected exception. 152 when others => 153 Report.Failed 154 ("Unexpected exception raised by Function Exception_Message " & 155 "when called with a Null_Occurrence input parameter"); 156 end; 157 158 159 -- Verify that function Exception_Identity raises Constraint_Error for 160 -- a Null_Occurrence input parameter. 161 -- Modified by AI-241. 162 begin 163 declare 164 Id : Ada.Exceptions.Exception_Id := 165 Ada.Exceptions.Exception_Identity(A_Null_Exception_Occurrence); 166 begin 167 Report.Comment 168 ("No exception raised by Function Exception_Identity " & 169 "when called with a Null_Occurrence input parameter - " & 170 "compatible with AI95-00241."); 171 end; 172 exception 173 when Constraint_Error => 174 Report.Comment 175 ("Constraint_Error raised by Function Exception_Identity " & 176 "when called with a Null_Occurrence input parameter - " & 177 "compatible with original Ada95."); 178 when others => 179 Report.Failed 180 ("Unexpected exception raised by Function Exception_Identity " & 181 "when called with a Null_Occurrence input parameter"); 182 end; 183 184 185 -- Verify that function Exception_Name raises Constraint_Error for 186 -- a Null_Occurrence input parameter. 187 begin 188 declare 189 Name : constant String := 190 Ada.Exceptions.Exception_Name(A_Null_Exception_Occurrence); 191 begin 192 Report.Failed 193 ("Constraint_Error not raised by Function Exception_Name " & 194 "when called with a Null_Occurrence input parameter"); 195 end; 196 exception 197 when Constraint_Error => null; -- OK, expected exception. 198 when others => 199 Report.Failed 200 ("Unexpected exception raised by Function Exception_Null " & 201 "when called with a Null_Occurrence input parameter"); 202 end; 203 204 205 -- Verify that function Exception_Information raises Constraint_Error 206 -- for a Null_Occurrence input parameter. 207 begin 208 declare 209 Info : constant String := 210 Ada.Exceptions.Exception_Information 211 (A_Null_Exception_Occurrence); 212 begin 213 Report.Failed 214 ("Constraint_Error not raised by Function " & 215 "Exception_Information when called with a " & 216 "Null_Occurrence input parameter"); 217 end; 218 exception 219 when Constraint_Error => null; -- OK, expected exception. 220 when others => 221 Report.Failed 222 ("Unexpected exception raised by Function Exception_Null " & 223 "when called with a Null_Occurrence input parameter"); 224 end; 225 226 227 -- Verify that calling the Save_Occurrence procedure with a 228 -- Null_Occurrence input parameter saves the Null_Occurrence to the 229 -- target object, and does not raise Constraint_Error. 230 declare 231 use Ada.Exceptions; 232 Saved_Occurrence : Exception_Occurrence; 233 begin 234 235 -- Initialize the Saved_Occurrence variable with a value other than 236 -- Null_Occurrence (default). 237 begin 238 raise Program_Error; 239 exception 240 when Exc : others => Save_Occurrence(Saved_Occurrence, Exc); 241 end; 242 243 -- Save a Null_Occurrence input parameter. 244 begin 245 Save_Occurrence(Target => Saved_Occurrence, 246 Source => Ada.Exceptions.Null_Occurrence); 247 exception 248 when others => 249 Report.Failed 250 ("Unexpected exception raised by procedure " & 251 "Save_Occurrence when called with a Null_Occurrence " & 252 "input parameter"); 253 end; 254 255 -- Verify that the occurrence that was saved above is a 256 -- Null_Occurrence value. 257 258 begin 259 Reraise_Occurrence(Saved_Occurrence); 260 exception 261 when others => 262 Report.Failed("Value saved from Procedure Save_Occurrence " & 263 "resulted in an exception, i.e., was not a " & 264 "value of Null_Occurrence"); 265 end; 266 267 exception 268 when others => 269 Report.Failed("Unexpected exception raised during evaluation " & 270 "of Procedure Save_Occurrence"); 271 end; 272 273 274 -- Verify that calling the Save_Occurrence function with a 275 -- Null_Occurrence input parameter returns the Null_Occurrence as the 276 -- function result, and does not raise Constraint_Error. 277 declare 278 Occurrence_Ptr : Ada.Exceptions.Exception_Occurrence_Access; 279 begin 280 -- Save a Null_Occurrence input parameter. 281 begin 282 Occurrence_Ptr := 283 Ada.Exceptions.Save_Occurrence(Ada.Exceptions.Null_Occurrence); 284 exception 285 when others => 286 Report.Failed 287 ("Unexpected exception raised by function " & 288 "Save_Occurrence when called with a Null_Occurrence " & 289 "input parameter"); 290 end; 291 292 -- Verify that the occurrence that was saved above is a 293 -- Null_Occurrence value. 294 295 begin 296 -- Dereferenced value of type Exception_Occurrence_Access 297 -- should be a Null_Occurrence value, based on the action 298 -- of Function Save_Occurrence above. Providing this as an 299 -- input parameter to Reraise_Exception should not result in 300 -- any exception being raised. 301 302 Ada.Exceptions.Reraise_Occurrence(Occurrence_Ptr.all); 303 304 exception 305 when others => 306 Report.Failed("Value saved from Function Save_Occurrence " & 307 "resulted in an exception, i.e., was not a " & 308 "value of Null_Occurrence"); 309 end; 310 exception 311 when others => 312 Report.Failed("Unexpected exception raised during evaluation " & 313 "of Function Save_Occurrence"); 314 end; 315 316 317 318 exception 319 when others => Report.Failed ("Exception raised in Test_Block"); 320 end Test_Block; 321 322 Report.Result; 323 324end CB41004; 325