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