-- CD30001.A
|
-- CD30001.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- 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
|
-- 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 in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- 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
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- Check that X'Address produces a useful result when X is an aliased
|
-- Check that X'Address produces a useful result when X is an aliased
|
-- object.
|
-- object.
|
-- Check that X'Address produces a useful result when X is an object of
|
-- Check that X'Address produces a useful result when X is an object of
|
-- a by-reference type.
|
-- a by-reference type.
|
-- Check that X'Address produces a useful result when X is an entity
|
-- Check that X'Address produces a useful result when X is an entity
|
-- whose Address has been specified.
|
-- whose Address has been specified.
|
--
|
--
|
-- Check that aliased objects and subcomponents are allocated on storage
|
-- Check that aliased objects and subcomponents are allocated on storage
|
-- element boundaries. Check that objects and subcomponents of by
|
-- element boundaries. Check that objects and subcomponents of by
|
-- reference types are allocated on storage element boundaries.
|
-- reference types are allocated on storage element boundaries.
|
--
|
--
|
-- Check that for an array X, X'Address points at the first component
|
-- Check that for an array X, X'Address points at the first component
|
-- of the array, and not at the array bounds.
|
-- of the array, and not at the array bounds.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- This test defines a data structure (an array of records) where each
|
-- This test defines a data structure (an array of records) where each
|
-- aspect of the data structure is aliased. The test checks 'Address
|
-- aspect of the data structure is aliased. The test checks 'Address
|
-- for each "layer" of aliased objects.
|
-- for each "layer" of aliased objects.
|
--
|
--
|
-- APPLICABILITY CRITERIA:
|
-- APPLICABILITY CRITERIA:
|
-- All implementations must attempt to compile this test.
|
-- All implementations must attempt to compile this test.
|
--
|
--
|
-- For implementations validating against Systems Programming Annex (C):
|
-- For implementations validating against Systems Programming Annex (C):
|
-- this test must execute and report PASSED.
|
-- this test must execute and report PASSED.
|
--
|
--
|
-- For implementations not validating against Annex C:
|
-- For implementations not validating against Annex C:
|
-- this test may report compile time errors at one or more points
|
-- 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.
|
-- indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
|
-- Otherwise, the test must execute and report PASSED.
|
-- Otherwise, the test must execute and report PASSED.
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 22 JUL 95 SAIC Initial version
|
-- 22 JUL 95 SAIC Initial version
|
-- 08 MAY 96 SAIC Reinforced for 2.1
|
-- 08 MAY 96 SAIC Reinforced for 2.1
|
-- 16 FEB 98 EDS Modified documentation
|
-- 16 FEB 98 EDS Modified documentation
|
--!
|
--!
|
|
|
----------------------------------------------------------------- CD30001_0
|
----------------------------------------------------------------- CD30001_0
|
|
|
with SPPRT13;
|
with SPPRT13;
|
package CD30001_0 is
|
package CD30001_0 is
|
|
|
-- Check that X'Address produces a useful result when X is an aliased
|
-- Check that X'Address produces a useful result when X is an aliased
|
-- object.
|
-- object.
|
-- Check that X'Address produces a useful result when X is an object of
|
-- Check that X'Address produces a useful result when X is an object of
|
-- a by-reference type.
|
-- a by-reference type.
|
-- Check that X'Address produces a useful result when X is an entity
|
-- Check that X'Address produces a useful result when X is an entity
|
-- whose Address has been specified.
|
-- whose Address has been specified.
|
-- (using the new form of "for X'Address use ...")
|
-- (using the new form of "for X'Address use ...")
|
--
|
--
|
-- Check that aliased objects and subcomponents are allocated on storage
|
-- Check that aliased objects and subcomponents are allocated on storage
|
-- element boundaries. Check that objects and subcomponents of by
|
-- element boundaries. Check that objects and subcomponents of by
|
-- reference types are allocated on storage element boundaries.
|
-- reference types are allocated on storage element boundaries.
|
|
|
type Simple_Enum_Type is (Just, A, Little, Bit);
|
type Simple_Enum_Type is (Just, A, Little, Bit);
|
|
|
type Data is record
|
type Data is record
|
Aliased_Comp_1 : aliased Simple_Enum_Type;
|
Aliased_Comp_1 : aliased Simple_Enum_Type;
|
Aliased_Comp_2 : aliased Simple_Enum_Type;
|
Aliased_Comp_2 : aliased Simple_Enum_Type;
|
end record;
|
end record;
|
|
|
type Array_W_Aliased_Comps is array(1..2) of aliased Data;
|
type Array_W_Aliased_Comps is array(1..2) of aliased Data;
|
|
|
Aliased_Object : aliased Array_W_Aliased_Comps;
|
Aliased_Object : aliased Array_W_Aliased_Comps;
|
|
|
Specific_Object : aliased Array_W_Aliased_Comps;
|
Specific_Object : aliased Array_W_Aliased_Comps;
|
for Specific_Object'Address use SPPRT13.Variable_Address2; -- ANX-C RQMT.
|
for Specific_Object'Address use SPPRT13.Variable_Address2; -- ANX-C RQMT.
|
|
|
procedure TC_Check_Aliased_Addresses;
|
procedure TC_Check_Aliased_Addresses;
|
|
|
procedure TC_Check_Specific_Addresses;
|
procedure TC_Check_Specific_Addresses;
|
|
|
procedure TC_Check_By_Reference_Types;
|
procedure TC_Check_By_Reference_Types;
|
|
|
end CD30001_0;
|
end CD30001_0;
|
|
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
|
|
with Report;
|
with Report;
|
with System.Storage_Elements;
|
with System.Storage_Elements;
|
with System.Address_To_Access_Conversions;
|
with System.Address_To_Access_Conversions;
|
package body CD30001_0 is
|
package body CD30001_0 is
|
|
|
package Simple_Enum_Type_Ref_Conv is
|
package Simple_Enum_Type_Ref_Conv is
|
new System.Address_To_Access_Conversions(Simple_Enum_Type);
|
new System.Address_To_Access_Conversions(Simple_Enum_Type);
|
|
|
package Data_Ref_Conv is new System.Address_To_Access_Conversions(Data);
|
package Data_Ref_Conv is new System.Address_To_Access_Conversions(Data);
|
|
|
package Array_W_Aliased_Comps_Ref_Conv is
|
package Array_W_Aliased_Comps_Ref_Conv is
|
new System.Address_To_Access_Conversions(Array_W_Aliased_Comps);
|
new System.Address_To_Access_Conversions(Array_W_Aliased_Comps);
|
|
|
use type System.Address;
|
use type System.Address;
|
use type System.Storage_Elements.Integer_Address;
|
use type System.Storage_Elements.Integer_Address;
|
use type System.Storage_Elements.Storage_Offset;
|
use type System.Storage_Elements.Storage_Offset;
|
|
|
procedure TC_Check_Aliased_Addresses is
|
procedure TC_Check_Aliased_Addresses is
|
use type Simple_Enum_Type_Ref_Conv.Object_Pointer;
|
use type Simple_Enum_Type_Ref_Conv.Object_Pointer;
|
use type Data_Ref_Conv.Object_Pointer;
|
use type Data_Ref_Conv.Object_Pointer;
|
use type Array_W_Aliased_Comps_Ref_Conv.Object_Pointer;
|
use type Array_W_Aliased_Comps_Ref_Conv.Object_Pointer;
|
|
|
begin
|
begin
|
|
|
-- Check the object Aliased_Object
|
-- Check the object Aliased_Object
|
|
|
if Aliased_Object'Address not in System.Address then
|
if Aliased_Object'Address not in System.Address then
|
Report.Failed("Aliased_Object'Address not an address");
|
Report.Failed("Aliased_Object'Address not an address");
|
end if;
|
end if;
|
|
|
if Array_W_Aliased_Comps_Ref_Conv.To_Pointer(Aliased_Object'Address)
|
if Array_W_Aliased_Comps_Ref_Conv.To_Pointer(Aliased_Object'Address)
|
/= Aliased_Object'Unchecked_Access then
|
/= Aliased_Object'Unchecked_Access then
|
Report.Failed
|
Report.Failed
|
("'Unchecked_Access does not match expected address value");
|
("'Unchecked_Access does not match expected address value");
|
end if;
|
end if;
|
|
|
-- Check the element Aliased_Object(1)
|
-- Check the element Aliased_Object(1)
|
|
|
if Data_Ref_Conv.To_Address( Aliased_Object(1)'Access )
|
if Data_Ref_Conv.To_Address( Aliased_Object(1)'Access )
|
/= Aliased_Object(1)'Address then
|
/= Aliased_Object(1)'Address then
|
Report.Failed
|
Report.Failed
|
("Array element 'Access does not match expected address value");
|
("Array element 'Access does not match expected address value");
|
end if;
|
end if;
|
|
|
-- Check that Array'Address points at the first component...
|
-- Check that Array'Address points at the first component...
|
|
|
if Array_W_Aliased_Comps_Ref_Conv.To_Address( Aliased_Object'Access )
|
if Array_W_Aliased_Comps_Ref_Conv.To_Address( Aliased_Object'Access )
|
/= Aliased_Object(1)'Address then
|
/= Aliased_Object(1)'Address then
|
Report.Failed
|
Report.Failed
|
("Address of array object does not equal address of first component");
|
("Address of array object does not equal address of first component");
|
end if;
|
end if;
|
|
|
-- Check the components of Aliased_Object(2)
|
-- Check the components of Aliased_Object(2)
|
|
|
if Simple_Enum_Type_Ref_Conv.To_Address(
|
if Simple_Enum_Type_Ref_Conv.To_Address(
|
Aliased_Object(2).Aliased_Comp_1'Unchecked_Access)
|
Aliased_Object(2).Aliased_Comp_1'Unchecked_Access)
|
not in System.Address then
|
not in System.Address then
|
Report.Failed("Component 2 'Unchecked_Access not a valid address");
|
Report.Failed("Component 2 'Unchecked_Access not a valid address");
|
end if;
|
end if;
|
|
|
if Aliased_Object(2).Aliased_Comp_2'Address not in System.Address then
|
if Aliased_Object(2).Aliased_Comp_2'Address not in System.Address then
|
Report.Failed("Component 2 not located at a valid address ");
|
Report.Failed("Component 2 not located at a valid address ");
|
end if;
|
end if;
|
|
|
end TC_Check_Aliased_Addresses;
|
end TC_Check_Aliased_Addresses;
|
|
|
procedure TC_Check_Specific_Addresses is
|
procedure TC_Check_Specific_Addresses is
|
use type System.Address;
|
use type System.Address;
|
use type System.Storage_Elements.Integer_Address;
|
use type System.Storage_Elements.Integer_Address;
|
use type Simple_Enum_Type_Ref_Conv.Object_Pointer;
|
use type Simple_Enum_Type_Ref_Conv.Object_Pointer;
|
use type Data_Ref_Conv.Object_Pointer;
|
use type Data_Ref_Conv.Object_Pointer;
|
use type Array_W_Aliased_Comps_Ref_Conv.Object_Pointer;
|
use type Array_W_Aliased_Comps_Ref_Conv.Object_Pointer;
|
begin
|
begin
|
|
|
-- Check the object Specific_Object
|
-- Check the object Specific_Object
|
|
|
if System.Storage_Elements.To_Integer(Specific_Object'Address)
|
if System.Storage_Elements.To_Integer(Specific_Object'Address)
|
/= System.Storage_Elements.To_Integer(SPPRT13.Variable_Address2) then
|
/= System.Storage_Elements.To_Integer(SPPRT13.Variable_Address2) then
|
Report.Failed
|
Report.Failed
|
("Specific_Object not at address specified in representation clause");
|
("Specific_Object not at address specified in representation clause");
|
end if;
|
end if;
|
|
|
if Array_W_Aliased_Comps_Ref_Conv.To_Pointer(SPPRT13.Variable_Address2)
|
if Array_W_Aliased_Comps_Ref_Conv.To_Pointer(SPPRT13.Variable_Address2)
|
/= Specific_Object'Unchecked_Access then
|
/= Specific_Object'Unchecked_Access then
|
Report.Failed("Specific_Object'Unchecked_Access not expected value");
|
Report.Failed("Specific_Object'Unchecked_Access not expected value");
|
end if;
|
end if;
|
|
|
-- Check the element Specific_Object(1)
|
-- Check the element Specific_Object(1)
|
|
|
if Data_Ref_Conv.To_Address( Specific_Object(1)'Access )
|
if Data_Ref_Conv.To_Address( Specific_Object(1)'Access )
|
/= Specific_Object(1)'Address then
|
/= Specific_Object(1)'Address then
|
Report.Failed
|
Report.Failed
|
("Specific Array element 'Access does not correspond to the "
|
("Specific Array element 'Access does not correspond to the "
|
& "elements 'Address");
|
& "elements 'Address");
|
end if;
|
end if;
|
|
|
-- Check that Array'Address points at the first component...
|
-- Check that Array'Address points at the first component...
|
|
|
if Array_W_Aliased_Comps_Ref_Conv.To_Address( Specific_Object'Access )
|
if Array_W_Aliased_Comps_Ref_Conv.To_Address( Specific_Object'Access )
|
/= Specific_Object(1)'Address then
|
/= Specific_Object(1)'Address then
|
Report.Failed
|
Report.Failed
|
("Address of array object does not equal address of first component");
|
("Address of array object does not equal address of first component");
|
end if;
|
end if;
|
|
|
-- Check the components of Specific_Object(2)
|
-- Check the components of Specific_Object(2)
|
|
|
if Simple_Enum_Type_Ref_Conv.To_Address(
|
if Simple_Enum_Type_Ref_Conv.To_Address(
|
Specific_Object(1).Aliased_Comp_1'Access)
|
Specific_Object(1).Aliased_Comp_1'Access)
|
not in System.Address then
|
not in System.Address then
|
Report.Failed("Access value of first record component for object at " &
|
Report.Failed("Access value of first record component for object at " &
|
"specific address not a valid address");
|
"specific address not a valid address");
|
end if;
|
end if;
|
|
|
if Specific_Object(2).Aliased_Comp_2'Address not in System.Address then
|
if Specific_Object(2).Aliased_Comp_2'Address not in System.Address then
|
Report.Failed("Second record component for object at specific " &
|
Report.Failed("Second record component for object at specific " &
|
"address not located at a valid address");
|
"address not located at a valid address");
|
end if;
|
end if;
|
|
|
end TC_Check_Specific_Addresses;
|
end TC_Check_Specific_Addresses;
|
|
|
-- Check that X'Address produces a useful result when X is an object of
|
-- Check that X'Address produces a useful result when X is an object of
|
-- a by-reference type.
|
-- a by-reference type.
|
|
|
type Tagged_But_Not_Exciting is tagged record
|
type Tagged_But_Not_Exciting is tagged record
|
A_Bit_Of_Data : Boolean;
|
A_Bit_Of_Data : Boolean;
|
end record;
|
end record;
|
|
|
Tagged_Object : Tagged_But_Not_Exciting;
|
Tagged_Object : Tagged_But_Not_Exciting;
|
|
|
procedure Muck_With_Addresses( It : in out Tagged_But_Not_Exciting;
|
procedure Muck_With_Addresses( It : in out Tagged_But_Not_Exciting;
|
Its_Address : in System.Address ) is
|
Its_Address : in System.Address ) is
|
begin
|
begin
|
if It'Address /= Its_Address then
|
if It'Address /= Its_Address then
|
Report.Failed("Address of object passed by reference does not " &
|
Report.Failed("Address of object passed by reference does not " &
|
"match address of object passed" );
|
"match address of object passed" );
|
end if;
|
end if;
|
end Muck_With_Addresses;
|
end Muck_With_Addresses;
|
|
|
procedure TC_Check_By_Reference_Types is
|
procedure TC_Check_By_Reference_Types is
|
begin
|
begin
|
Muck_With_Addresses( Tagged_Object, Tagged_Object'Address );
|
Muck_With_Addresses( Tagged_Object, Tagged_Object'Address );
|
end TC_Check_By_Reference_Types;
|
end TC_Check_By_Reference_Types;
|
|
|
end CD30001_0;
|
end CD30001_0;
|
|
|
------------------------------------------------------------------- CD30001
|
------------------------------------------------------------------- CD30001
|
|
|
with Report;
|
with Report;
|
with CD30001_0;
|
with CD30001_0;
|
procedure CD30001 is
|
procedure CD30001 is
|
|
|
begin -- Main test procedure.
|
begin -- Main test procedure.
|
|
|
Report.Test ("CD30001",
|
Report.Test ("CD30001",
|
"Check that X'Address produces a useful result when X is " &
|
"Check that X'Address produces a useful result when X is " &
|
"an aliased object, or an entity whose Address has been " &
|
"an aliased object, or an entity whose Address has been " &
|
"specified" );
|
"specified" );
|
|
|
-- Check that X'Address produces a useful result when X is an aliased
|
-- Check that X'Address produces a useful result when X is an aliased
|
-- object.
|
-- object.
|
--
|
--
|
-- Check that aliased objects and subcomponents are allocated on storage
|
-- Check that aliased objects and subcomponents are allocated on storage
|
-- element boundaries. Check that objects and subcomponents of by
|
-- element boundaries. Check that objects and subcomponents of by
|
-- reference types are allocated on storage element boundaries.
|
-- reference types are allocated on storage element boundaries.
|
|
|
CD30001_0.TC_Check_Aliased_Addresses;
|
CD30001_0.TC_Check_Aliased_Addresses;
|
|
|
-- Check that X'Address produces a useful result when X is an entity
|
-- Check that X'Address produces a useful result when X is an entity
|
-- whose Address has been specified.
|
-- whose Address has been specified.
|
|
|
CD30001_0.TC_Check_Specific_Addresses;
|
CD30001_0.TC_Check_Specific_Addresses;
|
|
|
-- Check that X'Address produces a useful result when X is an object of
|
-- Check that X'Address produces a useful result when X is an object of
|
-- a by-reference type.
|
-- a by-reference type.
|
|
|
CD30001_0.TC_Check_By_Reference_Types;
|
CD30001_0.TC_Check_By_Reference_Types;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end CD30001;
|
end CD30001;
|
|
|
