diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cd/cde0001.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cd/cde0001.a | 324 |
1 files changed, 0 insertions, 324 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cd/cde0001.a b/gcc/testsuite/ada/acats/tests/cd/cde0001.a deleted file mode 100644 index 59db2256f6f..00000000000 --- a/gcc/testsuite/ada/acats/tests/cd/cde0001.a +++ /dev/null @@ -1,324 +0,0 @@ --- CDE0001.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 the following names can be used in the declaration of a --- generic formal parameter (object, array type, or access type) without --- causing freezing of the named type: --- (1) The name of a private type, --- (2) A name that denotes a subtype of a private type, and --- (3) A name that denotes a composite type with a subcomponent of a --- private type (or subtype). --- Check for untagged and tagged types. --- --- TEST DESCRIPTION: --- This transition test defines private and limited private types, --- subtypes of these private types, records and arrays of both types and --- subtypes, a tagged type and a private extension. --- This test creates examples where the above types are used in the --- definition of several generic formal type parameters (object, array --- type, or access type) in both visible and private parts. These --- visible and private generic packages are instantiated in the body of --- the public child and the private child, respectively. --- The main program utilizes the functions declared in the public child --- to verify results of the instantiations. --- --- Inspired by B74103F.ADA. --- --- --- CHANGE HISTORY: --- 12 Mar 96 SAIC Initial version for ACVC 2.1. --- 05 Oct 96 SAIC ACVC 2.1: Added pragma Elaborate for CDE0001. --- 21 Nov 98 RLB Added pragma Elaborate for CDE0001 to CDE0001_3. ---! - -package CDE0001_0 is - - subtype Small_Int is Integer range 1 .. 2; - - type Private_Type is private; - type Limited_Private is limited private; - - subtype Private_Subtype is Private_Type; - subtype Limited_Private_Subtype is Limited_Private; - - type Array_Of_LP_Subtype is array (1..2) of Limited_Private_Subtype; - - type Rec_Of_Limited_Private is - record - C1 : Limited_Private; - end record; - - type Rec_Of_Private_SubType is - record - C1 : Private_SubType; - end record; - - type Tag_Type is tagged - record - C1 : Small_Int; - end record; - - type New_TagType is new Tag_Type with private; - - generic - - Formal_Obj01 : in out Private_Type; -- Formal objects defined - Formal_Obj02 : in out Limited_Private; -- by names of private - Formal_Obj03 : in out Private_Subtype; -- types, names that - Formal_Obj04 : in out Limited_Private_Subtype; -- denotes subtypes of - Formal_Obj05 : in out New_TagType; -- the private types. - - package CDE0001_1 is - procedure Assign_Objects; - - end CDE0001_1; - -private - - generic - -- Formal array types of a private type, a composite type with a - -- subcomponent of a private type. - - type Formal_Arr01 is array (Small_Int) of Private_Type; - type Formal_Arr02 is array (Small_Int) of Rec_Of_Limited_Private; - - -- Formal access types of composite types with a subcomponent of - -- a private subtype. - - type Formal_Acc01 is access Rec_Of_Private_Subtype; - type Formal_Acc02 is access Array_Of_LP_Subtype; - - package CDE0001_2 is - - procedure Assign_Arrays (P1 : out Formal_Arr01; - P2 : out Formal_Arr02); - - procedure Assign_Access (P1 : out Formal_Acc01; - P2 : out Formal_Acc02); - - end CDE0001_2; - - ---------------------------------------------------------- - type Private_Type is range 1 .. 10; - type Limited_Private is (Eh, Bee, Sea, Dee); - type New_TagType is new Tag_Type with - record - C2 : Private_Type; - end record; - -end CDE0001_0; - - --==================================================================-- - -package body CDE0001_0 is - - package body CDE0001_1 is - - procedure Assign_Objects is - begin - Formal_Obj01 := Private_Type'First; - Formal_Obj02 := Limited_Private'Last; - Formal_Obj03 := Private_Subtype'Last; - Formal_Obj04 := Limited_Private_Subtype'First; - Formal_Obj05 := New_TagType'(C1 => 2, C2 => Private_Type'Last); - - end Assign_Objects; - - end CDE0001_1; - - --===========================================================-- - - package body CDE0001_2 is - - procedure Assign_Arrays (P1 : out Formal_Arr01; - P2 : out Formal_Arr02) is - begin - P1(1) := Private_Type'Pred(Private_Type'Last); - P1(2) := Private_Type'Succ(Private_Type'First); - P2(1).C1 := Limited_Private'Succ(Limited_Private'First); - P2(2).C1 := Limited_Private'Pred(Limited_Private'Last); - - end Assign_Arrays; - - ----------------------------------------------------------------- - procedure Assign_Access (P1 : out Formal_Acc01; - P2 : out Formal_Acc02) is - begin - P1 := new Rec_Of_Private_Subtype'(C1 => Private_Subtype'Last); - P2 := new Array_Of_LP_Subtype'(Eh, Dee); - - end Assign_Access; - - end CDE0001_2; - -end CDE0001_0; - - --==================================================================-- - --- The following private child package instantiates its parent private generic --- package. - -with CDE0001_0; -pragma Elaborate (CDE0001_0); -- So generic unit can be instantiated. -private -package CDE0001_0.CDE0001_3 is - - type Arr01 is array (Small_Int) of Private_Type; - type Arr02 is array (Small_Int) of Rec_Of_Limited_Private; - type Acc01 is access Rec_Of_Private_Subtype; - type Acc02 is access Array_Of_LP_Subtype; - - package Formal_Types_Pck is new CDE0001_2 (Arr01, Arr02, Acc01, Acc02); - - Arr01_Obj : Arr01; - Arr02_Obj : Arr02; - Acc01_Obj : Acc01; - Acc02_Obj : Acc02; - -end CDE0001_0.CDE0001_3; - - --==================================================================-- - -package CDE0001_0.CDE0001_4 is - - -- The following functions check the private types defined in the parent - -- and the private child package from within the client program. - - function Verify_Objects return Boolean; - - function Verify_Arrays return Boolean; - - function Verify_Access return Boolean; - -end CDE0001_0.CDE0001_4; - - --==================================================================-- - -with CDE0001_0.CDE0001_3; -- private sibling. - -pragma Elaborate (CDE0001_0.CDE0001_3); - -package body CDE0001_0.CDE0001_4 is - - Obj1 : Private_Type := 2; - Obj2 : Limited_Private := Bee; - Obj3 : Private_Subtype := 3; - Obj4 : Limited_Private_Subtype := Sea; - Obj5 : New_TagType := (1, 5); - - -- Instantiate the generic package declared in the visible part of - -- the parent. - - package Formal_Obj_Pck is new CDE0001_1 (Obj1, Obj2, Obj3, Obj4, Obj5); - - --------------------------------------------------- - function Verify_Objects return Boolean is - Result : Boolean := False; - begin - if Obj1 = 1 and - Obj2 = Dee and - Obj3 = 10 and - Obj4 = Eh and - Obj5.C1 = 2 and - Obj5.C2 = 10 then - Result := True; - end if; - - return Result; - - end Verify_Objects; - - --------------------------------------------------- - function Verify_Arrays return Boolean is - Result : Boolean := False; - begin - if CDE0001_0.CDE0001_3.Arr01_Obj(1) = 9 and - CDE0001_0.CDE0001_3.Arr01_Obj(2) = 2 and - CDE0001_0.CDE0001_3.Arr02_Obj(1).C1 = Bee and - CDE0001_0.CDE0001_3.Arr02_Obj(2).C1 = Sea then - Result := True; - end if; - - return Result; - - end Verify_Arrays; - - --------------------------------------------------- - function Verify_Access return Boolean is - Result : Boolean := False; - begin - if CDE0001_0.CDE0001_3.Acc01_Obj.C1 = 10 and - CDE0001_0.CDE0001_3.Acc02_Obj(1) = Eh and - CDE0001_0.CDE0001_3.Acc02_Obj(2) = Dee then - Result := True; - end if; - - return Result; - - end Verify_Access; - -begin - - Formal_Obj_Pck.Assign_Objects; - - CDE0001_0.CDE0001_3.Formal_Types_Pck.Assign_Arrays - (CDE0001_0.CDE0001_3.Arr01_Obj, CDE0001_0.CDE0001_3.Arr02_Obj); - CDE0001_0.CDE0001_3.Formal_Types_Pck.Assign_Access - (CDE0001_0.CDE0001_3.Acc01_Obj, CDE0001_0.CDE0001_3.Acc02_Obj); - -end CDE0001_0.CDE0001_4; - - --==================================================================-- - -with Report; -with CDE0001_0.CDE0001_4; - -procedure CDE0001 is - -begin - - Report.Test ("CDE0001", "Check that the name of the private type, a " & - "name that denotes a subtype of the private type, or a " & - "name that denotes a composite type with a subcomponent " & - "of a private type can be used in the declaration of a " & - "generic formal type parameter without causing freezing " & - "of the named type"); - - if not CDE0001_0.CDE0001_4.Verify_Objects then - Report.Failed ("Wrong values for formal objects"); - end if; - - if not CDE0001_0.CDE0001_4.Verify_Arrays then - Report.Failed ("Wrong values for formal array types"); - end if; - - if not CDE0001_0.CDE0001_4.Verify_Access then - Report.Failed ("Wrong values for formal access types"); - end if; - - Report.Result; - -end CDE0001; |