-- C460A02.A -- -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained -- unlimited rights in the software and documentation contained herein. -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making -- this public release, the Government intends to confer upon all -- recipients unlimited rights equal to those held by the Government. -- These rights include rights to use, duplicate, release or disclose the -- released technical data and computer software in whole or in part, in -- any manner and for any purpose whatsoever, and to have or permit others -- to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. --* -- -- OBJECTIVE: -- Check that if the target type of a type conversion is a general -- access type, Program_Error is raised if the accessibility level of -- the operand type is deeper than that of the target type. Check for -- cases where the type conversion occurs in an instance body, and -- the operand type is declared inside the instance or is the anonymous -- access type of an access parameter or access discriminant. -- -- TEST DESCRIPTION: -- In order to satisfy accessibility requirements, the operand type must -- be at the same or a less deep nesting level than the target type -- the -- operand type must "live" as long as the target type. Nesting levels -- are the run-time nestings of masters: block statements; subprogram, -- task, and entry bodies; and accept statements. Packages are invisible -- to accessibility rules. -- -- This test checks for cases where the operand is a component of a -- generic formal object, a stand-alone object, and an access parameter. -- -- The test declares three generic units, each containing an access -- type conversion in which the target type is a formal type: -- -- (1) A generic package in which the operand type is the anonymous -- access type of an access discriminant, and the conversion -- occurs within the declarative part of the body. -- -- (2) A generic package in which the operand type is declared within -- the specification, and the conversion occurs within the -- sequence of statements of the body. -- -- (3) A generic procedure in which the operand type is the anonymous -- access type of an access parameter, and the conversion occurs -- within the sequence of statements. -- -- The test verifies the following: -- -- For (1), Program_Error is raised when the package is instantiated -- if the actual passed through the formal object has an accessibility -- level deeper than that of the target type passed as an actual, and -- that no exception is raised otherwise. The exception is propagated -- to the innermost enclosing master. -- -- For (2), Program_Error is raised when the package is instantiated -- if the package is instantiated at a level deeper than that of the -- target type passed as an actual, and that no exception is raised -- otherwise. The exception is handled within the package body. -- -- For (3), Program_Error is raised when the instance procedure is -- called if the actual passed through the access parameter has an -- accessibility level deeper than that of the target type passed as -- an actual, and that no exception is raised otherwise. The exception -- is handled within the instance procedure. -- -- TEST FILES: -- The following files comprise this test: -- -- F460A00.A -- => C460A02.A -- -- -- CHANGE HISTORY: -- 10 May 95 SAIC Initial prerelease version. -- 24 Apr 96 SAIC Changed the target type formal to be -- access-to-constant; Modified code to avoid dead -- variable optimization. -- --! with F460A00; generic type Target_Type is access all F460A00.Tagged_Type; FObj: in out F460A00.Composite_Type; package C460A02_0 is procedure Dummy; -- Needed to allow package body. end C460A02_0; --==================================================================-- with Report; package body C460A02_0 is Ptr: Target_Type := Target_Type(FObj.D); procedure Dummy is begin null; end Dummy; begin -- Avoid optimization (dead variable removal of Ptr): if not Report.Equal (Ptr.C, Ptr.C) then -- Always false. Report.Failed ("Unexpected error in C460A02_0 instance"); end if; end C460A02_0; --==================================================================-- with F460A00; generic type Designated_Type is private; type Target_Type is access all Designated_Type; FObj : in out Target_Type; FRes : in out F460A00.TC_Result_Kind; package C460A02_1 is type Operand_Type is access Designated_Type; Ptr : Operand_Type := new Designated_Type; procedure Dummy; -- Needed to allow package body. end C460A02_1; --==================================================================-- package body C460A02_1 is procedure Dummy is begin null; end Dummy; begin FRes := F460A00.UN_Init; FObj := Target_Type(Ptr); FRes := F460A00.OK; exception when Program_Error => FRes := F460A00.PE_Exception; when others => FRes := F460A00.Others_Exception; end C460A02_1; --==================================================================-- with F460A00; generic type Designated_Type is new F460A00.Tagged_Type with private; type Target_Type is access constant Designated_Type; procedure C460A02_2 (P : access Designated_Type'Class; Res : out F460A00.TC_Result_Kind); --==================================================================-- with Report; procedure C460A02_2 (P : access Designated_Type'Class; Res : out F460A00.TC_Result_Kind) is Ptr : Target_Type; begin Res := F460A00.UN_Init; Ptr := Target_Type(P); -- Avoid optimization (dead variable removal of Ptr): if not Report.Equal (Ptr.C, Ptr.C) then -- Always false. Report.Failed ("Unexpected error in C460A02_2 instance"); end if; Res := F460A00.OK; exception when Program_Error => Res := F460A00.PE_Exception; when others => Res := F460A00.Others_Exception; end C460A02_2; --==================================================================-- with F460A00; with C460A02_0; with C460A02_1; with C460A02_2; with Report; procedure C460A02 is begin -- C460A02. -- [ Level = 1 ] Report.Test ("C460A02", "Run-time accessibility checks: instance " & "bodies. Operand type of access type conversion is " & "declared inside instance or is anonymous"); SUBTEST1: declare -- [ Level = 2 ] type AccTag_L2 is access all F460A00.Tagged_Type; PTag_L2 : AccTag_L2 := new F460A00.Tagged_Type; Operand_L2 : F460A00.Composite_Type(PTag_L2); Result : F460A00.TC_Result_Kind := F460A00.UN_Init; begin -- SUBTEST1. begin -- [ Level = 3 ] declare -- [ Level = 4 ] -- The accessibility level of the actual passed as the target type -- in Pack_OK is 2. The accessibility level of the composite actual -- (and thus, the level of the anonymous type of the access -- discriminant, which is the same as that of the containing -- object) is also 2. Therefore, the access type conversion in -- Pack_OK does not raise an exception upon instantiation: package Pack_OK is new C460A02_0 (Target_Type => AccTag_L2, FObj => Operand_L2); begin Result := F460A00.OK; -- Expected result. end; exception when Program_Error => Result := F460A00.PE_Exception; when others => Result := F460A00.Others_Exception; end; F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #1"); end SUBTEST1; SUBTEST2: declare -- [ Level = 2 ] type AccTag_L2 is access all F460A00.Tagged_Type; PTag_L2 : AccTag_L2 := new F460A00.Tagged_Type; Result : F460A00.TC_Result_Kind := F460A00.UN_Init; begin -- SUBTEST2. declare -- [ Level = 3 ] Operand_L3 : F460A00.Composite_Type(PTag_L2); begin declare -- [ Level = 4 ] -- The accessibility level of the actual passed as the target type -- in Pack_PE is 2. The accessibility level of the composite actual -- (and thus, the level of the anonymous type of the access -- discriminant, which is the same as that of the containing -- object) is 3. Therefore, the access type conversion in Pack_PE -- propagates Program_Error upon instantiation: package Pack_PE is new C460A02_0 (AccTag_L2, Operand_L3); begin Result := F460A00.OK; end; exception when Program_Error => Result := F460A00.PE_Exception; -- Expected result. when others => Result := F460A00.Others_Exception; end; F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #2"); end SUBTEST2; SUBTEST3: declare -- [ Level = 2 ] Result : F460A00.TC_Result_Kind := F460A00.UN_Init; begin -- SUBTEST3. declare -- [ Level = 3 ] type AccArr_L3 is access all F460A00.Array_Type; Target: AccArr_L3; -- The accessibility level of the actual passed as the target type -- in Pack_OK is 3. The accessibility level of the operand type is -- that of the instance, which is also 3. Therefore, the access type -- conversion in Pack_OK does not raise an exception upon -- instantiation. If an exception is (incorrectly) raised, it is -- handled within the instance: package Pack_OK is new C460A02_1 (Designated_Type => F460A00.Array_Type, Target_Type => AccArr_L3, FObj => Target, FRes => Result); begin null; end; F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #3"); exception when Program_Error => Report.Failed ("SUBTEST #3: Program_Error incorrectly propagated"); when others => Report.Failed ("SUBTEST #3: Unexpected exception propagated"); end SUBTEST3; SUBTEST4: declare -- [ Level = 2 ] Result : F460A00.TC_Result_Kind := F460A00.UN_Init; begin -- SUBTEST4. declare -- [ Level = 3 ] Target: F460A00.AccArr_L0; -- The accessibility level of the actual passed as the target type -- in Pack_PE is 0. The accessibility level of the operand type is -- that of the instance, which is 3. Therefore, the access type -- conversion in Pack_PE raises Program_Error upon instantiation. -- The exception is handled within the instance: package Pack_PE is new C460A02_1 (Designated_Type => F460A00.Array_Type, Target_Type => F460A00.AccArr_L0, FObj => Target, FRes => Result); begin null; end; F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #4"); exception when Program_Error => Report.Failed ("SUBTEST #4: Program_Error incorrectly raised"); when others => Report.Failed ("SUBTEST #4: Unexpected exception raised"); end SUBTEST4; SUBTEST5: declare -- [ Level = 2 ] Result : F460A00.TC_Result_Kind := F460A00.UN_Init; begin -- SUBTEST5. declare -- [ Level = 3 ] -- The instantiation of C460A02_2 should NOT result in any -- exceptions. procedure Proc is new C460A02_2 (F460A00.Tagged_Type, F460A00.AccTag_L0); begin -- The accessibility level of the actual passed to Proc is 0. The -- accessibility level of the actual passed as the target type is -- also 0. Therefore, the access type conversion in Proc does not -- raise an exception when the subprogram is called. If an exception -- is (incorrectly) raised, it is handled within the subprogram: Proc (F460A00.PTagClass_L0, Result); end; F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #5"); exception when Program_Error => Report.Failed ("SUBTEST #5: Program_Error incorrectly raised"); when others => Report.Failed ("SUBTEST #5: Unexpected exception raised"); end SUBTEST5; SUBTEST6: declare -- [ Level = 2 ] Result : F460A00.TC_Result_Kind := F460A00.UN_Init; begin -- SUBTEST6. declare -- [ Level = 3 ] -- The instantiation of C460A02_2 should NOT result in any -- exceptions. procedure Proc is new C460A02_2 (F460A00.Tagged_Type, F460A00.AccTag_L0); begin -- In the call to (instantiated) procedure Proc, the first actual -- parameter is an allocator. Its accessibility level is that of -- the level of execution of Proc, which is 3. The accessibility -- level of the actual passed as the target type is 0. Therefore, -- the access type conversion in Proc raises Program_Error when the -- subprogram is called. The exception is handled within the -- subprogram: Proc (new F460A00.Tagged_Type, Result); end; F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #6"); exception when Program_Error => Report.Failed ("SUBTEST #6: Program_Error incorrectly raised"); when others => Report.Failed ("SUBTEST #6: Unexpected exception raised"); end SUBTEST6; Report.Result; end C460A02;