1-- C460A02.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 if the target type of a type conversion is a general 28-- access type, Program_Error is raised if the accessibility level of 29-- the operand type is deeper than that of the target type. Check for 30-- cases where the type conversion occurs in an instance body, and 31-- the operand type is declared inside the instance or is the anonymous 32-- access type of an access parameter or access discriminant. 33-- 34-- TEST DESCRIPTION: 35-- In order to satisfy accessibility requirements, the operand type must 36-- be at the same or a less deep nesting level than the target type -- the 37-- operand type must "live" as long as the target type. Nesting levels 38-- are the run-time nestings of masters: block statements; subprogram, 39-- task, and entry bodies; and accept statements. Packages are invisible 40-- to accessibility rules. 41-- 42-- This test checks for cases where the operand is a component of a 43-- generic formal object, a stand-alone object, and an access parameter. 44-- 45-- The test declares three generic units, each containing an access 46-- type conversion in which the target type is a formal type: 47-- 48-- (1) A generic package in which the operand type is the anonymous 49-- access type of an access discriminant, and the conversion 50-- occurs within the declarative part of the body. 51-- 52-- (2) A generic package in which the operand type is declared within 53-- the specification, and the conversion occurs within the 54-- sequence of statements of the body. 55-- 56-- (3) A generic procedure in which the operand type is the anonymous 57-- access type of an access parameter, and the conversion occurs 58-- within the sequence of statements. 59-- 60-- The test verifies the following: 61-- 62-- For (1), Program_Error is raised when the package is instantiated 63-- if the actual passed through the formal object has an accessibility 64-- level deeper than that of the target type passed as an actual, and 65-- that no exception is raised otherwise. The exception is propagated 66-- to the innermost enclosing master. 67-- 68-- For (2), Program_Error is raised when the package is instantiated 69-- if the package is instantiated at a level deeper than that of the 70-- target type passed as an actual, and that no exception is raised 71-- otherwise. The exception is handled within the package body. 72-- 73-- For (3), Program_Error is raised when the instance procedure is 74-- called if the actual passed through the access parameter has an 75-- accessibility level deeper than that of the target type passed as 76-- an actual, and that no exception is raised otherwise. The exception 77-- is handled within the instance procedure. 78-- 79-- TEST FILES: 80-- The following files comprise this test: 81-- 82-- F460A00.A 83-- => C460A02.A 84-- 85-- 86-- CHANGE HISTORY: 87-- 10 May 95 SAIC Initial prerelease version. 88-- 24 Apr 96 SAIC Changed the target type formal to be 89-- access-to-constant; Modified code to avoid dead 90-- variable optimization. 91-- 92--! 93 94with F460A00; 95generic 96 type Target_Type is access all F460A00.Tagged_Type; 97 FObj: in out F460A00.Composite_Type; 98package C460A02_0 is 99 procedure Dummy; -- Needed to allow package body. 100end C460A02_0; 101 102 103 --==================================================================-- 104 105with Report; 106package body C460A02_0 is 107 Ptr: Target_Type := Target_Type(FObj.D); 108 109 procedure Dummy is 110 begin 111 null; 112 end Dummy; 113 114begin 115 -- Avoid optimization (dead variable removal of Ptr): 116 if not Report.Equal (Ptr.C, Ptr.C) then -- Always false. 117 Report.Failed ("Unexpected error in C460A02_0 instance"); 118 end if; 119 120end C460A02_0; 121 122 123 --==================================================================-- 124 125 126with F460A00; 127generic 128 type Designated_Type is private; 129 type Target_Type is access all Designated_Type; 130 FObj : in out Target_Type; 131 FRes : in out F460A00.TC_Result_Kind; 132package C460A02_1 is 133 type Operand_Type is access Designated_Type; 134 Ptr : Operand_Type := new Designated_Type; 135 136 procedure Dummy; -- Needed to allow package body. 137end C460A02_1; 138 139 140 --==================================================================-- 141 142 143package body C460A02_1 is 144 procedure Dummy is 145 begin 146 null; 147 end Dummy; 148begin 149 FRes := F460A00.UN_Init; 150 FObj := Target_Type(Ptr); 151 FRes := F460A00.OK; 152exception 153 when Program_Error => FRes := F460A00.PE_Exception; 154 when others => FRes := F460A00.Others_Exception; 155end C460A02_1; 156 157 158 --==================================================================-- 159 160 161with F460A00; 162generic 163 type Designated_Type is new F460A00.Tagged_Type with private; 164 type Target_Type is access constant Designated_Type; 165procedure C460A02_2 (P : access Designated_Type'Class; 166 Res : out F460A00.TC_Result_Kind); 167 168 169 --==================================================================-- 170 171 172with Report; 173procedure C460A02_2 (P : access Designated_Type'Class; 174 Res : out F460A00.TC_Result_Kind) is 175 Ptr : Target_Type; 176begin 177 Res := F460A00.UN_Init; 178 Ptr := Target_Type(P); 179 180 -- Avoid optimization (dead variable removal of Ptr): 181 if not Report.Equal (Ptr.C, Ptr.C) then -- Always false. 182 Report.Failed ("Unexpected error in C460A02_2 instance"); 183 end if; 184 Res := F460A00.OK; 185exception 186 when Program_Error => Res := F460A00.PE_Exception; 187 when others => Res := F460A00.Others_Exception; 188end C460A02_2; 189 190 191 --==================================================================-- 192 193 194with F460A00; 195with C460A02_0; 196with C460A02_1; 197with C460A02_2; 198 199with Report; 200procedure C460A02 is 201begin -- C460A02. -- [ Level = 1 ] 202 203 Report.Test ("C460A02", "Run-time accessibility checks: instance " & 204 "bodies. Operand type of access type conversion is " & 205 "declared inside instance or is anonymous"); 206 207 208 SUBTEST1: 209 declare -- [ Level = 2 ] 210 type AccTag_L2 is access all F460A00.Tagged_Type; 211 PTag_L2 : AccTag_L2 := new F460A00.Tagged_Type; 212 Operand_L2 : F460A00.Composite_Type(PTag_L2); 213 214 Result : F460A00.TC_Result_Kind := F460A00.UN_Init; 215 begin -- SUBTEST1. 216 217 begin -- [ Level = 3 ] 218 declare -- [ Level = 4 ] 219 -- The accessibility level of the actual passed as the target type 220 -- in Pack_OK is 2. The accessibility level of the composite actual 221 -- (and thus, the level of the anonymous type of the access 222 -- discriminant, which is the same as that of the containing 223 -- object) is also 2. Therefore, the access type conversion in 224 -- Pack_OK does not raise an exception upon instantiation: 225 226 package Pack_OK is new C460A02_0 227 (Target_Type => AccTag_L2, FObj => Operand_L2); 228 begin 229 Result := F460A00.OK; -- Expected result. 230 end; 231 exception 232 when Program_Error => Result := F460A00.PE_Exception; 233 when others => Result := F460A00.Others_Exception; 234 end; 235 236 F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #1"); 237 238 end SUBTEST1; 239 240 241 242 SUBTEST2: 243 declare -- [ Level = 2 ] 244 type AccTag_L2 is access all F460A00.Tagged_Type; 245 PTag_L2 : AccTag_L2 := new F460A00.Tagged_Type; 246 247 Result : F460A00.TC_Result_Kind := F460A00.UN_Init; 248 begin -- SUBTEST2. 249 250 declare -- [ Level = 3 ] 251 Operand_L3 : F460A00.Composite_Type(PTag_L2); 252 begin 253 declare -- [ Level = 4 ] 254 -- The accessibility level of the actual passed as the target type 255 -- in Pack_PE is 2. The accessibility level of the composite actual 256 -- (and thus, the level of the anonymous type of the access 257 -- discriminant, which is the same as that of the containing 258 -- object) is 3. Therefore, the access type conversion in Pack_PE 259 -- propagates Program_Error upon instantiation: 260 261 package Pack_PE is new C460A02_0 (AccTag_L2, Operand_L3); 262 begin 263 Result := F460A00.OK; 264 end; 265 exception 266 when Program_Error => Result := F460A00.PE_Exception; 267 -- Expected result. 268 when others => Result := F460A00.Others_Exception; 269 end; 270 271 F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #2"); 272 273 end SUBTEST2; 274 275 276 277 SUBTEST3: 278 declare -- [ Level = 2 ] 279 Result : F460A00.TC_Result_Kind := F460A00.UN_Init; 280 begin -- SUBTEST3. 281 282 declare -- [ Level = 3 ] 283 type AccArr_L3 is access all F460A00.Array_Type; 284 Target: AccArr_L3; 285 286 -- The accessibility level of the actual passed as the target type 287 -- in Pack_OK is 3. The accessibility level of the operand type is 288 -- that of the instance, which is also 3. Therefore, the access type 289 -- conversion in Pack_OK does not raise an exception upon 290 -- instantiation. If an exception is (incorrectly) raised, it is 291 -- handled within the instance: 292 293 package Pack_OK is new C460A02_1 294 (Designated_Type => F460A00.Array_Type, 295 Target_Type => AccArr_L3, 296 FObj => Target, 297 FRes => Result); 298 begin 299 null; 300 end; 301 302 F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #3"); 303 304 exception 305 when Program_Error => 306 Report.Failed ("SUBTEST #3: Program_Error incorrectly propagated"); 307 when others => 308 Report.Failed ("SUBTEST #3: Unexpected exception propagated"); 309 end SUBTEST3; 310 311 312 313 SUBTEST4: 314 declare -- [ Level = 2 ] 315 Result : F460A00.TC_Result_Kind := F460A00.UN_Init; 316 begin -- SUBTEST4. 317 318 declare -- [ Level = 3 ] 319 Target: F460A00.AccArr_L0; 320 321 -- The accessibility level of the actual passed as the target type 322 -- in Pack_PE is 0. The accessibility level of the operand type is 323 -- that of the instance, which is 3. Therefore, the access type 324 -- conversion in Pack_PE raises Program_Error upon instantiation. 325 -- The exception is handled within the instance: 326 327 package Pack_PE is new C460A02_1 328 (Designated_Type => F460A00.Array_Type, 329 Target_Type => F460A00.AccArr_L0, 330 FObj => Target, 331 FRes => Result); 332 begin 333 null; 334 end; 335 336 F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #4"); 337 338 exception 339 when Program_Error => 340 Report.Failed ("SUBTEST #4: Program_Error incorrectly raised"); 341 when others => 342 Report.Failed ("SUBTEST #4: Unexpected exception raised"); 343 end SUBTEST4; 344 345 346 347 SUBTEST5: 348 declare -- [ Level = 2 ] 349 Result : F460A00.TC_Result_Kind := F460A00.UN_Init; 350 begin -- SUBTEST5. 351 352 declare -- [ Level = 3 ] 353 -- The instantiation of C460A02_2 should NOT result in any 354 -- exceptions. 355 356 procedure Proc is new C460A02_2 (F460A00.Tagged_Type, 357 F460A00.AccTag_L0); 358 begin 359 -- The accessibility level of the actual passed to Proc is 0. The 360 -- accessibility level of the actual passed as the target type is 361 -- also 0. Therefore, the access type conversion in Proc does not 362 -- raise an exception when the subprogram is called. If an exception 363 -- is (incorrectly) raised, it is handled within the subprogram: 364 365 Proc (F460A00.PTagClass_L0, Result); 366 end; 367 368 F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #5"); 369 370 exception 371 when Program_Error => 372 Report.Failed ("SUBTEST #5: Program_Error incorrectly raised"); 373 when others => 374 Report.Failed ("SUBTEST #5: Unexpected exception raised"); 375 end SUBTEST5; 376 377 378 379 SUBTEST6: 380 declare -- [ Level = 2 ] 381 Result : F460A00.TC_Result_Kind := F460A00.UN_Init; 382 begin -- SUBTEST6. 383 384 declare -- [ Level = 3 ] 385 -- The instantiation of C460A02_2 should NOT result in any 386 -- exceptions. 387 388 procedure Proc is new C460A02_2 (F460A00.Tagged_Type, 389 F460A00.AccTag_L0); 390 begin 391 -- In the call to (instantiated) procedure Proc, the first actual 392 -- parameter is an allocator. Its accessibility level is that of 393 -- the level of execution of Proc, which is 3. The accessibility 394 -- level of the actual passed as the target type is 0. Therefore, 395 -- the access type conversion in Proc raises Program_Error when the 396 -- subprogram is called. The exception is handled within the 397 -- subprogram: 398 399 Proc (new F460A00.Tagged_Type, Result); 400 end; 401 402 F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #6"); 403 404 exception 405 when Program_Error => 406 Report.Failed ("SUBTEST #6: Program_Error incorrectly raised"); 407 when others => 408 Report.Failed ("SUBTEST #6: Unexpected exception raised"); 409 end SUBTEST6; 410 411 Report.Result; 412 413end C460A02; 414