| -- 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; |
