From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/ada/acats/tests/cd/cd30001.a | 284 +++++++++++++++++++++++++++++ 1 file changed, 284 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/cd/cd30001.a (limited to 'gcc/testsuite/ada/acats/tests/cd/cd30001.a') diff --git a/gcc/testsuite/ada/acats/tests/cd/cd30001.a b/gcc/testsuite/ada/acats/tests/cd/cd30001.a new file mode 100644 index 000000000..d65e14508 --- /dev/null +++ b/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; -- cgit v1.2.3