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

   1 -- CD30001.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 X'Address produces a useful result when X is an aliased
  28 --      object.
  29 --      Check that X'Address produces a useful result when X is an object of
  30 --      a by-reference type.
  31 --      Check that X'Address produces a useful result when X is an entity
  32 --      whose Address has been specified.
  33 --
  34 --      Check that aliased objects and subcomponents are allocated on storage
  35 --      element boundaries.  Check that objects and subcomponents of by
  36 --      reference types are allocated on storage element boundaries.
  37 --
  38 --      Check that for an array X, X'Address points at the first component
  39 --      of the array, and not at the array bounds.
  40 --
  41 -- TEST DESCRIPTION:
  42 --      This test defines a data structure (an array of records) where each
  43 --      aspect of the data structure is aliased.  The test checks 'Address
  44 --      for each "layer" of aliased objects.
  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 --      08 MAY 96   SAIC   Reinforced for 2.1
  61 --      16 FEB 98   EDS    Modified documentation
  62 --!
  63
  64 ----------------------------------------------------------------- CD30001_0
  65
  66 with SPPRT13;
  67 package CD30001_0 is
  68
  69   --    Check that X'Address produces a useful result when X is an aliased
  70   --    object.
  71   --    Check that X'Address produces a useful result when X is an object of
  72   --    a by-reference type.
  73   --    Check that X'Address produces a useful result when X is an entity
  74   --    whose Address has been specified.
  75   --    (using the new form of "for X'Address use ...")
  76   --
  77   --    Check that aliased objects and subcomponents are allocated on storage
  78   --    element boundaries.  Check that objects and subcomponents of by
  79   --    reference types are allocated on storage element boundaries.
  80
  81   type Simple_Enum_Type is (Just, A, Little, Bit);
  82
  83   type Data is record
  84     Aliased_Comp_1 : aliased Simple_Enum_Type;
  85     Aliased_Comp_2 : aliased Simple_Enum_Type;
  86   end record;
  87
  88   type Array_W_Aliased_Comps is array(1..2) of aliased Data;
  89
  90   Aliased_Object  : aliased Array_W_Aliased_Comps;
  91
  92   Specific_Object : aliased Array_W_Aliased_Comps;
  93   for Specific_Object'Address use SPPRT13.Variable_Address2;  -- ANX-C RQMT.
  94
  95   procedure TC_Check_Aliased_Addresses;
  96
  97   procedure TC_Check_Specific_Addresses;
  98
  99   procedure TC_Check_By_Reference_Types;
 100
 101 end CD30001_0;
 102
 103 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
 104
 105 with Report;
 106 with System.Storage_Elements;
 107 with System.Address_To_Access_Conversions;
 108 package body CD30001_0 is
 109
 110   package Simple_Enum_Type_Ref_Conv is
 111     new System.Address_To_Access_Conversions(Simple_Enum_Type);
 112
 113   package Data_Ref_Conv is new System.Address_To_Access_Conversions(Data);
 114
 115   package Array_W_Aliased_Comps_Ref_Conv is
 116     new System.Address_To_Access_Conversions(Array_W_Aliased_Comps);
 117
 118   use type System.Address;
 119   use type System.Storage_Elements.Integer_Address;
 120   use type System.Storage_Elements.Storage_Offset;
 121
 122   procedure TC_Check_Aliased_Addresses is
 123     use type Simple_Enum_Type_Ref_Conv.Object_Pointer;
 124     use type Data_Ref_Conv.Object_Pointer;
 125     use type Array_W_Aliased_Comps_Ref_Conv.Object_Pointer;
 126
 127   begin
 128
 129     -- Check the object Aliased_Object
 130
 131     if Aliased_Object'Address not in System.Address then
 132       Report.Failed("Aliased_Object'Address not an address");
 133     end if;
 134
 135     if Array_W_Aliased_Comps_Ref_Conv.To_Pointer(Aliased_Object'Address)
 136        /= Aliased_Object'Unchecked_Access then
 137       Report.Failed
 138                   ("'Unchecked_Access does not match expected address value");
 139     end if;
 140
 141     -- Check the element Aliased_Object(1)
 142
 143     if Data_Ref_Conv.To_Address( Aliased_Object(1)'Access )
 144        /= Aliased_Object(1)'Address then
 145       Report.Failed
 146              ("Array element 'Access does not match expected address value");
 147     end if;
 148
 149     -- Check that Array'Address points at the first component...
 150
 151     if Array_W_Aliased_Comps_Ref_Conv.To_Address( Aliased_Object'Access )
 152        /= Aliased_Object(1)'Address then
 153       Report.Failed
 154         ("Address of array object does not equal address of first component");
 155     end if;
 156
 157     -- Check the components of Aliased_Object(2)
 158
 159     if Simple_Enum_Type_Ref_Conv.To_Address(
 160                           Aliased_Object(2).Aliased_Comp_1'Unchecked_Access)
 161        not in System.Address then
 162       Report.Failed("Component 2 'Unchecked_Access not a valid address");
 163     end if;
 164
 165     if Aliased_Object(2).Aliased_Comp_2'Address not in System.Address then
 166       Report.Failed("Component 2 not located at a valid address ");
 167     end if;
 168
 169   end TC_Check_Aliased_Addresses;
 170
 171   procedure TC_Check_Specific_Addresses is
 172     use type System.Address;
 173     use type System.Storage_Elements.Integer_Address;
 174     use type Simple_Enum_Type_Ref_Conv.Object_Pointer;
 175     use type Data_Ref_Conv.Object_Pointer;
 176     use type Array_W_Aliased_Comps_Ref_Conv.Object_Pointer;
 177   begin
 178
 179     -- Check the object Specific_Object
 180
 181     if System.Storage_Elements.To_Integer(Specific_Object'Address)
 182        /= System.Storage_Elements.To_Integer(SPPRT13.Variable_Address2) then
 183       Report.Failed
 184         ("Specific_Object not at address specified in representation clause");
 185     end if;
 186
 187     if Array_W_Aliased_Comps_Ref_Conv.To_Pointer(SPPRT13.Variable_Address2)
 188        /= Specific_Object'Unchecked_Access then
 189       Report.Failed("Specific_Object'Unchecked_Access not expected value");
 190     end if;
 191
 192     -- Check the element Specific_Object(1)
 193
 194     if Data_Ref_Conv.To_Address( Specific_Object(1)'Access )
 195        /= Specific_Object(1)'Address then
 196       Report.Failed
 197         ("Specific Array element 'Access does not correspond to the "
 198          & "elements 'Address");
 199     end if;
 200
 201     -- Check that Array'Address points at the first component...
 202
 203     if Array_W_Aliased_Comps_Ref_Conv.To_Address( Specific_Object'Access )
 204        /= Specific_Object(1)'Address then
 205       Report.Failed
 206         ("Address of array object does not equal address of first component");
 207     end if;
 208
 209     -- Check the components of Specific_Object(2)
 210
 211     if Simple_Enum_Type_Ref_Conv.To_Address(
 212                                     Specific_Object(1).Aliased_Comp_1'Access)
 213                                                     not in System.Address then
 214       Report.Failed("Access value of first record component for object at " &
 215                     "specific address not a valid address");
 216     end if;
 217
 218     if Specific_Object(2).Aliased_Comp_2'Address not in System.Address then
 219       Report.Failed("Second record component for object at specific " &
 220                     "address not located at a valid address");
 221     end if;
 222
 223   end TC_Check_Specific_Addresses;
 224
 225 --      Check that X'Address produces a useful result when X is an object of
 226 --      a by-reference type.
 227
 228     type Tagged_But_Not_Exciting is tagged record
 229       A_Bit_Of_Data : Boolean;
 230     end record;
 231
 232     Tagged_Object : Tagged_But_Not_Exciting;
 233
 234   procedure Muck_With_Addresses( It : in out Tagged_But_Not_Exciting;
 235                                  Its_Address : in System.Address ) is
 236   begin
 237     if It'Address /= Its_Address then
 238       Report.Failed("Address of object passed by reference does not " &
 239                     "match address of object passed" );
 240     end if;
 241   end Muck_With_Addresses;
 242
 243   procedure TC_Check_By_Reference_Types is
 244   begin
 245     Muck_With_Addresses( Tagged_Object, Tagged_Object'Address );
 246   end TC_Check_By_Reference_Types;
 247
 248 end CD30001_0;
 249
 250 ------------------------------------------------------------------- CD30001
 251
 252 with Report;
 253 with CD30001_0;
 254 procedure CD30001 is
 255
 256 begin  -- Main test procedure.
 257
 258   Report.Test ("CD30001",
 259                "Check that X'Address produces a useful result when X is " &
 260                "an aliased object, or an entity whose Address has been " &
 261                "specified" );
 262
 263 --      Check that X'Address produces a useful result when X is an aliased
 264 --      object.
 265 --
 266 --      Check that aliased objects and subcomponents are allocated on storage
 267 --      element boundaries.  Check that objects and subcomponents of by
 268 --      reference types are allocated on storage element boundaries.
 269
 270   CD30001_0.TC_Check_Aliased_Addresses;
 271
 272 --      Check that X'Address produces a useful result when X is an entity
 273 --      whose Address has been specified.
 274
 275   CD30001_0.TC_Check_Specific_Addresses;
 276
 277 --      Check that X'Address produces a useful result when X is an object of
 278 --      a by-reference type.
 279
 280   CD30001_0.TC_Check_By_Reference_Types;
 281
 282   Report.Result;
 283
 284 end CD30001;