-- CDE0001.A
|
-- CDE0001.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- 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
|
-- 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 in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- 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
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- Check that the following names can be used in the declaration of a
|
-- Check that the following names can be used in the declaration of a
|
-- generic formal parameter (object, array type, or access type) without
|
-- generic formal parameter (object, array type, or access type) without
|
-- causing freezing of the named type:
|
-- causing freezing of the named type:
|
-- (1) The name of a private type,
|
-- (1) The name of a private type,
|
-- (2) A name that denotes a subtype of a private type, and
|
-- (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
|
-- (3) A name that denotes a composite type with a subcomponent of a
|
-- private type (or subtype).
|
-- private type (or subtype).
|
-- Check for untagged and tagged types.
|
-- Check for untagged and tagged types.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- This transition test defines private and limited private types,
|
-- This transition test defines private and limited private types,
|
-- subtypes of these private types, records and arrays of both types and
|
-- subtypes of these private types, records and arrays of both types and
|
-- subtypes, a tagged type and a private extension.
|
-- subtypes, a tagged type and a private extension.
|
-- This test creates examples where the above types are used in the
|
-- This test creates examples where the above types are used in the
|
-- definition of several generic formal type parameters (object, array
|
-- definition of several generic formal type parameters (object, array
|
-- type, or access type) in both visible and private parts. These
|
-- type, or access type) in both visible and private parts. These
|
-- visible and private generic packages are instantiated in the body of
|
-- visible and private generic packages are instantiated in the body of
|
-- the public child and the private child, respectively.
|
-- the public child and the private child, respectively.
|
-- The main program utilizes the functions declared in the public child
|
-- The main program utilizes the functions declared in the public child
|
-- to verify results of the instantiations.
|
-- to verify results of the instantiations.
|
--
|
--
|
-- Inspired by B74103F.ADA.
|
-- Inspired by B74103F.ADA.
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 12 Mar 96 SAIC Initial version for ACVC 2.1.
|
-- 12 Mar 96 SAIC Initial version for ACVC 2.1.
|
-- 05 Oct 96 SAIC ACVC 2.1: Added pragma Elaborate for CDE0001.
|
-- 05 Oct 96 SAIC ACVC 2.1: Added pragma Elaborate for CDE0001.
|
-- 21 Nov 98 RLB Added pragma Elaborate for CDE0001 to CDE0001_3.
|
-- 21 Nov 98 RLB Added pragma Elaborate for CDE0001 to CDE0001_3.
|
--!
|
--!
|
|
|
package CDE0001_0 is
|
package CDE0001_0 is
|
|
|
subtype Small_Int is Integer range 1 .. 2;
|
subtype Small_Int is Integer range 1 .. 2;
|
|
|
type Private_Type is private;
|
type Private_Type is private;
|
type Limited_Private is limited private;
|
type Limited_Private is limited private;
|
|
|
subtype Private_Subtype is Private_Type;
|
subtype Private_Subtype is Private_Type;
|
subtype Limited_Private_Subtype is Limited_Private;
|
subtype Limited_Private_Subtype is Limited_Private;
|
|
|
type Array_Of_LP_Subtype is array (1..2) of Limited_Private_Subtype;
|
type Array_Of_LP_Subtype is array (1..2) of Limited_Private_Subtype;
|
|
|
type Rec_Of_Limited_Private is
|
type Rec_Of_Limited_Private is
|
record
|
record
|
C1 : Limited_Private;
|
C1 : Limited_Private;
|
end record;
|
end record;
|
|
|
type Rec_Of_Private_SubType is
|
type Rec_Of_Private_SubType is
|
record
|
record
|
C1 : Private_SubType;
|
C1 : Private_SubType;
|
end record;
|
end record;
|
|
|
type Tag_Type is tagged
|
type Tag_Type is tagged
|
record
|
record
|
C1 : Small_Int;
|
C1 : Small_Int;
|
end record;
|
end record;
|
|
|
type New_TagType is new Tag_Type with private;
|
type New_TagType is new Tag_Type with private;
|
|
|
generic
|
generic
|
|
|
Formal_Obj01 : in out Private_Type; -- Formal objects defined
|
Formal_Obj01 : in out Private_Type; -- Formal objects defined
|
Formal_Obj02 : in out Limited_Private; -- by names of private
|
Formal_Obj02 : in out Limited_Private; -- by names of private
|
Formal_Obj03 : in out Private_Subtype; -- types, names that
|
Formal_Obj03 : in out Private_Subtype; -- types, names that
|
Formal_Obj04 : in out Limited_Private_Subtype; -- denotes subtypes of
|
Formal_Obj04 : in out Limited_Private_Subtype; -- denotes subtypes of
|
Formal_Obj05 : in out New_TagType; -- the private types.
|
Formal_Obj05 : in out New_TagType; -- the private types.
|
|
|
package CDE0001_1 is
|
package CDE0001_1 is
|
procedure Assign_Objects;
|
procedure Assign_Objects;
|
|
|
end CDE0001_1;
|
end CDE0001_1;
|
|
|
private
|
private
|
|
|
generic
|
generic
|
-- Formal array types of a private type, a composite type with a
|
-- Formal array types of a private type, a composite type with a
|
-- subcomponent of a private type.
|
-- subcomponent of a private type.
|
|
|
type Formal_Arr01 is array (Small_Int) of Private_Type;
|
type Formal_Arr01 is array (Small_Int) of Private_Type;
|
type Formal_Arr02 is array (Small_Int) of Rec_Of_Limited_Private;
|
type Formal_Arr02 is array (Small_Int) of Rec_Of_Limited_Private;
|
|
|
-- Formal access types of composite types with a subcomponent of
|
-- Formal access types of composite types with a subcomponent of
|
-- a private subtype.
|
-- a private subtype.
|
|
|
type Formal_Acc01 is access Rec_Of_Private_Subtype;
|
type Formal_Acc01 is access Rec_Of_Private_Subtype;
|
type Formal_Acc02 is access Array_Of_LP_Subtype;
|
type Formal_Acc02 is access Array_Of_LP_Subtype;
|
|
|
package CDE0001_2 is
|
package CDE0001_2 is
|
|
|
procedure Assign_Arrays (P1 : out Formal_Arr01;
|
procedure Assign_Arrays (P1 : out Formal_Arr01;
|
P2 : out Formal_Arr02);
|
P2 : out Formal_Arr02);
|
|
|
procedure Assign_Access (P1 : out Formal_Acc01;
|
procedure Assign_Access (P1 : out Formal_Acc01;
|
P2 : out Formal_Acc02);
|
P2 : out Formal_Acc02);
|
|
|
end CDE0001_2;
|
end CDE0001_2;
|
|
|
----------------------------------------------------------
|
----------------------------------------------------------
|
type Private_Type is range 1 .. 10;
|
type Private_Type is range 1 .. 10;
|
type Limited_Private is (Eh, Bee, Sea, Dee);
|
type Limited_Private is (Eh, Bee, Sea, Dee);
|
type New_TagType is new Tag_Type with
|
type New_TagType is new Tag_Type with
|
record
|
record
|
C2 : Private_Type;
|
C2 : Private_Type;
|
end record;
|
end record;
|
|
|
end CDE0001_0;
|
end CDE0001_0;
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
package body CDE0001_0 is
|
package body CDE0001_0 is
|
|
|
package body CDE0001_1 is
|
package body CDE0001_1 is
|
|
|
procedure Assign_Objects is
|
procedure Assign_Objects is
|
begin
|
begin
|
Formal_Obj01 := Private_Type'First;
|
Formal_Obj01 := Private_Type'First;
|
Formal_Obj02 := Limited_Private'Last;
|
Formal_Obj02 := Limited_Private'Last;
|
Formal_Obj03 := Private_Subtype'Last;
|
Formal_Obj03 := Private_Subtype'Last;
|
Formal_Obj04 := Limited_Private_Subtype'First;
|
Formal_Obj04 := Limited_Private_Subtype'First;
|
Formal_Obj05 := New_TagType'(C1 => 2, C2 => Private_Type'Last);
|
Formal_Obj05 := New_TagType'(C1 => 2, C2 => Private_Type'Last);
|
|
|
end Assign_Objects;
|
end Assign_Objects;
|
|
|
end CDE0001_1;
|
end CDE0001_1;
|
|
|
--===========================================================--
|
--===========================================================--
|
|
|
package body CDE0001_2 is
|
package body CDE0001_2 is
|
|
|
procedure Assign_Arrays (P1 : out Formal_Arr01;
|
procedure Assign_Arrays (P1 : out Formal_Arr01;
|
P2 : out Formal_Arr02) is
|
P2 : out Formal_Arr02) is
|
begin
|
begin
|
P1(1) := Private_Type'Pred(Private_Type'Last);
|
P1(1) := Private_Type'Pred(Private_Type'Last);
|
P1(2) := Private_Type'Succ(Private_Type'First);
|
P1(2) := Private_Type'Succ(Private_Type'First);
|
P2(1).C1 := Limited_Private'Succ(Limited_Private'First);
|
P2(1).C1 := Limited_Private'Succ(Limited_Private'First);
|
P2(2).C1 := Limited_Private'Pred(Limited_Private'Last);
|
P2(2).C1 := Limited_Private'Pred(Limited_Private'Last);
|
|
|
end Assign_Arrays;
|
end Assign_Arrays;
|
|
|
-----------------------------------------------------------------
|
-----------------------------------------------------------------
|
procedure Assign_Access (P1 : out Formal_Acc01;
|
procedure Assign_Access (P1 : out Formal_Acc01;
|
P2 : out Formal_Acc02) is
|
P2 : out Formal_Acc02) is
|
begin
|
begin
|
P1 := new Rec_Of_Private_Subtype'(C1 => Private_Subtype'Last);
|
P1 := new Rec_Of_Private_Subtype'(C1 => Private_Subtype'Last);
|
P2 := new Array_Of_LP_Subtype'(Eh, Dee);
|
P2 := new Array_Of_LP_Subtype'(Eh, Dee);
|
|
|
end Assign_Access;
|
end Assign_Access;
|
|
|
end CDE0001_2;
|
end CDE0001_2;
|
|
|
end CDE0001_0;
|
end CDE0001_0;
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
-- The following private child package instantiates its parent private generic
|
-- The following private child package instantiates its parent private generic
|
-- package.
|
-- package.
|
|
|
with CDE0001_0;
|
with CDE0001_0;
|
pragma Elaborate (CDE0001_0); -- So generic unit can be instantiated.
|
pragma Elaborate (CDE0001_0); -- So generic unit can be instantiated.
|
private
|
private
|
package CDE0001_0.CDE0001_3 is
|
package CDE0001_0.CDE0001_3 is
|
|
|
type Arr01 is array (Small_Int) of Private_Type;
|
type Arr01 is array (Small_Int) of Private_Type;
|
type Arr02 is array (Small_Int) of Rec_Of_Limited_Private;
|
type Arr02 is array (Small_Int) of Rec_Of_Limited_Private;
|
type Acc01 is access Rec_Of_Private_Subtype;
|
type Acc01 is access Rec_Of_Private_Subtype;
|
type Acc02 is access Array_Of_LP_Subtype;
|
type Acc02 is access Array_Of_LP_Subtype;
|
|
|
package Formal_Types_Pck is new CDE0001_2 (Arr01, Arr02, Acc01, Acc02);
|
package Formal_Types_Pck is new CDE0001_2 (Arr01, Arr02, Acc01, Acc02);
|
|
|
Arr01_Obj : Arr01;
|
Arr01_Obj : Arr01;
|
Arr02_Obj : Arr02;
|
Arr02_Obj : Arr02;
|
Acc01_Obj : Acc01;
|
Acc01_Obj : Acc01;
|
Acc02_Obj : Acc02;
|
Acc02_Obj : Acc02;
|
|
|
end CDE0001_0.CDE0001_3;
|
end CDE0001_0.CDE0001_3;
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
package CDE0001_0.CDE0001_4 is
|
package CDE0001_0.CDE0001_4 is
|
|
|
-- The following functions check the private types defined in the parent
|
-- The following functions check the private types defined in the parent
|
-- and the private child package from within the client program.
|
-- and the private child package from within the client program.
|
|
|
function Verify_Objects return Boolean;
|
function Verify_Objects return Boolean;
|
|
|
function Verify_Arrays return Boolean;
|
function Verify_Arrays return Boolean;
|
|
|
function Verify_Access return Boolean;
|
function Verify_Access return Boolean;
|
|
|
end CDE0001_0.CDE0001_4;
|
end CDE0001_0.CDE0001_4;
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
with CDE0001_0.CDE0001_3; -- private sibling.
|
with CDE0001_0.CDE0001_3; -- private sibling.
|
|
|
pragma Elaborate (CDE0001_0.CDE0001_3);
|
pragma Elaborate (CDE0001_0.CDE0001_3);
|
|
|
package body CDE0001_0.CDE0001_4 is
|
package body CDE0001_0.CDE0001_4 is
|
|
|
Obj1 : Private_Type := 2;
|
Obj1 : Private_Type := 2;
|
Obj2 : Limited_Private := Bee;
|
Obj2 : Limited_Private := Bee;
|
Obj3 : Private_Subtype := 3;
|
Obj3 : Private_Subtype := 3;
|
Obj4 : Limited_Private_Subtype := Sea;
|
Obj4 : Limited_Private_Subtype := Sea;
|
Obj5 : New_TagType := (1, 5);
|
Obj5 : New_TagType := (1, 5);
|
|
|
-- Instantiate the generic package declared in the visible part of
|
-- Instantiate the generic package declared in the visible part of
|
-- the parent.
|
-- the parent.
|
|
|
package Formal_Obj_Pck is new CDE0001_1 (Obj1, Obj2, Obj3, Obj4, Obj5);
|
package Formal_Obj_Pck is new CDE0001_1 (Obj1, Obj2, Obj3, Obj4, Obj5);
|
|
|
---------------------------------------------------
|
---------------------------------------------------
|
function Verify_Objects return Boolean is
|
function Verify_Objects return Boolean is
|
Result : Boolean := False;
|
Result : Boolean := False;
|
begin
|
begin
|
if Obj1 = 1 and
|
if Obj1 = 1 and
|
Obj2 = Dee and
|
Obj2 = Dee and
|
Obj3 = 10 and
|
Obj3 = 10 and
|
Obj4 = Eh and
|
Obj4 = Eh and
|
Obj5.C1 = 2 and
|
Obj5.C1 = 2 and
|
Obj5.C2 = 10 then
|
Obj5.C2 = 10 then
|
Result := True;
|
Result := True;
|
end if;
|
end if;
|
|
|
return Result;
|
return Result;
|
|
|
end Verify_Objects;
|
end Verify_Objects;
|
|
|
---------------------------------------------------
|
---------------------------------------------------
|
function Verify_Arrays return Boolean is
|
function Verify_Arrays return Boolean is
|
Result : Boolean := False;
|
Result : Boolean := False;
|
begin
|
begin
|
if CDE0001_0.CDE0001_3.Arr01_Obj(1) = 9 and
|
if CDE0001_0.CDE0001_3.Arr01_Obj(1) = 9 and
|
CDE0001_0.CDE0001_3.Arr01_Obj(2) = 2 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(1).C1 = Bee and
|
CDE0001_0.CDE0001_3.Arr02_Obj(2).C1 = Sea then
|
CDE0001_0.CDE0001_3.Arr02_Obj(2).C1 = Sea then
|
Result := True;
|
Result := True;
|
end if;
|
end if;
|
|
|
return Result;
|
return Result;
|
|
|
end Verify_Arrays;
|
end Verify_Arrays;
|
|
|
---------------------------------------------------
|
---------------------------------------------------
|
function Verify_Access return Boolean is
|
function Verify_Access return Boolean is
|
Result : Boolean := False;
|
Result : Boolean := False;
|
begin
|
begin
|
if CDE0001_0.CDE0001_3.Acc01_Obj.C1 = 10 and
|
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(1) = Eh and
|
CDE0001_0.CDE0001_3.Acc02_Obj(2) = Dee then
|
CDE0001_0.CDE0001_3.Acc02_Obj(2) = Dee then
|
Result := True;
|
Result := True;
|
end if;
|
end if;
|
|
|
return Result;
|
return Result;
|
|
|
end Verify_Access;
|
end Verify_Access;
|
|
|
begin
|
begin
|
|
|
Formal_Obj_Pck.Assign_Objects;
|
Formal_Obj_Pck.Assign_Objects;
|
|
|
CDE0001_0.CDE0001_3.Formal_Types_Pck.Assign_Arrays
|
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.Arr01_Obj, CDE0001_0.CDE0001_3.Arr02_Obj);
|
CDE0001_0.CDE0001_3.Formal_Types_Pck.Assign_Access
|
CDE0001_0.CDE0001_3.Formal_Types_Pck.Assign_Access
|
(CDE0001_0.CDE0001_3.Acc01_Obj, CDE0001_0.CDE0001_3.Acc02_Obj);
|
(CDE0001_0.CDE0001_3.Acc01_Obj, CDE0001_0.CDE0001_3.Acc02_Obj);
|
|
|
end CDE0001_0.CDE0001_4;
|
end CDE0001_0.CDE0001_4;
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
with Report;
|
with Report;
|
with CDE0001_0.CDE0001_4;
|
with CDE0001_0.CDE0001_4;
|
|
|
procedure CDE0001 is
|
procedure CDE0001 is
|
|
|
begin
|
begin
|
|
|
Report.Test ("CDE0001", "Check that the name of the private type, a " &
|
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 subtype of the private type, or a " &
|
"name that denotes a composite type with a subcomponent " &
|
"name that denotes a composite type with a subcomponent " &
|
"of a private type can be used in the declaration of a " &
|
"of a private type can be used in the declaration of a " &
|
"generic formal type parameter without causing freezing " &
|
"generic formal type parameter without causing freezing " &
|
"of the named type");
|
"of the named type");
|
|
|
if not CDE0001_0.CDE0001_4.Verify_Objects then
|
if not CDE0001_0.CDE0001_4.Verify_Objects then
|
Report.Failed ("Wrong values for formal objects");
|
Report.Failed ("Wrong values for formal objects");
|
end if;
|
end if;
|
|
|
if not CDE0001_0.CDE0001_4.Verify_Arrays then
|
if not CDE0001_0.CDE0001_4.Verify_Arrays then
|
Report.Failed ("Wrong values for formal array types");
|
Report.Failed ("Wrong values for formal array types");
|
end if;
|
end if;
|
|
|
if not CDE0001_0.CDE0001_4.Verify_Access then
|
if not CDE0001_0.CDE0001_4.Verify_Access then
|
Report.Failed ("Wrong values for formal access types");
|
Report.Failed ("Wrong values for formal access types");
|
end if;
|
end if;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end CDE0001;
|
end CDE0001;
|
|
|
