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 66with SPPRT13; 67package 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 101end CD30001_0; 102 103-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- 104 105with Report; 106with System.Storage_Elements; 107with System.Address_To_Access_Conversions; 108package 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 248end CD30001_0; 249 250------------------------------------------------------------------- CD30001 251 252with Report; 253with CD30001_0; 254procedure CD30001 is 255 256begin -- 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 284end CD30001; 285