diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cde0001.a')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cde0001.a | 324 |
1 files changed, 324 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cde0001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cde0001.a new file mode 100644 index 000000000..59db2256f --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cde0001.a @@ -0,0 +1,324 @@ +-- 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; |