Subversion Repositories openrisc_me

-- 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;