-- C3A1002.A
|
-- C3A1002.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 full type completing a type with no discriminant part
|
-- Check that the full type completing a type with no discriminant part
|
-- or an unknown discriminant part may have explicitly declared or
|
-- or an unknown discriminant part may have explicitly declared or
|
-- inherited discriminants.
|
-- inherited discriminants.
|
-- Check for cases where the types are tagged records and task types.
|
-- Check for cases where the types are tagged records and task types.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- Declare two groups of incomplete types: one group with no discriminant
|
-- Declare two groups of incomplete types: one group with no discriminant
|
-- part and one group with unknown discriminant part. Both groups of
|
-- part and one group with unknown discriminant part. Both groups of
|
-- incomplete types are completed with both explicit and inherited
|
-- incomplete types are completed with both explicit and inherited
|
-- discriminants. Discriminants for task types are declared with both
|
-- discriminants. Discriminants for task types are declared with both
|
-- default and non default values. Discriminants for tagged types are
|
-- default and non default values. Discriminants for tagged types are
|
-- only declared without default values.
|
-- only declared without default values.
|
-- In the main program, verify that objects of both groups of incomplete
|
-- In the main program, verify that objects of both groups of incomplete
|
-- types can be created by default values or by assignments.
|
-- types can be created by default values or by assignments.
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 23 Oct 95 SAIC Initial prerelease version.
|
-- 23 Oct 95 SAIC Initial prerelease version.
|
-- 19 Oct 96 SAIC ACVC 2.1: modified test description. Initialized
|
-- 19 Oct 96 SAIC ACVC 2.1: modified test description. Initialized
|
-- Int_Val.
|
-- Int_Val.
|
--
|
--
|
--!
|
--!
|
|
|
package C3A1002_0 is
|
package C3A1002_0 is
|
|
|
subtype Small_Int is Integer range 1 .. 15;
|
subtype Small_Int is Integer range 1 .. 15;
|
|
|
type Enu_Type is (M, F);
|
type Enu_Type is (M, F);
|
|
|
type Tag_Type is tagged
|
type Tag_Type is tagged
|
record
|
record
|
I : Small_Int := 1;
|
I : Small_Int := 1;
|
end record;
|
end record;
|
|
|
type NTag_Type (D : Small_Int) is new Tag_Type with
|
type NTag_Type (D : Small_Int) is new Tag_Type with
|
record
|
record
|
S : String (1 .. D) := "Aloha";
|
S : String (1 .. D) := "Aloha";
|
end record;
|
end record;
|
|
|
type Incomplete1; -- no discriminant
|
type Incomplete1; -- no discriminant
|
|
|
type Incomplete2 (<>); -- unknown discriminant
|
type Incomplete2 (<>); -- unknown discriminant
|
|
|
type Incomplete3; -- no discriminant
|
type Incomplete3; -- no discriminant
|
|
|
type Incomplete4 (<>); -- unknown discriminant
|
type Incomplete4 (<>); -- unknown discriminant
|
|
|
type Incomplete5; -- no discriminant
|
type Incomplete5; -- no discriminant
|
|
|
type Incomplete6 (<>); -- unknown discriminant
|
type Incomplete6 (<>); -- unknown discriminant
|
|
|
type Incomplete1 (D1 : Enu_Type) is tagged -- no discriminant/
|
type Incomplete1 (D1 : Enu_Type) is tagged -- no discriminant/
|
record -- explicit discriminant
|
record -- explicit discriminant
|
case D1 is
|
case D1 is
|
when M => MInteger : Small_Int := 9;
|
when M => MInteger : Small_Int := 9;
|
when F => FInteger : Small_Int := 8;
|
when F => FInteger : Small_Int := 8;
|
end case;
|
end case;
|
end record;
|
end record;
|
|
|
type Incomplete2 (D2 : Small_Int) is new -- unknown discriminant/
|
type Incomplete2 (D2 : Small_Int) is new -- unknown discriminant/
|
Incomplete1 (D1 => F) with record -- explicit discriminant
|
Incomplete1 (D1 => F) with record -- explicit discriminant
|
ID : String (1 .. D2) := "ACVC95";
|
ID : String (1 .. D2) := "ACVC95";
|
end record;
|
end record;
|
|
|
type Incomplete3 is new -- no discriminant/
|
type Incomplete3 is new -- no discriminant/
|
NTag_Type with record -- inherited discriminant
|
NTag_Type with record -- inherited discriminant
|
E : Enu_Type := M;
|
E : Enu_Type := M;
|
end record;
|
end record;
|
|
|
type Incomplete4 is new -- unknown discriminant/
|
type Incomplete4 is new -- unknown discriminant/
|
NTag_Type (D => 3) with record -- inherited discriminant
|
NTag_Type (D => 3) with record -- inherited discriminant
|
E : Enu_Type := F;
|
E : Enu_Type := F;
|
end record;
|
end record;
|
|
|
task type Incomplete5 (D5 : Enu_Type) is -- no discriminant/
|
task type Incomplete5 (D5 : Enu_Type) is -- no discriminant/
|
entry Read_Disc (P : out Enu_Type); -- explicit discriminant
|
entry Read_Disc (P : out Enu_Type); -- explicit discriminant
|
end Incomplete5;
|
end Incomplete5;
|
|
|
task type Incomplete6
|
task type Incomplete6
|
(D6 : Small_Int := 4) is -- unknown discriminant/
|
(D6 : Small_Int := 4) is -- unknown discriminant/
|
entry Read_Int (P : out Small_Int); -- explicit discriminant
|
entry Read_Int (P : out Small_Int); -- explicit discriminant
|
end Incomplete6;
|
end Incomplete6;
|
|
|
end C3A1002_0;
|
end C3A1002_0;
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
package body C3A1002_0 is
|
package body C3A1002_0 is
|
|
|
task body Incomplete5 is
|
task body Incomplete5 is
|
begin
|
begin
|
select
|
select
|
accept Read_Disc (P : out Enu_Type) do
|
accept Read_Disc (P : out Enu_Type) do
|
P := D5;
|
P := D5;
|
end Read_Disc;
|
end Read_Disc;
|
or
|
or
|
terminate;
|
terminate;
|
end select;
|
end select;
|
|
|
end Incomplete5;
|
end Incomplete5;
|
|
|
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
task body Incomplete6 is
|
task body Incomplete6 is
|
begin
|
begin
|
select
|
select
|
accept Read_Int (P : out Small_Int) do
|
accept Read_Int (P : out Small_Int) do
|
P := D6;
|
P := D6;
|
end Read_Int;
|
end Read_Int;
|
or
|
or
|
terminate;
|
terminate;
|
end select;
|
end select;
|
|
|
end Incomplete6;
|
end Incomplete6;
|
|
|
end C3A1002_0;
|
end C3A1002_0;
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
with Report;
|
with Report;
|
|
|
with C3A1002_0;
|
with C3A1002_0;
|
use C3A1002_0;
|
use C3A1002_0;
|
|
|
procedure C3A1002 is
|
procedure C3A1002 is
|
|
|
Enum_Val : Enu_Type := M;
|
Enum_Val : Enu_Type := M;
|
|
|
Int_Val : Small_Int := 15;
|
Int_Val : Small_Int := 15;
|
|
|
-- Discriminant value comes from default.
|
-- Discriminant value comes from default.
|
|
|
Incomplete6_Obj_1 : Incomplete6;
|
Incomplete6_Obj_1 : Incomplete6;
|
|
|
-- Discriminant value comes from explicit constraint.
|
-- Discriminant value comes from explicit constraint.
|
|
|
Incomplete1_Obj_1 : Incomplete1 (M);
|
Incomplete1_Obj_1 : Incomplete1 (M);
|
|
|
Incomplete2_Obj_1 : Incomplete2 (6);
|
Incomplete2_Obj_1 : Incomplete2 (6);
|
|
|
Incomplete5_Obj_1 : Incomplete5 (F);
|
Incomplete5_Obj_1 : Incomplete5 (F);
|
|
|
Incomplete6_Obj_2 : Incomplete6 (7);
|
Incomplete6_Obj_2 : Incomplete6 (7);
|
|
|
-- Discriminant value comes from assignment.
|
-- Discriminant value comes from assignment.
|
|
|
Incomplete1_Obj_2 : Incomplete1
|
Incomplete1_Obj_2 : Incomplete1
|
:= (F, 12);
|
:= (F, 12);
|
|
|
Incomplete3_Obj_1 : Incomplete3
|
Incomplete3_Obj_1 : Incomplete3
|
:= (D => 2, S => "Hi", I => 10, E => F);
|
:= (D => 2, S => "Hi", I => 10, E => F);
|
|
|
Incomplete4_Obj_1 : Incomplete4
|
Incomplete4_Obj_1 : Incomplete4
|
:= (E => M, D => 3, S => "Bye", I => 14);
|
:= (E => M, D => 3, S => "Bye", I => 14);
|
|
|
begin
|
begin
|
|
|
Report.Test ("C3A1002", "Check that the full type completing a type " &
|
Report.Test ("C3A1002", "Check that the full type completing a type " &
|
"with no discriminant part or an unknown discriminant " &
|
"with no discriminant part or an unknown discriminant " &
|
"part may have explicitly declared or inherited " &
|
"part may have explicitly declared or inherited " &
|
"discriminants. Check for cases where the types are " &
|
"discriminants. Check for cases where the types are " &
|
"tagged records and task types");
|
"tagged records and task types");
|
|
|
-- Check the initial values.
|
-- Check the initial values.
|
|
|
if (Incomplete6_Obj_1.D6 /= 4) then
|
if (Incomplete6_Obj_1.D6 /= 4) then
|
Report.Failed ("Wrong initial value for Incomplete6_Obj_1");
|
Report.Failed ("Wrong initial value for Incomplete6_Obj_1");
|
end if;
|
end if;
|
|
|
-- Check the explicit values.
|
-- Check the explicit values.
|
|
|
if (Incomplete1_Obj_1.D1 /= M) or
|
if (Incomplete1_Obj_1.D1 /= M) or
|
(Incomplete1_Obj_1.MInteger /= 9) then
|
(Incomplete1_Obj_1.MInteger /= 9) then
|
Report.Failed ("Wrong values for Incomplete1_Obj_1");
|
Report.Failed ("Wrong values for Incomplete1_Obj_1");
|
end if;
|
end if;
|
|
|
if (Incomplete2_Obj_1.D2 /= 6) or
|
if (Incomplete2_Obj_1.D2 /= 6) or
|
(Incomplete2_Obj_1.FInteger /= 8) or
|
(Incomplete2_Obj_1.FInteger /= 8) or
|
(Incomplete2_Obj_1.ID /= "ACVC95") then
|
(Incomplete2_Obj_1.ID /= "ACVC95") then
|
Report.Failed ("Wrong values for Incomplete2_Obj_1");
|
Report.Failed ("Wrong values for Incomplete2_Obj_1");
|
end if;
|
end if;
|
|
|
if (Incomplete5_Obj_1.D5 /= F) then
|
if (Incomplete5_Obj_1.D5 /= F) then
|
Report.Failed ("Wrong value for Incomplete5_Obj_1");
|
Report.Failed ("Wrong value for Incomplete5_Obj_1");
|
end if;
|
end if;
|
|
|
Incomplete5_Obj_1.Read_Disc (Enum_Val);
|
Incomplete5_Obj_1.Read_Disc (Enum_Val);
|
|
|
if (Enum_Val /= F) then
|
if (Enum_Val /= F) then
|
Report.Failed ("Wrong value for Enum_Val");
|
Report.Failed ("Wrong value for Enum_Val");
|
end if;
|
end if;
|
|
|
if (Incomplete6_Obj_2.D6 /= 7) then
|
if (Incomplete6_Obj_2.D6 /= 7) then
|
Report.Failed ("Wrong value for Incomplete6_Obj_2");
|
Report.Failed ("Wrong value for Incomplete6_Obj_2");
|
end if;
|
end if;
|
|
|
Incomplete6_Obj_1.Read_Int (Int_Val);
|
Incomplete6_Obj_1.Read_Int (Int_Val);
|
|
|
if (Int_Val /= 4) then
|
if (Int_Val /= 4) then
|
Report.Failed ("Wrong value for Int_Val");
|
Report.Failed ("Wrong value for Int_Val");
|
end if;
|
end if;
|
|
|
-- Check the assigned values.
|
-- Check the assigned values.
|
|
|
if (Incomplete1_Obj_2.D1 /= F) or
|
if (Incomplete1_Obj_2.D1 /= F) or
|
(Incomplete1_Obj_2.FInteger /= 12) then
|
(Incomplete1_Obj_2.FInteger /= 12) then
|
Report.Failed ("Wrong values for Incomplete1_Obj_2");
|
Report.Failed ("Wrong values for Incomplete1_Obj_2");
|
end if;
|
end if;
|
|
|
if (Incomplete3_Obj_1.D /= 2 ) or
|
if (Incomplete3_Obj_1.D /= 2 ) or
|
(Incomplete3_Obj_1.I /= 10) or
|
(Incomplete3_Obj_1.I /= 10) or
|
(Incomplete3_Obj_1.E /= F ) or
|
(Incomplete3_Obj_1.E /= F ) or
|
(Incomplete3_Obj_1.S /= "Hi") then
|
(Incomplete3_Obj_1.S /= "Hi") then
|
Report.Failed ("Wrong values for Incomplete3_Obj_1");
|
Report.Failed ("Wrong values for Incomplete3_Obj_1");
|
end if;
|
end if;
|
|
|
if (Incomplete4_Obj_1.E /= M ) or
|
if (Incomplete4_Obj_1.E /= M ) or
|
(Incomplete4_Obj_1.D /= 3) or
|
(Incomplete4_Obj_1.D /= 3) or
|
(Incomplete4_Obj_1.S /= "Bye") or
|
(Incomplete4_Obj_1.S /= "Bye") or
|
(Incomplete4_Obj_1.I /= 14) then
|
(Incomplete4_Obj_1.I /= 14) then
|
Report.Failed ("Wrong values for Incomplete4_Obj_1");
|
Report.Failed ("Wrong values for Incomplete4_Obj_1");
|
end if;
|
end if;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end C3A1002;
|
end C3A1002;
|
|
|
