aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30001.a
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30001.a')
-rw-r--r--gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30001.a284
1 files changed, 284 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30001.a
new file mode 100644
index 000000000..d65e14508
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30001.a
@@ -0,0 +1,284 @@
+-- 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;