URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cd/] [cd30001.a] - Rev 816
Compare with Previous | Blame | View Log
-- 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;