-- CD20001.A
|
-- CD20001.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 for packed records the components are packed as tightly
|
-- Check that for packed records the components are packed as tightly
|
-- as possible subject to the Size of the component subtypes.
|
-- as possible subject to the Size of the component subtypes.
|
-- Specifically check that Boolean objects are packed one to a bit.
|
-- Specifically check that Boolean objects are packed one to a bit.
|
--
|
--
|
-- Check that the Component_Size for a packed array type is less than
|
-- Check that the Component_Size for a packed array type is less than
|
-- or equal to the smallest of those factors of the word size that are
|
-- or equal to the smallest of those factors of the word size that are
|
-- greater than or equal to the Size of the component subtype.
|
-- greater than or equal to the Size of the component subtype.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- This test defines and packs several types, and checks that the sizes
|
-- This test defines and packs several types, and checks that the sizes
|
-- of the resulting objects is as expected.
|
-- of the resulting objects is as expected.
|
--
|
--
|
-- 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
|
-- indicated by "-- ANX-C RQMT", in which case it may be graded as
|
-- inapplicable. Otherwise, the test must execute and report PASSED.
|
-- inapplicable. 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 Strengthened for 2.1
|
-- 08 MAY 96 SAIC Strengthened for 2.1
|
-- 29 JAN 98 EDS Deleted check that Component_Size is really a
|
-- 29 JAN 98 EDS Deleted check that Component_Size is really a
|
-- factor of Word_Size.
|
-- factor of Word_Size.
|
--!
|
--!
|
|
|
----------------------------------------------------------------- CD20001_0
|
----------------------------------------------------------------- CD20001_0
|
|
|
with System;
|
with System;
|
package CD20001_0 is
|
package CD20001_0 is
|
|
|
type Wordlong_Bool_Array is array(1..System.Word_Size) of Boolean;
|
type Wordlong_Bool_Array is array(1..System.Word_Size) of Boolean;
|
pragma Pack(Wordlong_Bool_Array); -- ANX-C RQMT
|
pragma Pack(Wordlong_Bool_Array); -- ANX-C RQMT
|
|
|
type Def_Rep_Components is range 0..2**(System.Storage_Unit-2);
|
type Def_Rep_Components is range 0..2**(System.Storage_Unit-2);
|
|
|
type Spec_Rep_Components is range 0..2**(System.Storage_Unit-2);
|
type Spec_Rep_Components is range 0..2**(System.Storage_Unit-2);
|
for Spec_Rep_Components'Size use System.Storage_Unit; -- ANX-C RQMT
|
for Spec_Rep_Components'Size use System.Storage_Unit; -- ANX-C RQMT
|
|
|
type Packed_Array_Def_Components is array(1..32) of Def_Rep_Components;
|
type Packed_Array_Def_Components is array(1..32) of Def_Rep_Components;
|
pragma Pack(Packed_Array_Def_Components); -- ANX-C RQMT
|
pragma Pack(Packed_Array_Def_Components); -- ANX-C RQMT
|
|
|
type Packed_Array_Spec_Components is array(1..32) of Spec_Rep_Components;
|
type Packed_Array_Spec_Components is array(1..32) of Spec_Rep_Components;
|
pragma Pack(Packed_Array_Spec_Components); -- ANX-C RQMT
|
pragma Pack(Packed_Array_Spec_Components); -- ANX-C RQMT
|
|
|
procedure TC_Check_Values;
|
procedure TC_Check_Values;
|
|
|
end CD20001_0;
|
end CD20001_0;
|
|
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
|
|
with Report;
|
with Report;
|
with TCTouch;
|
with TCTouch;
|
package body CD20001_0 is
|
package body CD20001_0 is
|
|
|
procedure TC_Check_Values is
|
procedure TC_Check_Values is
|
My_Word : Wordlong_Bool_Array := (others => False);
|
My_Word : Wordlong_Bool_Array := (others => False);
|
|
|
Cited_Unit : Spec_Rep_Components := 0;
|
Cited_Unit : Spec_Rep_Components := 0;
|
|
|
Packed_Array : Packed_Array_Def_Components := (others => 0);
|
Packed_Array : Packed_Array_Def_Components := (others => 0);
|
|
|
Cited_Packed : Packed_Array_Spec_Components := (others => 0);
|
Cited_Packed : Packed_Array_Spec_Components := (others => 0);
|
|
|
begin
|
begin
|
TCTouch.Assert( My_Word'Size = System.Word_Size,
|
TCTouch.Assert( My_Word'Size = System.Word_Size,
|
"pragma Pack on array of Booleans does not pack one Boolean per bit" );
|
"pragma Pack on array of Booleans does not pack one Boolean per bit" );
|
|
|
TCTouch.Assert( My_Word'Component_Size = 1,
|
TCTouch.Assert( My_Word'Component_Size = 1,
|
"size of Boolean array component not 1 bit");
|
"size of Boolean array component not 1 bit");
|
|
|
TCTouch.Assert( Cited_Unit'Size = System.Storage_Unit,
|
TCTouch.Assert( Cited_Unit'Size = System.Storage_Unit,
|
"Object specified to be Storage_Unit bits not " &
|
"Object specified to be Storage_Unit bits not " &
|
"Storage_Unit bits in size");
|
"Storage_Unit bits in size");
|
|
|
TCTouch.Assert( Packed_Array'Component_Size <= System.Storage_Unit,
|
TCTouch.Assert( Packed_Array'Component_Size <= System.Storage_Unit,
|
"Packed array component expected to be less than or " &
|
"Packed array component expected to be less than or " &
|
"equal to Storage_Unit bits in size is greater than " &
|
"equal to Storage_Unit bits in size is greater than " &
|
"Storage_Unit bits in size");
|
"Storage_Unit bits in size");
|
|
|
TCTouch.Assert( Cited_Packed'Component_Size = System.Storage_Unit,
|
TCTouch.Assert( Cited_Packed'Component_Size = System.Storage_Unit,
|
"Array component specified to be Storage_Unit " &
|
"Array component specified to be Storage_Unit " &
|
"bits not Storage_Unit bits in size");
|
"bits not Storage_Unit bits in size");
|
|
|
end TC_Check_Values;
|
end TC_Check_Values;
|
|
|
end CD20001_0;
|
end CD20001_0;
|
|
|
----------------------------------------------------------------- CD20001_1
|
----------------------------------------------------------------- CD20001_1
|
|
|
with System;
|
with System;
|
package CD20001_1 is
|
package CD20001_1 is
|
|
|
type Bits_2 is range 0..2**2-1;
|
type Bits_2 is range 0..2**2-1;
|
for Bits_2'Size use 2; -- ANX-C RQMT
|
for Bits_2'Size use 2; -- ANX-C RQMT
|
|
|
type Bits_3 is range 0..2**3-1;
|
type Bits_3 is range 0..2**3-1;
|
for Bits_3'Size use 3; -- ANX-C RQMT
|
for Bits_3'Size use 3; -- ANX-C RQMT
|
|
|
type Bits_7 is range 0..2**7-1;
|
type Bits_7 is range 0..2**7-1;
|
for Bits_7'Size use 7; -- ANX-C RQMT
|
for Bits_7'Size use 7; -- ANX-C RQMT
|
|
|
type Bits_8 is range 0..2**8-1;
|
type Bits_8 is range 0..2**8-1;
|
for Bits_8'Size use 8; -- ANX-C RQMT
|
for Bits_8'Size use 8; -- ANX-C RQMT
|
|
|
type Bits_9 is range 0..2**9-1;
|
type Bits_9 is range 0..2**9-1;
|
for Bits_9'Size use 9; -- ANX-C RQMT
|
for Bits_9'Size use 9; -- ANX-C RQMT
|
|
|
type Bits_15 is range 0..2**15-1;
|
type Bits_15 is range 0..2**15-1;
|
for Bits_15'Size use 15; -- ANX-C RQMT
|
for Bits_15'Size use 15; -- ANX-C RQMT
|
|
|
type Pact_Aray_2 is array(0..31) of Bits_2;
|
type Pact_Aray_2 is array(0..31) of Bits_2;
|
pragma Pack( Pact_Aray_2 ); -- ANX-C RQMT
|
pragma Pack( Pact_Aray_2 ); -- ANX-C RQMT
|
|
|
type Pact_Aray_3 is array(0..31) of Bits_3;
|
type Pact_Aray_3 is array(0..31) of Bits_3;
|
pragma Pack( Pact_Aray_3 ); -- ANX-C RQMT
|
pragma Pack( Pact_Aray_3 ); -- ANX-C RQMT
|
|
|
type Pact_Aray_7 is array(0..31) of Bits_7;
|
type Pact_Aray_7 is array(0..31) of Bits_7;
|
pragma Pack( Pact_Aray_7 ); -- ANX-C RQMT
|
pragma Pack( Pact_Aray_7 ); -- ANX-C RQMT
|
|
|
type Pact_Aray_8 is array(0..31) of Bits_8;
|
type Pact_Aray_8 is array(0..31) of Bits_8;
|
pragma Pack( Pact_Aray_8 ); -- ANX-C RQMT
|
pragma Pack( Pact_Aray_8 ); -- ANX-C RQMT
|
|
|
type Pact_Aray_9 is array(0..31) of Bits_9;
|
type Pact_Aray_9 is array(0..31) of Bits_9;
|
pragma Pack( Pact_Aray_9 ); -- ANX-C RQMT
|
pragma Pack( Pact_Aray_9 ); -- ANX-C RQMT
|
|
|
type Pact_Aray_15 is array(0..31) of Bits_15;
|
type Pact_Aray_15 is array(0..31) of Bits_15;
|
pragma Pack( Pact_Aray_15 ); -- ANX-C RQMT
|
pragma Pack( Pact_Aray_15 ); -- ANX-C RQMT
|
|
|
|
|
procedure TC_Check_Values;
|
procedure TC_Check_Values;
|
|
|
end CD20001_1;
|
end CD20001_1;
|
|
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
|
|
with Report;
|
with Report;
|
with TCTouch;
|
with TCTouch;
|
package body CD20001_1 is
|
package body CD20001_1 is
|
|
|
function Next_Factor ( Value : Positive ) return Integer is
|
function Next_Factor ( Value : Positive ) return Integer is
|
-- Returns the factor of Word_Size that is next larger than Value.
|
-- Returns the factor of Word_Size that is next larger than Value.
|
-- If Value is greater than Word_Size, then returns Word_Size.
|
-- If Value is greater than Word_Size, then returns Word_Size.
|
Test : Integer := Value;
|
Test : Integer := Value;
|
Found : Boolean := False;
|
Found : Boolean := False;
|
begin -- Next_Factor
|
begin -- Next_Factor
|
while not Found and Test <= System.Word_Size loop
|
while not Found and Test <= System.Word_Size loop
|
if System.Word_Size mod Test = 0 then
|
if System.Word_Size mod Test = 0 then
|
Found := True;
|
Found := True;
|
else
|
else
|
Test := Test + 1;
|
Test := Test + 1;
|
end if;
|
end if;
|
end loop;
|
end loop;
|
if Found then
|
if Found then
|
return Test;
|
return Test;
|
else
|
else
|
return System.Word_Size;
|
return System.Word_Size;
|
end if;
|
end if;
|
end Next_Factor;
|
end Next_Factor;
|
|
|
procedure TC_Check_Values is
|
procedure TC_Check_Values is
|
begin
|
begin
|
|
|
if Pact_Aray_2'Component_Size > Next_Factor ( Bits_2'Size ) then
|
if Pact_Aray_2'Component_Size > Next_Factor ( Bits_2'Size ) then
|
Report.Failed
|
Report.Failed
|
( "2 bit element Packed Array'Component_Size too big" );
|
( "2 bit element Packed Array'Component_Size too big" );
|
end if;
|
end if;
|
|
|
TCTouch.Assert( Pact_Aray_2'Component_Size <= Pact_Aray_2'Size,
|
TCTouch.Assert( Pact_Aray_2'Component_Size <= Pact_Aray_2'Size,
|
"2 bit Component_Size greater than array size" );
|
"2 bit Component_Size greater than array size" );
|
|
|
if Pact_Aray_3'Component_Size > Next_Factor ( Bits_3'Size ) then
|
if Pact_Aray_3'Component_Size > Next_Factor ( Bits_3'Size ) then
|
Report.Failed
|
Report.Failed
|
( "3 bit element Packed Array'Component_Size too big" );
|
( "3 bit element Packed Array'Component_Size too big" );
|
end if;
|
end if;
|
|
|
TCTouch.Assert( Pact_Aray_3'Component_Size <= Pact_Aray_3'Size,
|
TCTouch.Assert( Pact_Aray_3'Component_Size <= Pact_Aray_3'Size,
|
"3 bit Component_Size greater than array size" );
|
"3 bit Component_Size greater than array size" );
|
|
|
if Pact_Aray_7'Component_Size > Next_Factor ( Bits_7'Size ) then
|
if Pact_Aray_7'Component_Size > Next_Factor ( Bits_7'Size ) then
|
Report.Failed
|
Report.Failed
|
( "7 bit element Packed Array'Component_Size too big" );
|
( "7 bit element Packed Array'Component_Size too big" );
|
end if;
|
end if;
|
|
|
TCTouch.Assert( Pact_Aray_7'Component_Size <= Pact_Aray_7'Size,
|
TCTouch.Assert( Pact_Aray_7'Component_Size <= Pact_Aray_7'Size,
|
"7 bit Component_Size greater than array size" );
|
"7 bit Component_Size greater than array size" );
|
|
|
if Pact_Aray_8'Component_Size > Next_Factor ( Bits_8'Size ) then
|
if Pact_Aray_8'Component_Size > Next_Factor ( Bits_8'Size ) then
|
Report.Failed
|
Report.Failed
|
( "8 bit element Packed Array'Component_Size too big" );
|
( "8 bit element Packed Array'Component_Size too big" );
|
end if;
|
end if;
|
|
|
TCTouch.Assert( Pact_Aray_8'Component_Size <= Pact_Aray_8'Size,
|
TCTouch.Assert( Pact_Aray_8'Component_Size <= Pact_Aray_8'Size,
|
"8 bit Component_Size greater than array size" );
|
"8 bit Component_Size greater than array size" );
|
|
|
if System.Word_Size > 8 then
|
if System.Word_Size > 8 then
|
|
|
if Pact_Aray_9'Component_Size > Next_Factor ( Bits_9'Size ) then
|
if Pact_Aray_9'Component_Size > Next_Factor ( Bits_9'Size ) then
|
Report.Failed
|
Report.Failed
|
( "9 bit element Packed Array'Component_Size too big" );
|
( "9 bit element Packed Array'Component_Size too big" );
|
end if;
|
end if;
|
|
|
TCTouch.Assert( Pact_Aray_9'Component_Size <= Pact_Aray_9'Size,
|
TCTouch.Assert( Pact_Aray_9'Component_Size <= Pact_Aray_9'Size,
|
"9 bit Component_Size greater than array size" );
|
"9 bit Component_Size greater than array size" );
|
|
|
if Pact_Aray_15'Component_Size > Next_Factor ( Bits_15'Size ) then
|
if Pact_Aray_15'Component_Size > Next_Factor ( Bits_15'Size ) then
|
Report.Failed
|
Report.Failed
|
( "15 bit element Packed Array'Component_Size too big" );
|
( "15 bit element Packed Array'Component_Size too big" );
|
end if;
|
end if;
|
|
|
TCTouch.Assert( Pact_Aray_15'Component_Size <= Pact_Aray_15'Size,
|
TCTouch.Assert( Pact_Aray_15'Component_Size <= Pact_Aray_15'Size,
|
"15 bit Component_Size greater than array size" );
|
"15 bit Component_Size greater than array size" );
|
|
|
end if;
|
end if;
|
|
|
end TC_Check_Values;
|
end TC_Check_Values;
|
|
|
end CD20001_1;
|
end CD20001_1;
|
|
|
------------------------------------------------------------------- CD20001
|
------------------------------------------------------------------- CD20001
|
|
|
with Report;
|
with Report;
|
with CD20001_0;
|
with CD20001_0;
|
with CD20001_1;
|
with CD20001_1;
|
|
|
procedure CD20001 is
|
procedure CD20001 is
|
|
|
begin -- Main test procedure.
|
begin -- Main test procedure.
|
|
|
Report.Test ("CD20001", "Check that packed records are packed as tightly " &
|
Report.Test ("CD20001", "Check that packed records are packed as tightly " &
|
"as possible. Check that Boolean objects are " &
|
"as possible. Check that Boolean objects are " &
|
"packed one to a bit. " &
|
"packed one to a bit. " &
|
"Check that the Component_Size for a packed " &
|
"Check that the Component_Size for a packed " &
|
"array type is the value which is less than or " &
|
"array type is the value which is less than or " &
|
"equal to the Size of the component type, " &
|
"equal to the Size of the component type, " &
|
"rounded up to the nearest factor of word_size" );
|
"rounded up to the nearest factor of word_size" );
|
|
|
CD20001_0.TC_Check_Values;
|
CD20001_0.TC_Check_Values;
|
|
|
CD20001_1.TC_Check_Values;
|
CD20001_1.TC_Check_Values;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end CD20001;
|
end CD20001;
|
|
|