CbC/CbC_gcc: gcc/testsuite/ada/acats/tests/cd/cd30001.a comparison

comparison gcc/testsuite/ada/acats/tests/cd/cd30001.a @ 111:04ced10e8804

gcc 7

author	kono
date	Fri, 27 Oct 2017 22:46:09 +0900
parents
children

comparison

equal deleted inserted replaced

-:561a7518be6b
+:04ced10e8804
+-- 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;

Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cd/cd30001.a @ 111:04ced10e8804