diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c4/c460a01.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c4/c460a01.a | 408 |
1 files changed, 0 insertions, 408 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c4/c460a01.a b/gcc/testsuite/ada/acats/tests/c4/c460a01.a deleted file mode 100644 index 2d583706eb9..00000000000 --- a/gcc/testsuite/ada/acats/tests/c4/c460a01.a +++ /dev/null @@ -1,408 +0,0 @@ --- C460A01.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 passed as an actual during instantiation. --- --- 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 subprogram formal --- parameter. --- --- The test declares three generic packages, each containing an access --- type conversion in which the operand type is a formal type: --- --- (1) One in which the target type is declared within the --- specification, and the conversion occurs within a nested --- function. --- --- (2) One in which the target type is also a formal type, and --- the conversion occurs within a nested function. --- --- (3) One in which the target type is declared outside the --- generic, and the conversion occurs within a nested --- procedure. --- --- The test verifies the following: --- --- For (1), Program_Error is not raised when the nested function is --- called. Since the actual corresponding to the formal operand type --- must always have the same or a less deep level than the target --- type declared within the instance, the access type conversion is --- always safe. --- --- For (2), Program_Error is raised when the nested function is --- called if the operand type passed as an actual during instantiation --- 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 (3), Program_Error is raised when the nested procedure is --- called if the operand type passed as an actual during instantiation --- has an accessibility level deeper than that of the target type. --- The exception is handled within the nested procedure. --- --- TEST FILES: --- The following files comprise this test: --- --- F460A00.A --- => C460A01.A --- --- --- CHANGE HISTORY: --- 09 May 95 SAIC Initial prerelease version. --- 24 Apr 96 SAIC Added code to avoid dead variable optimization. --- 13 Feb 97 PWB.CTA Removed 'Class from qual expression at line 342. ---! - -generic - type Designated_Type is tagged private; - type Operand_Type is access Designated_Type; -package C460A01_0 is - type Target_Type is access all Designated_Type; - function Convert (P : Operand_Type) return Target_Type; -end C460A01_0; - - - --==================================================================-- - - -package body C460A01_0 is - function Convert (P : Operand_Type) return Target_Type is - begin - return Target_Type(P); -- Never fails. - end Convert; -end C460A01_0; - - - --==================================================================-- - - -generic - type Designated_Type is tagged private; - type Operand_Type is access all Designated_Type; - type Target_Type is access all Designated_Type; -package C460A01_1 is - function Convert (P : Operand_Type) return Target_Type; -end C460A01_1; - - - --==================================================================-- - - -package body C460A01_1 is - function Convert (P : Operand_Type) return Target_Type is - begin - return Target_Type(P); - end Convert; -end C460A01_1; - - - --==================================================================-- - - -with F460A00; -generic - type Designated_Type (<>) is new F460A00.Tagged_Type with private; - type Operand_Type is access Designated_Type; -package C460A01_2 is - procedure Proc (P : Operand_Type; - Res : out F460A00.TC_Result_Kind); -end C460A01_2; - - - --==================================================================-- - -with Report; -package body C460A01_2 is - procedure Proc (P : Operand_Type; - Res : out F460A00.TC_Result_Kind) is - Ptr : F460A00.AccTag_L0; - begin - Ptr := F460A00.AccTag_L0(P); - - -- Avoid optimization (dead variable removal of Ptr): - if not Report.Equal (Ptr.C, Ptr.C) then -- Always false. - Report.Failed ("Unexpected error in C460A01_2 instance"); - end if; - - Res := F460A00.OK; - exception - when Program_Error => Res := F460A00.PE_Exception; - when others => Res := F460A00.Others_Exception; - end Proc; -end C460A01_2; - - - --==================================================================-- - - -with F460A00; -with C460A01_0; -with C460A01_1; -with C460A01_2; - -with Report; -procedure C460A01 is -begin -- C460A01. -- [ Level = 1 ] - - Report.Test ("C460A01", "Run-time accessibility checks: instance " & - "bodies. Operand type of access type conversion is " & - "passed as actual to instance"); - - - SUBTEST1: - declare -- [ Level = 2 ] - type AccTag_L2 is access all F460A00.Tagged_Type; - Operand: AccTag_L2 := new F460A00.Tagged_Type; - - Result : F460A00.TC_Result_Kind := F460A00.UN_Init; - begin -- SUBTEST1. - - declare -- [ Level = 3 ] - -- The instantiation of C460A01_0 should NOT result in any - -- exceptions. - - package Pack_OK is new C460A01_0 (F460A00.Tagged_Type, AccTag_L2); - Target : Pack_OK.Target_Type; - begin - -- The accessibility level of Pack_OK.Target_Type will always be at - -- least as deep as the operand type passed as an actual. Thus, - -- a call to Pack_OK.Convert does not propagate an exception: - - Target := Pack_OK.Convert(Operand); - - -- Avoid optimization (dead variable removal of Target): - if not Report.Equal (Target.C, Target.C) then -- Always false. - Report.Failed ("Unexpected error in SUBTEST #1"); - end if; - - Result := F460A00.OK; -- Expected result. - exception - when Program_Error => Result := F460A00.PE_Exception; - when others => Result := F460A00.Others_Exception; - end; - - F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #1"); - - exception - when Program_Error => - Report.Failed ("SUBTEST #1: Program_Error incorrectly raised"); - when others => - Report.Failed ("SUBTEST #1: Unexpected exception raised"); - end SUBTEST1; - - - - SUBTEST2: - declare -- [ Level = 2 ] - type AccTag_L2 is access all F460A00.Tagged_Type; - Operand : AccTag_L2 := new F460A00.Tagged_Type; - - Result : F460A00.TC_Result_Kind := F460A00.UN_Init; - begin -- SUBTEST2. - - declare -- [ Level = 3 ] - - type AccTag_L3 is access all F460A00.Tagged_Type; - Target : AccTag_L3; - - -- The instantiation of C460A01_1 should NOT result in any - -- exceptions. - - package Pack_OK is new C460A01_1 - (Designated_Type => F460A00.Tagged_Type, - Operand_Type => AccTag_L2, - Target_Type => AccTag_L3); - begin - -- The accessibility level of the actual passed as the operand type - -- in Pack_OK is 2. The accessibility level of the actual passed as - -- the target type is 3. Therefore, the access type conversion in - -- Pack_OK.Convert does not raise an exception when the subprogram is - -- called. If an exception is (incorrectly) raised, it is propagated - -- to the innermost enclosing master: - - Target := Pack_OK.Convert(Operand); - - -- Avoid optimization (dead variable removal of Target): - if not Report.Equal (Target.C, Target.C) then -- Always false. - Report.Failed ("Unexpected error in SUBTEST #2"); - end if; - - Result := F460A00.OK; -- Expected result. - exception - when Program_Error => Result := F460A00.PE_Exception; - when others => Result := F460A00.Others_Exception; - end; - - F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #2"); - - exception - when Program_Error => - Report.Failed ("SUBTEST #2: Program_Error incorrectly raised"); - when others => - Report.Failed ("SUBTEST #2: Unexpected exception raised"); - end SUBTEST2; - - - - SUBTEST3: - declare -- [ Level = 2 ] - type AccTag_L2 is access all F460A00.Tagged_Type; - Target : AccTag_L2; - - Result : F460A00.TC_Result_Kind := F460A00.UN_Init; - begin -- SUBTEST3. - - declare -- [ Level = 3 ] - - type AccTag_L3 is access all F460A00.Tagged_Type; - Operand : AccTag_L3 := new F460A00.Tagged_Type; - - -- The instantiation of C460A01_1 should NOT result in any - -- exceptions. - - package Pack_PE is new C460A01_1 - (Designated_Type => F460A00.Tagged_Type, - Operand_Type => AccTag_L3, - Target_Type => AccTag_L2); - begin - -- The accessibility level of the actual passed as the operand type - -- in Pack_PE is 3. The accessibility level of the actual passed as - -- the target type is 2. Therefore, the access type conversion in - -- Pack_PE.Convert raises Program_Error when the subprogram is - -- called. The exception is propagated to the innermost enclosing - -- master: - - Target := Pack_PE.Convert(Operand); - - -- Avoid optimization (dead variable removal of Target): - if not Report.Equal (Target.C, Target.C) then -- Always false. - Report.Failed ("Unexpected error in SUBTEST #3"); - end if; - - Result := F460A00.OK; - 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 #3"); - - exception - when Program_Error => - Report.Failed ("SUBTEST #3: Program_Error incorrectly raised"); - when others => - Report.Failed ("SUBTEST #3: Unexpected exception raised"); - end SUBTEST3; - - - - SUBTEST4: - declare -- [ Level = 2 ] - Result : F460A00.TC_Result_Kind := F460A00.UN_Init; - begin -- SUBTEST4. - - declare -- [ Level = 3 ] - - TType : F460A00.Tagged_Type; - Operand : F460A00.AccTagClass_L0 - := new F460A00.Tagged_Type'(TType); - - -- The instantiation of C460A01_2 should NOT result in any - -- exceptions. - - package Pack_OK is new C460A01_2 (F460A00.Tagged_Type'Class, - F460A00.AccTagClass_L0); - begin - -- The accessibility level of the actual passed as the operand type - -- in Pack_OK is 0. The accessibility level of the target type - -- (F460A00.AccTag_L0) is also 0. Therefore, the access type - -- conversion in Pack_OK.Proc does not raise an exception when the - -- subprogram is called. If an exception is (incorrectly) raised, - -- it is handled within the subprogram: - - Pack_OK.Proc(Operand, Result); - end; - - F460A00.TC_Check_Results (Result, F460A00.OK, "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 ] - - type AccDerTag_L3 is access all F460A00.Derived_Tagged_Type; - Operand : AccDerTag_L3 := new F460A00.Derived_Tagged_Type; - - -- The instantiation of C460A01_2 should NOT result in any - -- exceptions. - - package Pack_PE is new C460A01_2 (F460A00.Derived_Tagged_Type, - AccDerTag_L3); - begin - -- The accessibility level of the actual passed as the operand type - -- in Pack_PE is 3. The accessibility level of the target type - -- (F460A00.AccTag_L0) is 0. Therefore, the access type conversion - -- in Pack_PE.Proc raises Program_Error when the subprogram is - -- called. The exception is handled within the subprogram: - - Pack_PE.Proc(Operand, Result); - end; - - F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "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; - - Report.Result; - -end C460A01; |