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

   1 -- CD10001.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 representation items may contain nonstatic expressions
  28 --      in the case that each expression in  the representation item is a
  29 --      name that statically denotes a constant declared before the entity.
  30 --
  31 --
  32 -- TEST DESCRIPTION:
  33 --      For each of the specific items in the objective, this test checks
  34 --      an example of each of the categories of representation specification
  35 --      that are applicable to that objective, to wit:
  36 --        address clause ....................... Expressions need not be static
  37 --        alignment clause ..................... Expressions must be static
  38 --        bit order clause ..................... Not tested
  39 --        component size clause ................ Expressions must be static
  40 --        enumeration representation clause .... Expressions must be static
  41 --        external tag clause .................. Expressions must be static
  42 --        Import, Export and Convention pragmas  Not tested
  43 --        input clause ......................... Not tested
  44 --        output clause ........................ Not tested
  45 --        Pack pragma .......................... Not tested
  46 --        read clause .......................... Not tested
  47 --        record representation clause ......... Expressions must be static
  48 --        size clause .......................... Expressions must be static
  49 --        small clause ......................... Expressions must be static
  50 --        storage pool clause .................. Not tested
  51 --        storage size clause .................. Expressions must be static
  52 --        write clause ......................... Not tested
  53 --
  54 -- APPLICABILITY CRITERIA:
  55 --      All implementations must attempt to compile this test.
  56 --
  57 --      For implementations validating against Systems Programming Annex (C):
  58 --        this test must execute.
  59 --
  60 --      For implementations not validating against Annex C:
  61 --        if this test compiles without error messages at compilation,
  62 --        it must bind and execute.
  63 --
  64 -- PASS/FAIL CRITERIA:
  65 --      For implementations validating against Systems Programming Annex (C):
  66 --        this test must execute, report PASSED, and complete normally,
  67 --        otherwise the test FAILS
  68 --
  69 --      For implementations not validating against Annex C:
  70 --        PASSING behavior is:
  71 --          this test executes, reports PASSED, and completes normally
  72 --        or
  73 --          this test executes and reports NOT_APPLICABLE
  74 --        or
  75 --          this test produces at least one error message at compilation, and
  76 --          the error message is associated with one of the items marked:
  77 --             -- N/A => ERROR.
  78 --
  79 --      All other behaviors are FAILING.
  80 --
  81
  82 -- CHANGE HISTORY:
  83 --      11 JUL 95   SAIC  Initial version
  84 --      10 MAR 97   PWB.CTA Made Nonstatic_Entity nonstatic; changed
  85 --                        Tenths'Small from 1.0/32.0 to 1.0/10.0,
  86 --                        as expected by the later check; improved
  87 --                        internal documentation.
  88 --      16 FEB 98   EDS   Modified test documentation.
  89 --      24 NOV 98   RLB   Changed Tenths'Small to 1.0/32.0, as this is
  90 --                        necessary so that all implementations can
  91 --                        process this test. (3.5.9(21) means non-binary
  92 --                        smalls are optional.)
  93 --      11 MAR 99   RLB   Merged versions. Most EDS changes removed (as
  94 --                        they made the test less applicable than the ACAA
  95 --                        version).
  96 --!
  97
  98 ----------------------------------------------------------------- CD10001_0
  99
 100 with System;
 101 with System.Storage_Elements;
 102 with Impdef;
 103 with SPPRT13;
 104 package CD10001_0 is
 105
 106   -- a few types and objects to work with.
 107
 108   type Int is range -2048 .. 2047;
 109   My_Int : Int := 1024;
 110
 111   type Enumeration is (First, Second, Third, Fourth, Fifth);
 112
 113   -- a few names that statically denote constants:
 114
 115   Nonstatic_Entity : constant System.Address :=                  -- Non-static
 116      System.Storage_Elements."+"
 117        ( SPPRT13.Variable_Address,
 118          System.Storage_Elements.Storage_Offset'(0) );
 119
 120   Tag_String : constant String := Impdef.External_Tag_Value;     -- Static
 121   -- Check to ensure that Tag_String is static
 122   Tag_String_Length : constant := Tag_String'Length;
 123
 124   A_Reasonable_Size_Value : constant := System.Storage_Unit;     -- Static
 125
 126   Zero  : constant := 0;                                         -- Static
 127   One   : constant := 1;                                         -- Static
 128   Two   : constant := 2;                                         -- Static
 129   Three : constant := 3;                                         -- Static
 130   Four  : constant := 4;                                         -- Static
 131   Five  : constant := 5;                                         -- Static
 132
 133   K : constant Int := My_Int;                                    -- Non-Static
 134
 135 --      Check that representation items containing nonstatic expressions are
 136 --      supported in the case that the representation item is a name that
 137 --      statically denotes a constant declared before the entity.
 138 --
 139 --        address clause
 140 --        Expression must be static - RM 13.3(12)
 141
 142   Object_Address : Enumeration;
 143     for Object_Address'Address use Nonstatic_Entity;          -- N/A => ERROR.
 144
 145 --        alignment clause
 146 --        Expression must be static - RM 13.3(25)
 147
 148   Object_Alignment : Enumeration;
 149     for Object_Alignment'Alignment use One;                   -- N/A => ERROR.
 150
 151 --        bit order clause
 152 -- no interesting test can be specified
 153
 154 --        component size clause
 155 --        Expression must be static - RM 13.3(69)
 156
 157   type Array_With_Components is array(1..10) of Enumeration;
 158     for Array_With_Components'Component_Size
 159       use A_Reasonable_Size_Value;                            -- N/A => ERROR.
 160
 161 --        enumeration representation clause
 162 --        Expressions must be static - RM 13.4(6)
 163
 164   type Enumeration_1 is (First, Second, Third);
 165   for Enumeration_1 use (First => One, Second => Two, Third => Three);
 166
 167 --        external tag clause
 168 --        Expression must be static - RM 13.3(75)
 169
 170   type Some_Tagged_Type is tagged null record;
 171     for Some_Tagged_Type'External_Tag use Tag_String;         -- N/A => ERROR.
 172
 173 --        Import, Export and Convention pragmas
 174 -- no interesting test can be specified
 175
 176 --        input clause
 177 -- no interesting test can be specified
 178
 179 --        output clause
 180 -- no interesting test can be specified
 181
 182 --        Pack pragma
 183 -- no interesting test can be specified
 184
 185 --        read clause
 186 -- no interesting test can be specified
 187
 188 --        record representation clause
 189 --        Expressions must be static - RM 13.3(10)
 190
 191   type Record_To_Layout is record
 192     Bit_0 : Boolean;
 193     Bit_1 : Boolean;
 194   end record;
 195     for Record_To_Layout use record                           -- N/A => ERROR.
 196       Bit_0 at Zero range Zero..Zero;                         -- N/A => ERROR.
 197       Bit_1 at Zero range Four..Four;                         -- N/A => ERROR.
 198     end record;                                               -- N/A => ERROR.
 199
 200 --        size clause
 201 --        Expression must be static - RM 13.3(41)
 202
 203   Object_Size : Enumeration;
 204     for Object_Size'Size use A_Reasonable_Size_Value;         -- N/A => ERROR.
 205
 206 --        small clause
 207 --        Expression must be static - RM 3.5.10(2)
 208
 209   type Tenths is delta 0.1 range 0.0..10.0;
 210     for Tenths'Small use 1.0 / (Two ** Five);                 -- N/A => ERROR.
 211
 212 --        storage pool clause
 213 --        Not tested
 214
 215 --        storage size clause
 216 --        Expression may be non-static - RM 13.11(15)
 217   type Reference is access Record_To_Layout;
 218     for Reference'Storage_Size use Four * K;                  -- N/A => ERROR.
 219
 220
 221 --        write clause
 222 -- no interesting test can be specified
 223
 224   procedure TC_Check_Values;
 225
 226 end CD10001_0;
 227
 228 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
 229
 230 with TCTouch;
 231 package body CD10001_0 is
 232
 233   use type System.Address;
 234
 235   procedure Assert( Truth : Boolean; Message: String ) is
 236   begin
 237     if not Truth then
 238       TCTouch.Implementation_Check( Message );
 239     end if;
 240   end Assert;
 241
 242   procedure TC_Check_Values is
 243     Record_Object : Record_To_Layout;
 244   begin
 245
 246     Assert(Object_Address'Address = Nonstatic_Entity,
 247            "Object not at specified address");
 248
 249     Assert(Object_Alignment'Alignment >= One,
 250            "Object not at specified alignment");
 251
 252     Assert(Array_With_Components'Component_Size = A_Reasonable_Size_Value,
 253            "Array Components not specified size");
 254
 255 -- I don't see how to reliably check this one:
 256 --
 257 --  type Enumeration_1 is (First, Second, Third);
 258 --  for Enumeration_1 use (First => One, Second => Two, Third => Three);
 259
 260     Assert(Some_Tagged_Type'External_Tag = Tag_String,
 261            "External_Tag not specified value");
 262     Assert(Record_Object.Bit_0'First_Bit = Zero,
 263           "Record object First_Bit not zero");
 264
 265     Assert(Record_Object.Bit_1'Last_Bit = Four,
 266           "Record object Last_Bit not four");
 267
 268     Assert(Object_Size'Size = A_Reasonable_Size_Value,
 269            "Object size not specified value");
 270
 271     Assert(Tenths'Small = 1.0 / Two ** Five,
 272            "Tenths small not specified value");
 273
 274     Assert(Reference'Storage_Size = 4096, -- Four * K,
 275            "Reference storage size not specified value");
 276
 277   end TC_Check_Values;
 278
 279 end CD10001_0;
 280
 281 ------------------------------------------------------------------- CD10001
 282
 283 with Report;
 284 with CD10001_0;
 285
 286 procedure CD10001 is
 287
 288 begin  -- Main test procedure.
 289
 290   Report.Test ("CD10001", "Check that representation items containing " &
 291                           "nonstatic expressions are supported in the " &
 292                           "case that the representation item is a name " &
 293                           "that statically denotes a constant declared " &
 294                           "before the entity" );
 295
 296   CD10001_0.TC_Check_Values;
 297
 298   Report.Result;
 299
 300 end CD10001;