-- C360002.A
|
-- C360002.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 modular types may be used as array indices.
|
-- Check that modular types may be used as array indices.
|
--
|
--
|
-- Check that if aliased appears in the component_definition of an
|
-- Check that if aliased appears in the component_definition of an
|
-- array_type that each component of the array is aliased.
|
-- array_type that each component of the array is aliased.
|
--
|
--
|
-- Check that references to aliased array objects produce correct
|
-- Check that references to aliased array objects produce correct
|
-- results, and that out-of-bounds indexing correctly produces
|
-- results, and that out-of-bounds indexing correctly produces
|
-- Constraint_Error.
|
-- Constraint_Error.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- This test defines several array types and subtypes indexed by modular
|
-- This test defines several array types and subtypes indexed by modular
|
-- types; some aliased some not, some with aliased components, some not.
|
-- types; some aliased some not, some with aliased components, some not.
|
--
|
--
|
-- It then checks that assignments move the correct data.
|
-- It then checks that assignments move the correct data.
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 28 SEP 95 SAIC Initial version
|
-- 28 SEP 95 SAIC Initial version
|
-- 23 APR 96 SAIC Doc fixes, fixed constrained/unconstrained conflict
|
-- 23 APR 96 SAIC Doc fixes, fixed constrained/unconstrained conflict
|
-- 13 FEB 97 PWB.CTA Removed illegal declarations and affected code
|
-- 13 FEB 97 PWB.CTA Removed illegal declarations and affected code
|
--!
|
--!
|
|
|
------------------------------------------------------------------- C360002
|
------------------------------------------------------------------- C360002
|
|
|
with Report;
|
with Report;
|
|
|
procedure C360002 is
|
procedure C360002 is
|
|
|
Verbose : Boolean := Report.Ident_Bool( False );
|
Verbose : Boolean := Report.Ident_Bool( False );
|
|
|
type Mod_128 is mod 128;
|
type Mod_128 is mod 128;
|
|
|
function Ident_128( I: Integer ) return Mod_128 is
|
function Ident_128( I: Integer ) return Mod_128 is
|
begin
|
begin
|
return Mod_128( Report.Ident_Int( I ) );
|
return Mod_128( Report.Ident_Int( I ) );
|
end Ident_128;
|
end Ident_128;
|
|
|
type Unconstrained_Array
|
type Unconstrained_Array
|
is array( Mod_128 range <> ) of Integer;
|
is array( Mod_128 range <> ) of Integer;
|
|
|
type Unconstrained_Array_Aliased
|
type Unconstrained_Array_Aliased
|
is array( Mod_128 range <> ) of aliased Integer;
|
is array( Mod_128 range <> ) of aliased Integer;
|
|
|
type Access_All_Unconstrained_Array
|
type Access_All_Unconstrained_Array
|
is access all Unconstrained_Array;
|
is access all Unconstrained_Array;
|
|
|
type Access_All_Unconstrained_Array_Aliased
|
type Access_All_Unconstrained_Array_Aliased
|
is access all Unconstrained_Array_Aliased;
|
is access all Unconstrained_Array_Aliased;
|
|
|
subtype Array_01_10
|
subtype Array_01_10
|
is Unconstrained_Array(01..10);
|
is Unconstrained_Array(01..10);
|
|
|
subtype Array_11_20
|
subtype Array_11_20
|
is Unconstrained_Array(11..20);
|
is Unconstrained_Array(11..20);
|
|
|
subtype Array_Aliased_01_10
|
subtype Array_Aliased_01_10
|
is Unconstrained_Array_Aliased(01..10);
|
is Unconstrained_Array_Aliased(01..10);
|
|
|
subtype Array_Aliased_11_20
|
subtype Array_Aliased_11_20
|
is Unconstrained_Array_Aliased(11..20);
|
is Unconstrained_Array_Aliased(11..20);
|
|
|
subtype Access_All_01_10_Array
|
subtype Access_All_01_10_Array
|
is Access_All_Unconstrained_Array(01..10);
|
is Access_All_Unconstrained_Array(01..10);
|
|
|
subtype Access_All_01_10_Array_Aliased
|
subtype Access_All_01_10_Array_Aliased
|
is Access_All_Unconstrained_Array_Aliased(01..10);
|
is Access_All_Unconstrained_Array_Aliased(01..10);
|
|
|
subtype Access_All_11_20_Array
|
subtype Access_All_11_20_Array
|
is Access_All_Unconstrained_Array(11..20);
|
is Access_All_Unconstrained_Array(11..20);
|
|
|
subtype Access_All_11_20_Array_Aliased
|
subtype Access_All_11_20_Array_Aliased
|
is Access_All_Unconstrained_Array_Aliased(11..20);
|
is Access_All_Unconstrained_Array_Aliased(11..20);
|
|
|
|
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
|
|
-- these 'filler' functions create unique values for every element that
|
-- these 'filler' functions create unique values for every element that
|
-- is used and/or tested in this test.
|
-- is used and/or tested in this test.
|
|
|
Well_Bottom : Integer := 0;
|
Well_Bottom : Integer := 0;
|
|
|
function Filler( Size : Mod_128 ) return Unconstrained_Array is
|
function Filler( Size : Mod_128 ) return Unconstrained_Array is
|
It : Unconstrained_Array( 0..Size-1 );
|
It : Unconstrained_Array( 0..Size-1 );
|
begin
|
begin
|
for Eyes in It'Range loop
|
for Eyes in It'Range loop
|
It(Eyes) := Integer( Eyes ) + Well_Bottom;
|
It(Eyes) := Integer( Eyes ) + Well_Bottom;
|
end loop;
|
end loop;
|
Well_Bottom := Well_Bottom + It'Length;
|
Well_Bottom := Well_Bottom + It'Length;
|
return It;
|
return It;
|
end Filler;
|
end Filler;
|
|
|
function Filler( Size : Mod_128 ) return Unconstrained_Array_Aliased is
|
function Filler( Size : Mod_128 ) return Unconstrained_Array_Aliased is
|
It : Unconstrained_Array_Aliased( 0..Size-1 );
|
It : Unconstrained_Array_Aliased( 0..Size-1 );
|
begin
|
begin
|
for Ayes in It'Range loop
|
for Ayes in It'Range loop
|
It(Ayes) := Integer( Ayes ) + Well_Bottom;
|
It(Ayes) := Integer( Ayes ) + Well_Bottom;
|
end loop;
|
end loop;
|
Well_Bottom := Well_Bottom + It'Length;
|
Well_Bottom := Well_Bottom + It'Length;
|
return It;
|
return It;
|
end Filler;
|
end Filler;
|
|
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
|
|
An_Integer : Integer;
|
An_Integer : Integer;
|
|
|
type AAI is access all Integer;
|
type AAI is access all Integer;
|
|
|
An_Integer_Access : AAI;
|
An_Integer_Access : AAI;
|
|
|
Array_Item_01_10 : Array_01_10 := Filler(10); -- 0..9
|
Array_Item_01_10 : Array_01_10 := Filler(10); -- 0..9
|
|
|
Array_Item_11_20 : Array_11_20 := Filler(10); -- 10..19 (sliding)
|
Array_Item_11_20 : Array_11_20 := Filler(10); -- 10..19 (sliding)
|
|
|
Array_Aliased_Item_01_10 : Array_Aliased_01_10 := Filler(10); -- 20..29
|
Array_Aliased_Item_01_10 : Array_Aliased_01_10 := Filler(10); -- 20..29
|
|
|
Array_Aliased_Item_11_20 : Array_Aliased_11_20 := Filler(10); -- 30..39
|
Array_Aliased_Item_11_20 : Array_Aliased_11_20 := Filler(10); -- 30..39
|
|
|
Aliased_Array_Item_01_10 : aliased Array_01_10 := Filler(10); -- 40..49
|
Aliased_Array_Item_01_10 : aliased Array_01_10 := Filler(10); -- 40..49
|
|
|
Aliased_Array_Item_11_20 : aliased Array_11_20 := Filler(10); -- 50..59
|
Aliased_Array_Item_11_20 : aliased Array_11_20 := Filler(10); -- 50..59
|
|
|
Aliased_Array_Aliased_Item_01_10 : aliased Array_Aliased_01_10
|
Aliased_Array_Aliased_Item_01_10 : aliased Array_Aliased_01_10
|
:= Filler(10); -- 60..69
|
:= Filler(10); -- 60..69
|
|
|
Aliased_Array_Aliased_Item_11_20 : aliased Array_Aliased_11_20
|
Aliased_Array_Aliased_Item_11_20 : aliased Array_Aliased_11_20
|
:= Filler(10); -- 70..79
|
:= Filler(10); -- 70..79
|
|
|
Check_Item : Access_All_Unconstrained_Array;
|
Check_Item : Access_All_Unconstrained_Array;
|
|
|
Check_Aliased_Item : Access_All_Unconstrained_Array_Aliased;
|
Check_Aliased_Item : Access_All_Unconstrained_Array_Aliased;
|
|
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
|
|
procedure Fail( Message : String; CI, SB : Integer ) is
|
procedure Fail( Message : String; CI, SB : Integer ) is
|
begin
|
begin
|
Report.Failed("Wrong value passed " & Message);
|
Report.Failed("Wrong value passed " & Message);
|
if Verbose then
|
if Verbose then
|
Report.Comment("got" & Integer'Image(CI) &
|
Report.Comment("got" & Integer'Image(CI) &
|
" should be" & Integer'Image(SB) );
|
" should be" & Integer'Image(SB) );
|
end if;
|
end if;
|
end Fail;
|
end Fail;
|
|
|
procedure Check_Array_01_10( Checked_Item : Array_01_10;
|
procedure Check_Array_01_10( Checked_Item : Array_01_10;
|
Low_SB : Integer ) is
|
Low_SB : Integer ) is
|
begin
|
begin
|
for Index in Checked_Item'Range loop
|
for Index in Checked_Item'Range loop
|
if (Checked_Item(Index) /= (Low_SB +Integer(Index)-1)) then
|
if (Checked_Item(Index) /= (Low_SB +Integer(Index)-1)) then
|
Fail("unaliased 1..10", Checked_Item(Index),
|
Fail("unaliased 1..10", Checked_Item(Index),
|
(Low_SB +Integer(Index)-1));
|
(Low_SB +Integer(Index)-1));
|
end if;
|
end if;
|
end loop;
|
end loop;
|
end Check_Array_01_10;
|
end Check_Array_01_10;
|
|
|
procedure Check_Array_11_20( Checked_Item : Array_11_20;
|
procedure Check_Array_11_20( Checked_Item : Array_11_20;
|
Low_SB : Integer ) is
|
Low_SB : Integer ) is
|
begin
|
begin
|
for Index in Checked_Item'Range loop
|
for Index in Checked_Item'Range loop
|
if (Checked_Item(Index) /= (Low_SB +Integer(Index)-11)) then
|
if (Checked_Item(Index) /= (Low_SB +Integer(Index)-11)) then
|
Fail("unaliased 11..20", Checked_Item(Index),
|
Fail("unaliased 11..20", Checked_Item(Index),
|
(Low_SB +Integer(Index)-11));
|
(Low_SB +Integer(Index)-11));
|
end if;
|
end if;
|
end loop;
|
end loop;
|
end Check_Array_11_20;
|
end Check_Array_11_20;
|
|
|
procedure Check_Single_Integer( The_Integer, SB : Integer;
|
procedure Check_Single_Integer( The_Integer, SB : Integer;
|
Message : String ) is
|
Message : String ) is
|
begin
|
begin
|
if The_Integer /= SB then
|
if The_Integer /= SB then
|
Report.Failed("Wrong integer value for " & Message );
|
Report.Failed("Wrong integer value for " & Message );
|
end if;
|
end if;
|
end Check_Single_Integer;
|
end Check_Single_Integer;
|
|
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
|
|
begin -- Main test procedure.
|
begin -- Main test procedure.
|
|
|
Report.Test ("C360002", "Check that modular types may be used as array " &
|
Report.Test ("C360002", "Check that modular types may be used as array " &
|
"indices. Check that if aliased appears in " &
|
"indices. Check that if aliased appears in " &
|
"the component_definition of an array_type that " &
|
"the component_definition of an array_type that " &
|
"each component of the array is aliased. Check " &
|
"each component of the array is aliased. Check " &
|
"that references to aliased array objects " &
|
"that references to aliased array objects " &
|
"produce correct results, and that out of bound " &
|
"produce correct results, and that out of bound " &
|
"references to aliased objects correctly " &
|
"references to aliased objects correctly " &
|
"produce Constraint_Error" );
|
"produce Constraint_Error" );
|
-- start with checks that the Filler assignments produced the expected
|
-- start with checks that the Filler assignments produced the expected
|
-- result. This is a "case 0" test to check that nothing REALLY surprising
|
-- result. This is a "case 0" test to check that nothing REALLY surprising
|
-- is happening
|
-- is happening
|
|
|
Check_Array_01_10( Array_Item_01_10, 0 );
|
Check_Array_01_10( Array_Item_01_10, 0 );
|
Check_Array_11_20( Array_Item_11_20, 10 );
|
Check_Array_11_20( Array_Item_11_20, 10 );
|
|
|
-- check that having the variable aliased makes no difference
|
-- check that having the variable aliased makes no difference
|
Check_Array_01_10( Aliased_Array_Item_01_10, 40 );
|
Check_Array_01_10( Aliased_Array_Item_01_10, 40 );
|
Check_Array_11_20( Aliased_Array_Item_11_20, 50 );
|
Check_Array_11_20( Aliased_Array_Item_11_20, 50 );
|
|
|
-- now check that conversion between array types where the only
|
-- now check that conversion between array types where the only
|
-- difference in the definitions is that the components are aliased works
|
-- difference in the definitions is that the components are aliased works
|
|
|
Check_Array_01_10( Unconstrained_Array( Array_Aliased_Item_01_10 ), 20 );
|
Check_Array_01_10( Unconstrained_Array( Array_Aliased_Item_01_10 ), 20 );
|
Check_Array_11_20( Unconstrained_Array( Array_Aliased_Item_11_20 ), 30 );
|
Check_Array_11_20( Unconstrained_Array( Array_Aliased_Item_11_20 ), 30 );
|
|
|
-- check that conversion of an aliased object with aliased components
|
-- check that conversion of an aliased object with aliased components
|
-- also works
|
-- also works
|
|
|
Check_Array_01_10( Unconstrained_Array( Aliased_Array_Aliased_Item_01_10 ),
|
Check_Array_01_10( Unconstrained_Array( Aliased_Array_Aliased_Item_01_10 ),
|
60 );
|
60 );
|
Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
|
Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
|
70 );
|
70 );
|
|
|
-- check that the bounds will slide
|
-- check that the bounds will slide
|
|
|
Check_Array_01_10( Array_01_10( Array_Item_11_20 ), 10 );
|
Check_Array_01_10( Array_01_10( Array_Item_11_20 ), 10 );
|
Check_Array_11_20( Array_11_20( Array_Item_01_10 ), 0 );
|
Check_Array_11_20( Array_11_20( Array_Item_01_10 ), 0 );
|
|
|
-- point at some of the components and check them
|
-- point at some of the components and check them
|
|
|
An_Integer_Access := Array_Aliased_Item_01_10(5)'Access;
|
An_Integer_Access := Array_Aliased_Item_01_10(5)'Access;
|
|
|
Check_Single_Integer( An_Integer_Access.all, 24,
|
Check_Single_Integer( An_Integer_Access.all, 24,
|
"Aliased component 'Access");
|
"Aliased component 'Access");
|
|
|
An_Integer_Access := Aliased_Array_Aliased_Item_01_10(7)'Access;
|
An_Integer_Access := Aliased_Array_Aliased_Item_01_10(7)'Access;
|
|
|
Check_Single_Integer( An_Integer_Access.all, 66,
|
Check_Single_Integer( An_Integer_Access.all, 66,
|
"Aliased Aliased component 'Access");
|
"Aliased Aliased component 'Access");
|
|
|
-- check some assignments
|
-- check some assignments
|
|
|
Array_Item_01_10 := Aliased_Array_Item_01_10;
|
Array_Item_01_10 := Aliased_Array_Item_01_10;
|
Check_Array_01_10( Array_Item_01_10, 40 );
|
Check_Array_01_10( Array_Item_01_10, 40 );
|
|
|
Aliased_Array_Item_01_10 := Aliased_Array_Item_11_20(11..20);
|
Aliased_Array_Item_01_10 := Aliased_Array_Item_11_20(11..20);
|
Check_Array_01_10( Aliased_Array_Item_01_10, 50 );
|
Check_Array_01_10( Aliased_Array_Item_01_10, 50 );
|
|
|
Aliased_Array_Aliased_Item_11_20(11..20)
|
Aliased_Array_Aliased_Item_11_20(11..20)
|
:= Aliased_Array_Aliased_Item_01_10;
|
:= Aliased_Array_Aliased_Item_01_10;
|
Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
|
Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
|
60 );
|
60 );
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end C360002;
|
end C360002;
|
|
|
