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

   1 -- CD30003.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 a Size clause for an object is supported if the specified
  28 --      size is at least as large as the subtype's size, and correspond to a
  29 --      size in storage elements that is a multiple of the object's (non-zero)
  30 --      Alignment. RM 13.3(43)
  31 --
  32 -- TEST DESCRIPTION:
  33 --      This test defines several types and then asserts specific sizes for
  34 --      the, it then checks that the size set is reported back.
  35 --
  36 -- APPLICABILITY CRITERIA:
  37 --      All implementations must attempt to compile this test.
  38 --
  39 --      For implementations validating against Systems Programming Annex (C):
  40 --        this test must execute and report PASSED.
  41 --
  42 --      For implementations not validating against Annex C:
  43 --        this test may report compile time errors at one or more points
  44 --        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
  45 --        Otherwise, the test must execute and report PASSED.
  46 --
  47 --
  48 -- CHANGE HISTORY:
  49 --      22 JUL 95   SAIC   Initial version
  50 --      08 MAY 96   SAIC   Corrected and strengthened for 2.1
  51 --      14 FEB 97   PWB.CTA Changed 'Size specifications to multiples
  52 --                         of System.Storage_Unit; restricted 'Size spec
  53 --                         for enumeration object to max integer size.
  54 --      16 FEB 98   EDS    Modify Documentation.
  55 --      25 JAN 99   RLB    Repaired to properly set and check sizes.
  56 --      29 JAN 99   RLB    Added Pack pragma needed for some implementations.
  57 --                         Corrected to support a Storage_Unit size < 8.
  58 --!
  59
  60 ------------------------------------------------------------------- CD30003
  61
  62 with Report;
  63 with System;
  64 procedure CD30003 is
  65
  66   ---------------------------------------------------------------------------
  67   -- types and subtypes
  68   ---------------------------------------------------------------------------
  69
  70   type Bit is mod 2**1;
  71   for Bit'Size use 1;                                         -- ANX-C RQMT.
  72
  73   type Byte is mod 2**8;
  74   for Byte'Size use 8;                                        -- ANX-C RQMT.
  75
  76   type Smallword is mod 2**8;
  77   for Smallword'size use 16;                                  -- ANX-C RQMT.
  78
  79   type Byte_Array is array(1..4) of Byte;
  80   pragma Pack(Byte_Array);                                    -- ANX-C RQMT.
  81   -- size should be 32
  82
  83   type Smallword_Array is array(1..4) of Smallword;
  84   pragma Pack(Smallword_Array); -- Required if Storage_Unit > 16. -- ANX-C RQMT.
  85
  86   -- Use to calulate maximum required size:
  87   type Max_Modular is mod System.Max_Binary_Modulus;
  88   type Max_Integer is range System.Min_Int .. System.Max_Int;
  89   Enum_Size : constant := Integer'Min (32,
  90       Integer'Min (Max_Modular'Size, Max_Integer'Size));
  91   type Transmission_Data is ( Empty, Input, Output, IO, Control );
  92   for Transmission_Data'Size use Enum_Size;                   -- ANX-C RQMT.
  93
  94   -- Sizes to try:
  95
  96   -- The basic sizes are based on a "normal" Storage_Unit = 8 implementation.
  97   -- We then use formulas to insure that the specified sizes meet the
  98   -- the minimum level of support and AI-0051.
  99
 100   Modular_Single_Size : constant := Integer'Min (((8 + (System.Storage_Unit-1))
 101      /System.Storage_Unit)*System.Storage_Unit, Max_Modular'Size);
 102      -- Calulate an appropriate, legal, and required to be supported size to
 103      -- try, which is the size of Byte. Note that object sizes must be
 104      -- a multiple of the storage unit for the compiler.
 105
 106   Modular_Double_Size : constant := Integer'Min (((16 + (System.Storage_Unit-1))
 107      /System.Storage_Unit)*System.Storage_Unit, Max_Modular'Size);
 108
 109   Modular_Quad_Size : constant := Integer'Min (((32 + (System.Storage_Unit-1))
 110      /System.Storage_Unit)*System.Storage_Unit, Max_Modular'Size);
 111
 112   Array_Quad_Size : constant := ((4 * 8 + (System.Storage_Unit-1))
 113      /System.Storage_Unit)*System.Storage_Unit;
 114
 115   Array_Octo_Size : constant := ((4 * 16 + (System.Storage_Unit-1))
 116      /System.Storage_Unit)*System.Storage_Unit;
 117
 118   Rounded_Enum_Size : constant := ((Enum_Size + (System.Storage_Unit-1))
 119      /System.Storage_Unit)*System.Storage_Unit;
 120
 121   Enum_Quad_Size : constant := Integer'Min (((32 + (System.Storage_Unit-1))
 122      /System.Storage_Unit)*System.Storage_Unit,
 123      Integer'Min (Max_Modular'Size, Max_Integer'Size));
 124
 125
 126   ---------------------------------------------------------------------------
 127   -- objects
 128   ---------------------------------------------------------------------------
 129
 130   Bit_8 : Bit :=0;
 131   for Bit_8'Size use System.Storage_Unit;                     -- ANX-C RQMT.
 132
 133   Bit_G : Bit :=0;
 134   for Bit_G'Size use Modular_Double_Size;                     -- ANX-C RQMT.
 135
 136   Byte_8 : Byte :=0;
 137   for Byte_8'Size use Modular_Single_Size;                    -- ANX-C RQMT.
 138
 139   Byte_G : Byte :=0;
 140   for Byte_G'Size use Modular_Double_Size;                    -- ANX-C RQMT.
 141
 142   Smallword_1 : Smallword :=0;
 143   for Smallword_1'Size use Modular_Double_Size;               -- ANX-C RQMT.
 144
 145   Smallword_2 : Smallword :=0;
 146   for Smallword_2'Size use Modular_Quad_Size;                 -- ANX-C RQMT.
 147
 148   Byte_Array_1 : Byte_Array := (others=>0);
 149   for Byte_Array_1'Size use Array_Quad_Size;                  -- ANX-C RQMT.
 150
 151   Smallword_Array_1 : Smallword_Array := (others=>0);
 152   for Smallword_Array_1'Size use Array_Octo_Size;             -- ANX-C RQMT.
 153
 154   Transmission_Data_1 : aliased Transmission_Data := Empty;
 155
 156   Transmission_Data_2 : Transmission_Data := Control;
 157   for Transmission_Data_2'Size use Enum_Quad_Size;            -- ANX-C RQMT.
 158
 159 begin  -- Main test procedure.
 160
 161   Report.Test ("CD30003", "Check that Size clauses are supported for " &
 162                           "values at least as large as the subtypes " &
 163                           "size, and correspond to a size in storage " &
 164                           "elements that is a multiple of the objects " &
 165                           "(non-zero) Alignment" );
 166
 167   if Bit_8'Size /= System.Storage_Unit then
 168     Report.Failed("Expected Bit_8'Size =" & Integer'Image(System.Storage_Unit)
 169                       & " , actually =" & Integer'Image(Bit_8'Size));
 170   end if;
 171
 172   if Bit_G'Size /= Modular_Double_Size then
 173     Report.Failed("Expected Bit_G'Size =" & Integer'Image(Modular_Double_Size)
 174                       & " , actually =" & Integer'Image(Bit_G'Size));
 175   end if;
 176
 177   if Byte_8'Size /= Modular_Single_Size then
 178     Report.Failed("Expected Byte_8'Size =" & Integer'Image(Modular_Single_Size)
 179                       & " , actually =" & Integer'Image(Byte_8'Size));
 180   end if;
 181
 182   if Byte_G'Size /= Modular_Double_Size then
 183     Report.Failed("Expected Bit_G'Size =" & Integer'Image(Modular_Double_Size)
 184                       & " , actually =" & Integer'Image(Byte_G'Size));
 185   end if;
 186
 187   if Smallword_1'Size /= Modular_Double_Size then
 188     Report.Failed("Expected Smallword_1'Size =" &
 189                       Integer'Image(Modular_Double_Size) &
 190                       ", actually =" & Integer'Image(Smallword_1'Size));
 191   end if;
 192
 193   if Smallword_2'Size /= Modular_Quad_Size then
 194     Report.Failed("Expected Smallword_2'Size =" &
 195                       Integer'Image(Modular_Quad_Size) &
 196                       ", actually =" & Integer'Image(Smallword_2'Size));
 197   end if;
 198
 199   if Byte_Array_1'Size /= Array_Quad_Size then
 200     Report.Failed("Expected Byte_Array_1'Size =" &
 201                       Integer'Image(Array_Quad_Size) &
 202                       ", actually =" & Integer'Image(Byte_Array_1'Size));
 203   end if;
 204
 205   if Smallword_Array_1'Size /= Array_Octo_Size then
 206     Report.Failed(
 207       "Expected Smallword_Array_1'Size =" &
 208                       Integer'Image(Array_Octo_Size) &
 209                       ", actually =" & Integer'Image(Smallword_Array_1'Size));
 210   end if;
 211
 212   if Transmission_Data_1'Size /= Enum_Size and then
 213      Transmission_Data_1'Size /= Rounded_Enum_Size then
 214     Report.Failed(
 215       "Expected Transmission_Data_1'Size =" & Integer'Image(Rounded_Enum_Size) &
 216                       ", actually =" & Integer'Image(Transmission_Data_1'Size));
 217   end if;
 218
 219   if Transmission_Data_2'Size /= Enum_Quad_Size then
 220     Report.Failed(
 221       "Expected Transmission_Data_2'Size =" & Integer'Image(Enum_Quad_Size) &
 222                       ", actually =" & Integer'Image(Transmission_Data_2'Size));
 223   end if;
 224
 225   Report.Result;
 226
 227 end CD30003;