diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd90001.a')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd90001.a | 233 |
1 files changed, 233 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd90001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd90001.a new file mode 100644 index 000000000..bd5c070a6 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd90001.a @@ -0,0 +1,233 @@ +-- 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; |