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

   1 -- CD20001.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 for packed records the components are packed as tightly
  28 --      as possible subject to the Size of the component subtypes.
  29 --      Specifically check that Boolean objects are packed one to a bit.
  30 --
  31 --      Check that the Component_Size for a packed array type is less than
  32 --      or equal to the smallest of those factors of the word size that are
  33 --      greater than or equal to the Size of the component subtype.
  34 --
  35 -- TEST DESCRIPTION:
  36 --      This test defines and packs several types, and checks that the sizes
  37 --      of the resulting objects is as expected.
  38 --
  39 -- APPLICABILITY CRITERIA:
  40 --      All implementations must attempt to compile this test.
  41 --
  42 --      For implementations validating against Systems Programming Annex (C):
  43 --        this test must execute and report PASSED.
  44 --
  45 --      For implementations not validating against Annex C:
  46 --        this test may report compile time errors at one or more points
  47 --        indicated by "-- ANX-C RQMT", in which case it may be graded as
  48 --        inapplicable.  Otherwise, the test must execute and report PASSED.
  49 --
  50 --
  51 -- CHANGE HISTORY:
  52 --      22 JUL 95   SAIC   Initial version
  53 --      08 MAY 96   SAIC   Strengthened for 2.1
  54 --      29 JAN 98   EDS    Deleted check that Component_Size is really a
  55 --                         factor of Word_Size.
  56 --!
  57
  58 ----------------------------------------------------------------- CD20001_0
  59
  60 with System;
  61 package CD20001_0 is
  62
  63   type Wordlong_Bool_Array is array(1..System.Word_Size) of Boolean;
  64     pragma Pack(Wordlong_Bool_Array);                         -- ANX-C RQMT
  65
  66   type Def_Rep_Components is range 0..2**(System.Storage_Unit-2);
  67
  68   type Spec_Rep_Components is range 0..2**(System.Storage_Unit-2);
  69     for Spec_Rep_Components'Size use System.Storage_Unit;     -- ANX-C RQMT
  70
  71   type Packed_Array_Def_Components is array(1..32) of Def_Rep_Components;
  72     pragma Pack(Packed_Array_Def_Components);                 -- ANX-C RQMT
  73
  74   type Packed_Array_Spec_Components is array(1..32) of Spec_Rep_Components;
  75     pragma Pack(Packed_Array_Spec_Components);                -- ANX-C RQMT
  76
  77   procedure TC_Check_Values;
  78
  79 end CD20001_0;
  80
  81 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
  82
  83 with Report;
  84 with TCTouch;
  85 package body CD20001_0 is
  86
  87   procedure TC_Check_Values is
  88     My_Word      : Wordlong_Bool_Array := (others => False);
  89
  90     Cited_Unit   : Spec_Rep_Components := 0;
  91
  92     Packed_Array : Packed_Array_Def_Components := (others => 0);
  93
  94     Cited_Packed : Packed_Array_Spec_Components := (others => 0);
  95
  96   begin
  97     TCTouch.Assert( My_Word'Size = System.Word_Size,
  98        "pragma Pack on array of Booleans does not pack one Boolean per bit" );
  99
 100     TCTouch.Assert( My_Word'Component_Size = 1,
 101                     "size of Boolean array component not 1 bit");
 102
 103     TCTouch.Assert( Cited_Unit'Size = System.Storage_Unit,
 104                     "Object specified to be Storage_Unit bits not " &
 105                     "Storage_Unit bits in size");
 106
 107     TCTouch.Assert( Packed_Array'Component_Size <= System.Storage_Unit,
 108                     "Packed array component expected to be less than or " &
 109                     "equal to Storage_Unit bits in size is greater than " &
 110                     "Storage_Unit bits in size");
 111
 112     TCTouch.Assert( Cited_Packed'Component_Size = System.Storage_Unit,
 113                     "Array component specified to be Storage_Unit " &
 114                     "bits not Storage_Unit bits in size");
 115
 116   end TC_Check_Values;
 117
 118 end CD20001_0;
 119
 120 ----------------------------------------------------------------- CD20001_1
 121
 122 with System;
 123 package CD20001_1 is
 124
 125   type Bits_2  is range 0..2**2-1;
 126     for Bits_2'Size use 2;                                    -- ANX-C RQMT
 127
 128   type Bits_3  is range 0..2**3-1;
 129     for Bits_3'Size use 3;                                    -- ANX-C RQMT
 130
 131   type Bits_7  is range 0..2**7-1;
 132     for Bits_7'Size use 7;                                    -- ANX-C RQMT
 133
 134   type Bits_8  is range 0..2**8-1;
 135     for Bits_8'Size use 8;                                    -- ANX-C RQMT
 136
 137   type Bits_9  is range 0..2**9-1;
 138     for Bits_9'Size use 9;                                    -- ANX-C RQMT
 139
 140   type Bits_15 is range 0..2**15-1;
 141     for Bits_15'Size use 15;                                  -- ANX-C RQMT
 142
 143   type Pact_Aray_2  is array(0..31) of Bits_2;
 144     pragma Pack( Pact_Aray_2 );                               -- ANX-C RQMT
 145
 146   type Pact_Aray_3  is array(0..31) of Bits_3;
 147     pragma Pack( Pact_Aray_3 );                               -- ANX-C RQMT
 148
 149   type Pact_Aray_7  is array(0..31) of Bits_7;
 150     pragma Pack( Pact_Aray_7 );                               -- ANX-C RQMT
 151
 152   type Pact_Aray_8  is array(0..31) of Bits_8;
 153     pragma Pack( Pact_Aray_8 );                               -- ANX-C RQMT
 154
 155   type Pact_Aray_9  is array(0..31) of Bits_9;
 156     pragma Pack( Pact_Aray_9 );                               -- ANX-C RQMT
 157
 158   type Pact_Aray_15 is array(0..31) of Bits_15;
 159     pragma Pack( Pact_Aray_15 );                              -- ANX-C RQMT
 160
 161
 162   procedure TC_Check_Values;
 163
 164 end CD20001_1;
 165
 166 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
 167
 168 with Report;
 169 with TCTouch;
 170 package body CD20001_1 is
 171
 172    function Next_Factor ( Value : Positive ) return Integer is
 173    -- Returns the factor of Word_Size that is next larger than Value.
 174    -- If Value is greater than Word_Size, then returns Word_Size.
 175      Test   : Integer := Value;
 176      Found  : Boolean := False;
 177   begin  -- Next_Factor
 178      while not Found and Test <= System.Word_Size loop
 179        if System.Word_Size mod Test = 0 then
 180           Found := True;
 181        else
 182           Test := Test + 1;
 183        end if;
 184      end loop;
 185      if Found then
 186         return Test;
 187      else
 188         return System.Word_Size;
 189      end if;
 190   end Next_Factor;
 191
 192   procedure TC_Check_Values is
 193   begin
 194
 195     if Pact_Aray_2'Component_Size > Next_Factor ( Bits_2'Size ) then
 196        Report.Failed
 197           ( "2 bit element Packed Array'Component_Size too big" );
 198     end if;
 199
 200     TCTouch.Assert( Pact_Aray_2'Component_Size <= Pact_Aray_2'Size,
 201                     "2 bit Component_Size greater than array size" );
 202
 203     if Pact_Aray_3'Component_Size > Next_Factor ( Bits_3'Size ) then
 204        Report.Failed
 205           ( "3 bit element Packed Array'Component_Size too big" );
 206     end if;
 207
 208     TCTouch.Assert( Pact_Aray_3'Component_Size <= Pact_Aray_3'Size,
 209                     "3 bit Component_Size greater than array size" );
 210
 211     if Pact_Aray_7'Component_Size > Next_Factor ( Bits_7'Size ) then
 212        Report.Failed
 213           ( "7 bit element Packed Array'Component_Size too big" );
 214     end if;
 215
 216     TCTouch.Assert( Pact_Aray_7'Component_Size <= Pact_Aray_7'Size,
 217                     "7 bit Component_Size greater than array size" );
 218
 219     if Pact_Aray_8'Component_Size > Next_Factor ( Bits_8'Size ) then
 220        Report.Failed
 221           ( "8 bit element Packed Array'Component_Size too big" );
 222     end if;
 223
 224     TCTouch.Assert( Pact_Aray_8'Component_Size <= Pact_Aray_8'Size,
 225                     "8 bit Component_Size greater than array size" );
 226
 227     if System.Word_Size > 8 then
 228
 229       if Pact_Aray_9'Component_Size > Next_Factor ( Bits_9'Size ) then
 230          Report.Failed
 231             ( "9 bit element Packed Array'Component_Size too big" );
 232       end if;
 233
 234       TCTouch.Assert( Pact_Aray_9'Component_Size <= Pact_Aray_9'Size,
 235                     "9 bit Component_Size greater than array size" );
 236
 237       if Pact_Aray_15'Component_Size > Next_Factor ( Bits_15'Size ) then
 238          Report.Failed
 239             ( "15 bit element Packed Array'Component_Size too big" );
 240       end if;
 241
 242       TCTouch.Assert( Pact_Aray_15'Component_Size <= Pact_Aray_15'Size,
 243                     "15 bit Component_Size greater than array size" );
 244
 245     end if;
 246
 247   end TC_Check_Values;
 248
 249 end CD20001_1;
 250
 251 ------------------------------------------------------------------- CD20001
 252
 253 with Report;
 254 with CD20001_0;
 255 with CD20001_1;
 256
 257 procedure CD20001 is
 258
 259 begin  -- Main test procedure.
 260
 261   Report.Test ("CD20001", "Check that packed records are packed as tightly " &
 262                           "as possible.  Check that Boolean objects are " &
 263                           "packed one to a bit. " &
 264                           "Check that the Component_Size for a packed " &
 265                           "array type is the value which is less than or " &
 266                           "equal to the Size of the component type, " &
 267                           "rounded up to the nearest factor of word_size" );
 268
 269   CD20001_0.TC_Check_Values;
 270
 271   CD20001_1.TC_Check_Values;
 272
 273   Report.Result;
 274
 275 end CD20001;