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/] [c3a1001.a] - Rev 384
Compare with Previous | Blame | View Log
-- C3A1001.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 records and protected 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 record and protected types are
-- declared with default and non 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:
-- 11 Oct 95 SAIC Initial prerelease version.
-- 11 Nov 96 SAIC Revised for version 2.1.
--
--!
package C3A1001_0 is
type Incomplete1 (<>); -- unknown discriminant
type Incomplete2; -- no discriminant
type Incomplete3 (<>); -- unknown discriminant
type Incomplete4; -- no discriminant
type Incomplete5 (<>); -- unknown discriminant
type Incomplete6; -- no discriminant
type Incomplete8; -- no discriminant
subtype Small_Int is Integer range 1 .. 10;
type Enu_Type is (M, F);
type Incomplete1 (Disc : Enu_Type) is -- unknown discriminant/
record -- explicit discriminant
case Disc is
when M => MInteger : Small_Int := 3;
when F => FInteger : Small_Int := 8;
end case;
end record;
type Incomplete2 (Disc : Small_Int := 8) is -- no discriminant/
record -- explicit discriminant
ID : String (1 .. Disc) := "Plymouth";
end record;
type Incomplete3 is new Incomplete2; -- unknown discriminant/
-- inherited discriminant
type Incomplete4 is new Incomplete2; -- no discriminant/
-- inherited discriminant
protected type Incomplete5 -- unknown discriminant/
(Disc : Enu_Type) is -- explicit discriminant
function Get_Priv_Val return Enu_Type;
private
Enu_Obj : Enu_Type := Disc;
end Incomplete5;
protected type Incomplete6 -- no discriminant/
(Disc : Small_Int := 1) is -- explicit discriminant
function Get_Priv_Val return Small_Int; -- with default
private
Num : Small_Int := Disc;
end Incomplete6;
type Incomplete8 (Disc : Small_Int) is -- no discriminant/
record -- explicit discriminant
Str : String (1 .. Disc); -- no default
end record;
type Incomplete9 is new Incomplete8;
function Return_String (S : String) return String;
end C3A1001_0;
--==================================================================--
with Report;
package body C3A1001_0 is
protected body Incomplete5 is
function Get_Priv_Val return Enu_Type is
begin
return Enu_Obj;
end Get_Priv_Val;
end Incomplete5;
----------------------------------------------------------------------
protected body Incomplete6 is
function Get_Priv_Val return Small_Int is
begin
return Num;
end Get_Priv_Val;
end Incomplete6;
----------------------------------------------------------------------
function Return_String (S : String) return String is
begin
if Report.Ident_Bool(True) = True then
return S;
end if;
return S;
end Return_String;
end C3A1001_0;
--==================================================================--
with Report;
with C3A1001_0;
use C3A1001_0;
procedure C3A1001 is
-- Discriminant value comes from default.
Incomplete2_Obj_1 : Incomplete2;
Incomplete4_Obj_1 : Incomplete4;
Incomplete6_Obj_1 : Incomplete6;
-- Discriminant value comes from explicit constraint.
Incomplete1_Obj_1 : Incomplete1 (F);
Incomplete5_Obj_1 : Incomplete5 (M);
Incomplete6_Obj_2 : Incomplete6 (2);
-- Discriminant value comes from assignment.
Incomplete3_Obj_1 : Incomplete3 := (Disc => 6, ID => "Sentra");
Incomplete1_Obj_2 : Incomplete1 := (Disc => M, MInteger => 9);
Incomplete2_Obj_2 : Incomplete2 := (Disc => 5, ID => "Buick");
begin
Report.Test ("C3A1001", "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 " &
"records and protected types");
-- Check the initial values.
if (Incomplete2_Obj_1.Disc /= 8) or
(Incomplete2_Obj_1.ID /= "Plymouth") then
Report.Failed ("Wrong initial values for Incomplete2_Obj_1");
end if;
if (Incomplete4_Obj_1.Disc /= 8) or
(Incomplete4_Obj_1.ID /= "Plymouth") then
Report.Failed ("Wrong initial values for Incomplete4_Obj_1");
end if;
if (Incomplete6_Obj_1.Disc /= 1) or
(Incomplete6_Obj_1.Get_Priv_Val /= 1) then
Report.Failed ("Wrong initial value for Incomplete6_Obj_1");
end if;
-- Check the explicit values.
if (Incomplete1_Obj_1.Disc /= F) or
(Incomplete1_Obj_1.FInteger /= 8) then
Report.Failed ("Wrong values for Incomplete1_Obj_1");
end if;
if (Incomplete5_Obj_1.Disc /= M) or
(Incomplete5_Obj_1.Get_Priv_Val /= M) then
Report.Failed ("Wrong value for Incomplete5_Obj_1");
end if;
if (Incomplete6_Obj_2.Disc /= 2) or
(Incomplete6_Obj_2.Get_Priv_Val /= 2) then
Report.Failed ("Wrong value for Incomplete6_Obj_2");
end if;
-- Check the assigned values.
if (Incomplete3_Obj_1.Disc /= 6) or
(Incomplete3_Obj_1.ID /= "Sentra") then
Report.Failed ("Wrong values for Incomplete3_Obj_1");
end if;
if (Incomplete1_Obj_2.Disc /= M) or
(Incomplete1_Obj_2.MInteger /= 9) then
Report.Failed ("Wrong values for Incomplete1_Obj_2");
end if;
if (Incomplete2_Obj_2.Disc /= 5) or
(Incomplete2_Obj_2.ID /= "Buick") then
Report.Failed ("Wrong values for Incomplete2_Obj_2");
end if;
-- Make sure that assignments work without problems.
Incomplete1_Obj_1.FInteger := 1;
-- Avoid optimization (dead variable removal of FInteger):
if Incomplete1_Obj_1.FInteger /= Report.Ident_Int(1)
then
Report.Failed ("Wrong value stored in Incomplete1_Obj_1.FInteger");
end if;
Incomplete2_Obj_1.ID := Return_String ("12345678");
-- Avoid optimization (dead variable removal of ID)
if Incomplete2_Obj_1.ID /= Return_String ("12345678")
then
Report.Failed ("Wrong values for Incomplete8_Obj_1.ID");
end if;
Incomplete4_Obj_1.ID := Return_String ("87654321");
-- Avoid optimization (dead variable removal of ID)
if Incomplete4_Obj_1.ID /= Return_String ("87654321")
then
Report.Failed ("Wrong values for Incomplete4_Obj_1.ID");
end if;
Test1:
declare
Incomplete8_Obj_1 : Incomplete8 (10);
begin
Incomplete8_Obj_1.Str := "Merry Xmas";
-- Avoid optimization (dead variable removal of Str):
if Return_String (Incomplete8_Obj_1.Str) /= "Merry Xmas"
then
Report.Failed ("Wrong values for Incomplete8_Obj_1.Str");
end if;
exception
when Constraint_Error =>
Report.Failed ("Constraint_Error raised in Incomplete8_Obj_1");
end Test1;
Test2:
declare
Incomplete8_Obj_2 : Incomplete8 (5);
begin
Incomplete8_Obj_2.Str := "Happy";
-- Avoid optimization (dead variable removal of Str):
if Return_String (Incomplete8_Obj_2.Str) /= "Happy"
then
Report.Failed ("Wrong values for Incomplete8_Obj_1.Str");
end if;
exception
when Constraint_Error =>
Report.Failed ("Constraint_Error raised in Incomplete8_Obj_2");
end Test2;
Report.Result;
end C3A1001;