URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cd/] [cd90001.a] - Rev 720
Compare with Previous | Blame | View Log
-- CD90001.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 Unchecked_Conversion is supported and is reversible in
-- the cases where:
-- Source'Size = Target'Size
-- Source'Alignment = Target'Alignment
-- Source and Target are both represented contiguously
-- Bit pattern in Source is a meaningful value of Target type
--
-- TEST DESCRIPTION:
-- This test declares an enumeration type with a representation
-- specification that should fit neatly into an 8 bit object; and a
-- modular type that should also be able to fit easily into 8 bits;
-- uses size representation clauses on both of them for 8 bit
-- representations. It then defines two instances of
-- Unchecked_Conversion; to convert both ways between the types.
-- Using several distinctive values, it checks that the conversions
-- are performed, and reversible.
-- As a second case, the above is performed with an integer type and
-- a packed array of booleans.
--
-- APPLICABILITY CRITERIA:
-- All implementations must attempt to compile this test.
--
-- For implementations validating against Systems Programming Annex (C):
-- this test must execute and report PASSED.
--
-- For implementations not validating against Annex C:
-- this test may report compile time errors at one or more points
-- indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
-- Otherwise, the test must execute and report PASSED.
--
--
-- CHANGE HISTORY:
-- 22 JUL 95 SAIC Initial version
-- 07 MAY 96 SAIC Changed Boolean to Character for 2.1
-- 27 JUL 96 SAIC Allowed for partial N/A to be PASS
-- 14 FEB 97 PWB.CTA Corrected "=" to "/=" in alignment check.
-- 16 FEB 98 EDS Modified documentation.
--!
----------------------------------------------------------------- CD90001_0
with Report;
with Unchecked_Conversion;
package CD90001_0 is
-- Case 1 : Modular <=> Enumeration
type Eight_Bits is mod 2**8;
for Eight_Bits'Size use 8;
type User_Enums is ( One, Two, Four, Eight,
Sixteen, Thirty_Two, Sixty_Four, One_Twenty_Eight );
for User_Enums'Size use 8;
for User_Enums use
( One => 1, -- ANX-C RQMT.
Two => 2, -- ANX-C RQMT.
Four => 4, -- ANX-C RQMT.
Eight => 8, -- ANX-C RQMT.
Sixteen => 16, -- ANX-C RQMT.
Thirty_Two => 32, -- ANX-C RQMT.
Sixty_Four => 64, -- ANX-C RQMT.
One_Twenty_Eight => 128 ); -- ANX-C RQMT.
function EB_2_UE is new Unchecked_Conversion( Eight_Bits, User_Enums );
function UE_2_EB is new Unchecked_Conversion( User_Enums, Eight_Bits );
procedure TC_Check_Case_1;
-- Case 2 : Integer <=> Packed Character array
type Signed_16 is range -2**15+1 .. 2**15-1;
-- +1, -1 allows for both 1's and 2's comp
type Bits_16 is array(0..1) of Character;
pragma Pack(Bits_16); -- ANX-C RQMT.
function S16_2_B16 is new Unchecked_Conversion( Signed_16, Bits_16 );
function B16_2_S16 is new Unchecked_Conversion( Bits_16, Signed_16 );
procedure TC_Check_Case_2;
end CD90001_0;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
with Report;
package body CD90001_0 is
Check_List : constant array(1..8) of Eight_Bits
:= ( 1, 2, 4, 8, 16, 32, 64, 128 );
Check_Enum : constant array(1..8) of User_Enums
:= ( One, Two, Four, Eight,
Sixteen, Thirty_Two, Sixty_Four, One_Twenty_Eight );
procedure TC_Check_Case_1 is
Mod_Value : Eight_Bits;
Enum_Val : User_Enums;
begin
for I in Check_List'Range loop
if EB_2_UE(Check_List(I)) /= Check_Enum(I) then
Report.Failed("EB => UE conversion failed");
end if;
if Check_List(I) /= UE_2_EB(Check_Enum(I)) then
Report.Failed ("EU => EB conversion failed");
end if;
end loop;
end TC_Check_Case_1;
procedure TC_Check_Case_2 is
S: Signed_16;
T,U: Signed_16;
B: Bits_16;
C,D: Bits_16; -- allow for byte swapping
begin
--FDEC_BA98_7654_3210
S := 2#0011_0000_0111_0111#;
B := S16_2_B16( S );
C := ( Character'Val(2#0011_0000#), Character'Val(2#0111_0111#) );
D := ( Character'Val(2#0111_0111#), Character'Val(2#0011_0000#) );
if (B /= C) and (B /= D) then
Report.Failed("Int => Chararray conversion failed");
end if;
B := ( Character'Val(2#0011_1100#), Character'Val(2#0101_0101#) );
S := B16_2_S16( B );
T := 2#0011_1100_0101_0101#;
U := 2#0101_0101_0011_1100#;
if (S /= T) and (S /= U) then
Report.Failed("Chararray => Int conversion failed");
end if;
end TC_Check_Case_2;
end CD90001_0;
------------------------------------------------------------------- CD90001
with Report;
with CD90001_0;
procedure CD90001 is
Eight_NA : Boolean := False;
Sixteen_NA : Boolean := False;
begin -- Main test procedure.
Report.Test ("CD90001", "Check that Unchecked_Conversion is supported " &
"and is reversible in appropriate cases" );
Eight_Bit_Case:
begin
if CD90001_0.User_Enums'Size /= CD90001_0.Eight_Bits'Size then
Report.Comment("The sizes of the 8 bit types used in this test "
& "do not match" );
Eight_NA := True;
elsif CD90001_0.User_Enums'Alignment /= CD90001_0.Eight_Bits'Alignment then
Report.Comment("The alignments of the 8 bit types used in this "
& "test do not match" );
Eight_NA := True;
else
CD90001_0.TC_Check_Case_1;
end if;
exception
when Constraint_Error =>
Report.Failed("Constraint_Error raised in 8 bit case");
when others =>
Report.Failed("Unexpected exception raised in 8 bit case");
end Eight_Bit_Case;
Sixteen_Bit_Case:
begin
if CD90001_0.Signed_16'Size /= CD90001_0.Bits_16'Size then
Report.Comment("The sizes of the 16 bit types used in this test "
& "do not match" );
Sixteen_NA := True;
elsif CD90001_0.Signed_16'Alignment = CD90001_0.Bits_16'Alignment then
Report.Comment("The alignments of the 16 bit types used in this "
& "test do not match" );
Sixteen_NA := True;
else
CD90001_0.TC_Check_Case_2;
end if;
exception
when Constraint_Error =>
Report.Failed("Constraint_Error raised in 16 bit case");
when others =>
Report.Failed("Unexpected exception raised in 16 bit case");
end Sixteen_Bit_Case;
if Eight_NA and Sixteen_NA then
Report.Not_Applicable("No cases in this test apply");
end if;
Report.Result;
end CD90001;