gcc/testsuite/ada/acats/tests/cd/cd90001.a

   1 -- CD90001.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- OBJECTIVE:
  27 --      Check that Unchecked_Conversion is supported and is reversible in
  28 --      the cases where:
  29 --        Source'Size = Target'Size
  30 --        Source'Alignment = Target'Alignment
  31 --        Source and Target are both represented contiguously
  32 --        Bit pattern in Source is a meaningful value of Target type
  33 --
  34 -- TEST DESCRIPTION:
  35 --      This test declares an enumeration type with a representation
  36 --      specification that should fit neatly into an 8 bit object; and a
  37 --      modular type that should also be able to fit easily into 8 bits;
  38 --      uses size representation clauses on both of them for 8 bit
  39 --      representations.  It then defines two instances of
  40 --      Unchecked_Conversion; to convert both ways between the types.
  41 --      Using several distinctive values, it checks that the conversions
  42 --      are performed, and reversible.
  43 --      As a second case, the above is performed with an integer type and
  44 --      a packed array of booleans.
  45 --
  46 -- APPLICABILITY CRITERIA:
  47 --      All implementations must attempt to compile this test.
  48 --
  49 --      For implementations validating against Systems Programming Annex (C):
  50 --        this test must execute and report PASSED.
  51 --
  52 --      For implementations not validating against Annex C:
  53 --        this test may report compile time errors at one or more points
  54 --        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
  55 --        Otherwise, the test must execute and report PASSED.
  56 --
  57 --
  58 -- CHANGE HISTORY:
  59 --      22 JUL 95   SAIC   Initial version
  60 --      07 MAY 96   SAIC   Changed Boolean to Character for 2.1
  61 --      27 JUL 96   SAIC   Allowed for partial N/A to be PASS
  62 --      14 FEB 97   PWB.CTA  Corrected "=" to "/=" in alignment check.
  63 --      16 FEB 98   EDS    Modified documentation.
  64 --!
  65
  66 ----------------------------------------------------------------- CD90001_0
  67
  68 with Report;
  69 with Unchecked_Conversion;
  70 package CD90001_0 is
  71
  72   -- Case 1 : Modular <=> Enumeration
  73
  74   type Eight_Bits is mod 2**8;
  75     for Eight_Bits'Size use 8;
  76
  77   type User_Enums is ( One, Two, Four, Eight,
  78                        Sixteen, Thirty_Two, Sixty_Four, One_Twenty_Eight );
  79     for User_Enums'Size use 8;
  80
  81     for User_Enums use
  82                     ( One              =>   1,                -- ANX-C RQMT.
  83                       Two              =>   2,                -- ANX-C RQMT.
  84                       Four             =>   4,                -- ANX-C RQMT.
  85                       Eight            =>   8,                -- ANX-C RQMT.
  86                       Sixteen          =>  16,                -- ANX-C RQMT.
  87                       Thirty_Two       =>  32,                -- ANX-C RQMT.
  88                       Sixty_Four       =>  64,                -- ANX-C RQMT.
  89                       One_Twenty_Eight => 128 );              -- ANX-C RQMT.
  90
  91   function EB_2_UE is new Unchecked_Conversion( Eight_Bits, User_Enums );
  92
  93   function UE_2_EB is new Unchecked_Conversion( User_Enums, Eight_Bits );
  94
  95   procedure TC_Check_Case_1;
  96
  97   -- Case 2 : Integer <=> Packed Character array
  98
  99   type Signed_16 is range -2**15+1 .. 2**15-1;
 100   -- +1, -1 allows for both 1's and 2's comp
 101
 102   type Bits_16 is array(0..1) of Character;
 103   pragma Pack(Bits_16);                                       -- ANX-C RQMT.
 104
 105   function S16_2_B16 is new Unchecked_Conversion( Signed_16, Bits_16 );
 106
 107   function B16_2_S16 is new Unchecked_Conversion( Bits_16, Signed_16 );
 108
 109   procedure TC_Check_Case_2;
 110
 111 end CD90001_0;
 112
 113 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
 114
 115 with Report;
 116 package body CD90001_0 is
 117
 118   Check_List : constant array(1..8) of Eight_Bits
 119              := ( 1, 2, 4, 8, 16, 32, 64, 128 );
 120
 121   Check_Enum : constant array(1..8) of User_Enums
 122              := ( One, Two, Four, Eight,
 123                   Sixteen, Thirty_Two, Sixty_Four, One_Twenty_Eight );
 124
 125   procedure TC_Check_Case_1 is
 126     Mod_Value : Eight_Bits;
 127     Enum_Val  : User_Enums;
 128   begin
 129     for I in Check_List'Range loop
 130
 131       if EB_2_UE(Check_List(I)) /= Check_Enum(I) then
 132         Report.Failed("EB => UE conversion failed");
 133       end if;
 134
 135       if Check_List(I)          /= UE_2_EB(Check_Enum(I)) then
 136         Report.Failed ("EU => EB conversion failed");
 137       end if;
 138
 139     end loop;
 140   end TC_Check_Case_1;
 141
 142   procedure TC_Check_Case_2 is
 143     S: Signed_16;
 144     T,U: Signed_16;
 145     B: Bits_16;
 146     C,D: Bits_16;  -- allow for byte swapping
 147   begin
 148          --FDEC_BA98_7654_3210
 149     S := 2#0011_0000_0111_0111#;
 150     B := S16_2_B16( S );
 151     C := ( Character'Val(2#0011_0000#), Character'Val(2#0111_0111#) );
 152     D := ( Character'Val(2#0111_0111#), Character'Val(2#0011_0000#) );
 153
 154     if (B /= C) and (B /= D) then
 155       Report.Failed("Int => Chararray conversion failed");
 156     end if;
 157
 158     B := ( Character'Val(2#0011_1100#), Character'Val(2#0101_0101#) );
 159     S := B16_2_S16( B );
 160     T := 2#0011_1100_0101_0101#;
 161     U := 2#0101_0101_0011_1100#;
 162
 163     if (S /= T) and (S /= U) then
 164       Report.Failed("Chararray => Int conversion failed");
 165     end if;
 166
 167   end TC_Check_Case_2;
 168
 169 end CD90001_0;
 170
 171 ------------------------------------------------------------------- CD90001
 172
 173 with Report;
 174 with CD90001_0;
 175
 176 procedure CD90001 is
 177
 178   Eight_NA   : Boolean := False;
 179   Sixteen_NA : Boolean := False;
 180
 181 begin  -- Main test procedure.
 182
 183   Report.Test ("CD90001", "Check that Unchecked_Conversion is supported " &
 184                           "and is reversible in appropriate cases" );
 185   Eight_Bit_Case:
 186   begin
 187     if CD90001_0.User_Enums'Size /= CD90001_0.Eight_Bits'Size then
 188       Report.Comment("The sizes of the 8 bit types used in this test "
 189                             & "do not match" );
 190       Eight_NA := True;
 191     elsif CD90001_0.User_Enums'Alignment /= CD90001_0.Eight_Bits'Alignment then
 192       Report.Comment("The alignments of the 8 bit types used in this "
 193                             & "test do not match" );
 194       Eight_NA := True;
 195     else
 196       CD90001_0.TC_Check_Case_1;
 197     end if;
 198
 199   exception
 200     when Constraint_Error =>
 201            Report.Failed("Constraint_Error raised in 8 bit case");
 202     when others           =>
 203            Report.Failed("Unexpected exception raised in 8 bit case");
 204   end Eight_Bit_Case;
 205
 206   Sixteen_Bit_Case:
 207   begin
 208     if CD90001_0.Signed_16'Size /= CD90001_0.Bits_16'Size then
 209       Report.Comment("The sizes of the 16 bit types used in this test "
 210                             & "do not match" );
 211       Sixteen_NA := True;
 212     elsif CD90001_0.Signed_16'Alignment = CD90001_0.Bits_16'Alignment then
 213       Report.Comment("The alignments of the 16 bit types used in this "
 214                             & "test do not match" );
 215       Sixteen_NA := True;
 216     else
 217       CD90001_0.TC_Check_Case_2;
 218     end if;
 219
 220   exception
 221     when Constraint_Error =>
 222            Report.Failed("Constraint_Error raised in 16 bit case");
 223     when others           =>
 224            Report.Failed("Unexpected exception raised in 16 bit case");
 225   end Sixteen_Bit_Case;
 226
 227   if Eight_NA and Sixteen_NA then
 228     Report.Not_Applicable("No cases in this test apply");
 229   end if;
 230
 231   Report.Result;
 232
 233 end CD90001;