diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c4/c460a02.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c4/c460a02.a | 413 |
1 files changed, 0 insertions, 413 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c4/c460a02.a b/gcc/testsuite/ada/acats/tests/c4/c460a02.a deleted file mode 100644 index 1d79d3a614e..00000000000 --- a/gcc/testsuite/ada/acats/tests/c4/c460a02.a +++ /dev/null @@ -1,413 +0,0 @@ --- 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; |