| -- CD30001.A |
| -- |
| -- Grant of Unlimited Rights |
| -- |
| -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, |
| -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained |
| -- unlimited rights in the software and documentation contained herein. |
| -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making |
| -- this public release, the Government intends to confer upon all |
| -- recipients unlimited rights equal to those held by the Government. |
| -- These rights include rights to use, duplicate, release or disclose the |
| -- released technical data and computer software in whole or in part, in |
| -- any manner and for any purpose whatsoever, and to have or permit others |
| -- to do so. |
| -- |
| -- DISCLAIMER |
| -- |
| -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR |
| -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED |
| -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE |
| -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE |
| -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A |
| -- PARTICULAR PURPOSE OF SAID MATERIAL. |
| --* |
| -- |
| -- OBJECTIVE: |
| -- Check that X'Address produces a useful result when X is an aliased |
| -- object. |
| -- Check that X'Address produces a useful result when X is an object of |
| -- a by-reference type. |
| -- Check that X'Address produces a useful result when X is an entity |
| -- whose Address has been specified. |
| -- |
| -- Check that aliased objects and subcomponents are allocated on storage |
| -- element boundaries. Check that objects and subcomponents of by |
| -- reference types are allocated on storage element boundaries. |
| -- |
| -- Check that for an array X, X'Address points at the first component |
| -- of the array, and not at the array bounds. |
| -- |
| -- TEST DESCRIPTION: |
| -- This test defines a data structure (an array of records) where each |
| -- aspect of the data structure is aliased. The test checks 'Address |
| -- for each "layer" of aliased objects. |
| -- |
| -- APPLICABILITY CRITERIA: |
| -- All implementations must attempt to compile this test. |
| -- |
| -- For implementations validating against Systems Programming Annex (C): |
| -- this test must execute and report PASSED. |
| -- |
| -- For implementations not validating against Annex C: |
| -- this test may report compile time errors at one or more points |
| -- indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable. |
| -- Otherwise, the test must execute and report PASSED. |
| -- |
| -- |
| -- CHANGE HISTORY: |
| -- 22 JUL 95 SAIC Initial version |
| -- 08 MAY 96 SAIC Reinforced for 2.1 |
| -- 16 FEB 98 EDS Modified documentation |
| --! |
| |
| ----------------------------------------------------------------- CD30001_0 |
| |
| with SPPRT13; |
| package CD30001_0 is |
| |
| -- Check that X'Address produces a useful result when X is an aliased |
| -- object. |
| -- Check that X'Address produces a useful result when X is an object of |
| -- a by-reference type. |
| -- Check that X'Address produces a useful result when X is an entity |
| -- whose Address has been specified. |
| -- (using the new form of "for X'Address use ...") |
| -- |
| -- Check that aliased objects and subcomponents are allocated on storage |
| -- element boundaries. Check that objects and subcomponents of by |
| -- reference types are allocated on storage element boundaries. |
| |
| type Simple_Enum_Type is (Just, A, Little, Bit); |
| |
| type Data is record |
| Aliased_Comp_1 : aliased Simple_Enum_Type; |
| Aliased_Comp_2 : aliased Simple_Enum_Type; |
| end record; |
| |
| type Array_W_Aliased_Comps is array(1..2) of aliased Data; |
| |
| Aliased_Object : aliased Array_W_Aliased_Comps; |
| |
| Specific_Object : aliased Array_W_Aliased_Comps; |
| for Specific_Object'Address use SPPRT13.Variable_Address2; -- ANX-C RQMT. |
| |
| procedure TC_Check_Aliased_Addresses; |
| |
| procedure TC_Check_Specific_Addresses; |
| |
| procedure TC_Check_By_Reference_Types; |
| |
| end CD30001_0; |
| |
| -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- |
| |
| with Report; |
| with System.Storage_Elements; |
| with System.Address_To_Access_Conversions; |
| package body CD30001_0 is |
| |
| package Simple_Enum_Type_Ref_Conv is |
| new System.Address_To_Access_Conversions(Simple_Enum_Type); |
| |
| package Data_Ref_Conv is new System.Address_To_Access_Conversions(Data); |
| |
| package Array_W_Aliased_Comps_Ref_Conv is |
| new System.Address_To_Access_Conversions(Array_W_Aliased_Comps); |
| |
| use type System.Address; |
| use type System.Storage_Elements.Integer_Address; |
| use type System.Storage_Elements.Storage_Offset; |
| |
| procedure TC_Check_Aliased_Addresses is |
| use type Simple_Enum_Type_Ref_Conv.Object_Pointer; |
| use type Data_Ref_Conv.Object_Pointer; |
| use type Array_W_Aliased_Comps_Ref_Conv.Object_Pointer; |
| |
| begin |
| |
| -- Check the object Aliased_Object |
| |
| if Aliased_Object'Address not in System.Address then |
| Report.Failed("Aliased_Object'Address not an address"); |
| end if; |
| |
| if Array_W_Aliased_Comps_Ref_Conv.To_Pointer(Aliased_Object'Address) |
| /= Aliased_Object'Unchecked_Access then |
| Report.Failed |
| ("'Unchecked_Access does not match expected address value"); |
| end if; |
| |
| -- Check the element Aliased_Object(1) |
| |
| if Data_Ref_Conv.To_Address( Aliased_Object(1)'Access ) |
| /= Aliased_Object(1)'Address then |
| Report.Failed |
| ("Array element 'Access does not match expected address value"); |
| end if; |
| |
| -- Check that Array'Address points at the first component... |
| |
| if Array_W_Aliased_Comps_Ref_Conv.To_Address( Aliased_Object'Access ) |
| /= Aliased_Object(1)'Address then |
| Report.Failed |
| ("Address of array object does not equal address of first component"); |
| end if; |
| |
| -- Check the components of Aliased_Object(2) |
| |
| if Simple_Enum_Type_Ref_Conv.To_Address( |
| Aliased_Object(2).Aliased_Comp_1'Unchecked_Access) |
| not in System.Address then |
| Report.Failed("Component 2 'Unchecked_Access not a valid address"); |
| end if; |
| |
| if Aliased_Object(2).Aliased_Comp_2'Address not in System.Address then |
| Report.Failed("Component 2 not located at a valid address "); |
| end if; |
| |
| end TC_Check_Aliased_Addresses; |
| |
| procedure TC_Check_Specific_Addresses is |
| use type System.Address; |
| use type System.Storage_Elements.Integer_Address; |
| use type Simple_Enum_Type_Ref_Conv.Object_Pointer; |
| use type Data_Ref_Conv.Object_Pointer; |
| use type Array_W_Aliased_Comps_Ref_Conv.Object_Pointer; |
| begin |
| |
| -- Check the object Specific_Object |
| |
| if System.Storage_Elements.To_Integer(Specific_Object'Address) |
| /= System.Storage_Elements.To_Integer(SPPRT13.Variable_Address2) then |
| Report.Failed |
| ("Specific_Object not at address specified in representation clause"); |
| end if; |
| |
| if Array_W_Aliased_Comps_Ref_Conv.To_Pointer(SPPRT13.Variable_Address2) |
| /= Specific_Object'Unchecked_Access then |
| Report.Failed("Specific_Object'Unchecked_Access not expected value"); |
| end if; |
| |
| -- Check the element Specific_Object(1) |
| |
| if Data_Ref_Conv.To_Address( Specific_Object(1)'Access ) |
| /= Specific_Object(1)'Address then |
| Report.Failed |
| ("Specific Array element 'Access does not correspond to the " |
| & "elements 'Address"); |
| end if; |
| |
| -- Check that Array'Address points at the first component... |
| |
| if Array_W_Aliased_Comps_Ref_Conv.To_Address( Specific_Object'Access ) |
| /= Specific_Object(1)'Address then |
| Report.Failed |
| ("Address of array object does not equal address of first component"); |
| end if; |
| |
| -- Check the components of Specific_Object(2) |
| |
| if Simple_Enum_Type_Ref_Conv.To_Address( |
| Specific_Object(1).Aliased_Comp_1'Access) |
| not in System.Address then |
| Report.Failed("Access value of first record component for object at " & |
| "specific address not a valid address"); |
| end if; |
| |
| if Specific_Object(2).Aliased_Comp_2'Address not in System.Address then |
| Report.Failed("Second record component for object at specific " & |
| "address not located at a valid address"); |
| end if; |
| |
| end TC_Check_Specific_Addresses; |
| |
| -- Check that X'Address produces a useful result when X is an object of |
| -- a by-reference type. |
| |
| type Tagged_But_Not_Exciting is tagged record |
| A_Bit_Of_Data : Boolean; |
| end record; |
| |
| Tagged_Object : Tagged_But_Not_Exciting; |
| |
| procedure Muck_With_Addresses( It : in out Tagged_But_Not_Exciting; |
| Its_Address : in System.Address ) is |
| begin |
| if It'Address /= Its_Address then |
| Report.Failed("Address of object passed by reference does not " & |
| "match address of object passed" ); |
| end if; |
| end Muck_With_Addresses; |
| |
| procedure TC_Check_By_Reference_Types is |
| begin |
| Muck_With_Addresses( Tagged_Object, Tagged_Object'Address ); |
| end TC_Check_By_Reference_Types; |
| |
| end CD30001_0; |
| |
| ------------------------------------------------------------------- CD30001 |
| |
| with Report; |
| with CD30001_0; |
| procedure CD30001 is |
| |
| begin -- Main test procedure. |
| |
| Report.Test ("CD30001", |
| "Check that X'Address produces a useful result when X is " & |
| "an aliased object, or an entity whose Address has been " & |
| "specified" ); |
| |
| -- Check that X'Address produces a useful result when X is an aliased |
| -- object. |
| -- |
| -- Check that aliased objects and subcomponents are allocated on storage |
| -- element boundaries. Check that objects and subcomponents of by |
| -- reference types are allocated on storage element boundaries. |
| |
| CD30001_0.TC_Check_Aliased_Addresses; |
| |
| -- Check that X'Address produces a useful result when X is an entity |
| -- whose Address has been specified. |
| |
| CD30001_0.TC_Check_Specific_Addresses; |
| |
| -- Check that X'Address produces a useful result when X is an object of |
| -- a by-reference type. |
| |
| CD30001_0.TC_Check_By_Reference_Types; |
| |
| Report.Result; |
| |
| end CD30001; |
