-- C332001.A
|
-- C332001.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 the static expression given for a number declaration may be
|
-- Check that the static expression given for a number declaration may be
|
-- of any numeric type. Check that the type of a named number is
|
-- of any numeric type. Check that the type of a named number is
|
-- universal_integer or universal_real regardless of the type of the
|
-- universal_integer or universal_real regardless of the type of the
|
-- static expression that provides its value.
|
-- static expression that provides its value.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- This test defines a large cross section of mixed type named numbers.
|
-- This test defines a large cross section of mixed type named numbers.
|
-- Well, obviously the named numbers don't have types (other than
|
-- Well, obviously the named numbers don't have types (other than
|
-- universal_integer and universal_real) associated with them.
|
-- universal_integer and universal_real) associated with them.
|
-- This test uses typed static values in the definition of several named
|
-- This test uses typed static values in the definition of several named
|
-- numbers, and then mixes the named numbers to ensure that their typed
|
-- numbers, and then mixes the named numbers to ensure that their typed
|
-- origins do not interfere with the use of their values.
|
-- origins do not interfere with the use of their values.
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 10 OCT 95 SAIC Initial version
|
-- 10 OCT 95 SAIC Initial version
|
-- 11 APR 96 SAIC Fixed a few arithmetic errors for 2.1
|
-- 11 APR 96 SAIC Fixed a few arithmetic errors for 2.1
|
-- 24 NOV 98 RLB Removed decimal types to insure that this
|
-- 24 NOV 98 RLB Removed decimal types to insure that this
|
-- test is applicable to all implementations.
|
-- test is applicable to all implementations.
|
--
|
--
|
--!
|
--!
|
|
|
----------------------------------------------------------------- C332001_0
|
----------------------------------------------------------------- C332001_0
|
|
|
package C332001_0 is
|
package C332001_0 is
|
|
|
type Enumeration_Type is ( Ah, Gnome, Er, Ay, Shun );
|
type Enumeration_Type is ( Ah, Gnome, Er, Ay, Shun );
|
|
|
type Integer_Type is range 0..1023;
|
type Integer_Type is range 0..1023;
|
|
|
type Modular_Type is mod 256;
|
type Modular_Type is mod 256;
|
|
|
type Floating_Type is digits 4;
|
type Floating_Type is digits 4;
|
|
|
type Fixed_Type is delta 0.125 range -10.0 .. 10.0;
|
type Fixed_Type is delta 0.125 range -10.0 .. 10.0;
|
|
|
type Mod_Array is array(Modular_Type) of Floating_Type;
|
type Mod_Array is array(Modular_Type) of Floating_Type;
|
|
|
type Int_Array is array(Integer_Type) of Fixed_Type;
|
type Int_Array is array(Integer_Type) of Fixed_Type;
|
|
|
type Record_Type is record
|
type Record_Type is record
|
Pinkie : Integer_Type;
|
Pinkie : Integer_Type;
|
Ring : Modular_Type;
|
Ring : Modular_Type;
|
Middle : Floating_Type;
|
Middle : Floating_Type;
|
Index : Fixed_Type;
|
Index : Fixed_Type;
|
end record;
|
end record;
|
|
|
Mod_Array_Object : Mod_Array;
|
Mod_Array_Object : Mod_Array;
|
Int_Array_Object : Int_Array;
|
Int_Array_Object : Int_Array;
|
|
|
Record_Object : Record_Type;
|
Record_Object : Record_Type;
|
|
|
-- numeric_literals
|
-- numeric_literals
|
|
|
Nothing_New_Integer : constant := 1;
|
Nothing_New_Integer : constant := 1;
|
Nothing_New_Real : constant := 1.0;
|
Nothing_New_Real : constant := 1.0;
|
|
|
-- static constants
|
-- static constants
|
|
|
Integ : constant Integer_Type := 2;
|
Integ : constant Integer_Type := 2;
|
Modul : constant Modular_Type := 2;
|
Modul : constant Modular_Type := 2;
|
Float : constant Floating_Type := 2.0; -- bad practice, good test
|
Float : constant Floating_Type := 2.0; -- bad practice, good test
|
Fixed : constant Fixed_Type := 2.0;
|
Fixed : constant Fixed_Type := 2.0;
|
|
|
Named_Integer : constant := Integ; -- 2
|
Named_Integer : constant := Integ; -- 2
|
Named_Modular : constant := Modul; -- 2
|
Named_Modular : constant := Modul; -- 2
|
Named_Float : constant := Float; -- 2.0
|
Named_Float : constant := Float; -- 2.0
|
Named_Fixed : constant := Fixed; -- 2.0
|
Named_Fixed : constant := Fixed; -- 2.0
|
|
|
-- function calls
|
-- function calls
|
-- parenthetical expressions
|
-- parenthetical expressions
|
|
|
Fn_Integer : constant := Integer_Type'Min(Integ * 2, 8); -- 4
|
Fn_Integer : constant := Integer_Type'Min(Integ * 2, 8); -- 4
|
Fn_Modular : constant := Modular_Type'Max(Modul + 2, Modular_Type'First);--4
|
Fn_Modular : constant := Modular_Type'Max(Modul + 2, Modular_Type'First);--4
|
Fn_Float : constant := (Float ** 2); -- 4.0
|
Fn_Float : constant := (Float ** 2); -- 4.0
|
Fn_Fixed : constant := - Fixed; -- -2.0
|
Fn_Fixed : constant := - Fixed; -- -2.0
|
-- attributes
|
-- attributes
|
|
|
ITF : constant := Integer_Type'First; -- 0
|
ITF : constant := Integer_Type'First; -- 0
|
MTL : constant := Modular_Type'Last; -- 255
|
MTL : constant := Modular_Type'Last; -- 255
|
MTM : constant := Modular_Type'Modulus; -- 256
|
MTM : constant := Modular_Type'Modulus; -- 256
|
ENP : constant := Enumeration_Type'Pos(Ay); -- 3
|
ENP : constant := Enumeration_Type'Pos(Ay); -- 3
|
MTP : constant := Modular_Type'Pred(Modul); -- 1
|
MTP : constant := Modular_Type'Pred(Modul); -- 1
|
FTS : constant := Fixed_Type'Size; -- # impdef
|
FTS : constant := Fixed_Type'Size; -- # impdef
|
ITS : constant := Integer_Type'Succ(Integ); -- 3
|
ITS : constant := Integer_Type'Succ(Integ); -- 3
|
|
|
-- array attributes 'First, 'Last, 'Length
|
-- array attributes 'First, 'Last, 'Length
|
|
|
MAFirst : constant := Mod_Array_Object'First; -- 0
|
MAFirst : constant := Mod_Array_Object'First; -- 0
|
IALast : constant := Int_Array_Object'Last; -- 1023
|
IALast : constant := Int_Array_Object'Last; -- 1023
|
MAL : constant := Mod_Array_Object'Length; -- 255
|
MAL : constant := Mod_Array_Object'Length; -- 255
|
IAL : constant := Int_Array_Object'Length; -- 1024
|
IAL : constant := Int_Array_Object'Length; -- 1024
|
|
|
-- type conversions
|
-- type conversions
|
--
|
--
|
-- F\T Int Mod Flt Fix
|
-- F\T Int Mod Flt Fix
|
-- Int . X O X
|
-- Int . X O X
|
-- Mod O . X O
|
-- Mod O . X O
|
-- Flt X O . X
|
-- Flt X O . X
|
-- Fix O X O .
|
-- Fix O X O .
|
|
|
Int2Mod : constant := Modular_Type (Integ); -- 2
|
Int2Mod : constant := Modular_Type (Integ); -- 2
|
Int2Fix : constant := Fixed_Type (Integ); -- 2.0
|
Int2Fix : constant := Fixed_Type (Integ); -- 2.0
|
Mod2Flt : constant := Floating_Type (Modul); -- 2.0
|
Mod2Flt : constant := Floating_Type (Modul); -- 2.0
|
Flt2Int : constant := Integer_Type(Float); -- 2
|
Flt2Int : constant := Integer_Type(Float); -- 2
|
Flt2Fix : constant := Fixed_Type (Float); -- 2.0
|
Flt2Fix : constant := Fixed_Type (Float); -- 2.0
|
Fix2Mod : constant := Modular_Type (Fixed); -- 2
|
Fix2Mod : constant := Modular_Type (Fixed); -- 2
|
|
|
procedure Check_Values;
|
procedure Check_Values;
|
|
|
-- TRANSITION CHECKS
|
-- TRANSITION CHECKS
|
--
|
--
|
-- The following were illegal in Ada83; they are now legal in Ada95
|
-- The following were illegal in Ada83; they are now legal in Ada95
|
--
|
--
|
|
|
Int_Base_First : constant := Integer'Base'First; -- # impdef
|
Int_Base_First : constant := Integer'Base'First; -- # impdef
|
Int_First : constant := Integer'First; -- # impdef
|
Int_First : constant := Integer'First; -- # impdef
|
Int_Last : constant := Integer'Last; -- # impdef
|
Int_Last : constant := Integer'Last; -- # impdef
|
Int_Val : constant := Integer'Val(17); -- 17
|
Int_Val : constant := Integer'Val(17); -- 17
|
|
|
-- END OF TRANSITION CHECKS
|
-- END OF TRANSITION CHECKS
|
|
|
end C332001_0;
|
end C332001_0;
|
|
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
|
|
with Report;
|
with Report;
|
package body C332001_0 is
|
package body C332001_0 is
|
|
|
procedure Assert( Truth : Boolean; Message: String ) is
|
procedure Assert( Truth : Boolean; Message: String ) is
|
begin
|
begin
|
if not Truth then
|
if not Truth then
|
Report.Failed("Assertion " & Message & " not true" );
|
Report.Failed("Assertion " & Message & " not true" );
|
end if;
|
end if;
|
end Assert;
|
end Assert;
|
|
|
procedure Check_Values is
|
procedure Check_Values is
|
begin
|
begin
|
|
|
Assert( Nothing_New_Integer * Named_Integer = Named_Modular,
|
Assert( Nothing_New_Integer * Named_Integer = Named_Modular,
|
"Nothing_New_Integer * Named_Integer = Named_Modular" ); -- 1*2 = 2
|
"Nothing_New_Integer * Named_Integer = Named_Modular" ); -- 1*2 = 2
|
Assert( Nothing_New_Real * Named_Float = Named_Fixed,
|
Assert( Nothing_New_Real * Named_Float = Named_Fixed,
|
"Nothing_New_Real * Named_Float = Named_Fixed" );-- 1.0*2.0 = 2.0
|
"Nothing_New_Real * Named_Float = Named_Fixed" );-- 1.0*2.0 = 2.0
|
|
|
Assert( Fn_Integer = Int2Mod + Flt2Int,
|
Assert( Fn_Integer = Int2Mod + Flt2Int,
|
"Fn_Integer = Int2Mod + Flt2Int" ); -- 4 = 2+2
|
"Fn_Integer = Int2Mod + Flt2Int" ); -- 4 = 2+2
|
Assert( Fn_Modular = Flt2Int * 2,
|
Assert( Fn_Modular = Flt2Int * 2,
|
"Fn_Modular = Flt2Int * 2" ); -- 4 = 2*2
|
"Fn_Modular = Flt2Int * 2" ); -- 4 = 2*2
|
Assert( Fn_Float = Mod2Flt ** Fix2Mod,
|
Assert( Fn_Float = Mod2Flt ** Fix2Mod,
|
"Fn_Float = Mod2Flt ** Fix2Mod" ); -- 4.0 = 2.0**2
|
"Fn_Float = Mod2Flt ** Fix2Mod" ); -- 4.0 = 2.0**2
|
Assert( Fn_Fixed = (- Mod2Flt),
|
Assert( Fn_Fixed = (- Mod2Flt),
|
"Fn_Fixed = (- Mod2Flt)" ); -- -2.0 = (-2.0)
|
"Fn_Fixed = (- Mod2Flt)" ); -- -2.0 = (-2.0)
|
|
|
Assert( ITF = Modular_Type'First,
|
Assert( ITF = Modular_Type'First,
|
"ITF = Modular_Type'First" ); -- 0 = 0
|
"ITF = Modular_Type'First" ); -- 0 = 0
|
Assert( MTL < Integer_Type'Last,
|
Assert( MTL < Integer_Type'Last,
|
"MTL < Integer_Type'Last" ); -- 255 < 1023
|
"MTL < Integer_Type'Last" ); -- 255 < 1023
|
Assert( MTM < Integer_Type'Last,
|
Assert( MTM < Integer_Type'Last,
|
"MTM < Integer_Type'Last" ); -- 256 < 1023
|
"MTM < Integer_Type'Last" ); -- 256 < 1023
|
Assert( ENP > MTP,
|
Assert( ENP > MTP,
|
"ENP > MTP" ); -- 3 > 1
|
"ENP > MTP" ); -- 3 > 1
|
Assert( (FTS < MTL) or (FTS >= MTL), -- given FTS is impdef...
|
Assert( (FTS < MTL) or (FTS >= MTL), -- given FTS is impdef...
|
"(FTS < MTL) or (FTS >= MTL)" ); -- True
|
"(FTS < MTL) or (FTS >= MTL)" ); -- True
|
Assert( FTS > ITS,
|
Assert( FTS > ITS,
|
"FTS > ITS" ); -- impdef > 3
|
"FTS > ITS" ); -- impdef > 3
|
|
|
Assert( MAFirst = Int_Array_Object'First,
|
Assert( MAFirst = Int_Array_Object'First,
|
"MAFirst = Int_Array_Object'First" ); -- 0 = 0
|
"MAFirst = Int_Array_Object'First" ); -- 0 = 0
|
Assert( IALast > MAFirst,
|
Assert( IALast > MAFirst,
|
"IALast > MAFirst" ); -- 1023 > 0
|
"IALast > MAFirst" ); -- 1023 > 0
|
Assert( MAL < IAL,
|
Assert( MAL < IAL,
|
"MAL < IAL" ); -- 255 < 1024
|
"MAL < IAL" ); -- 255 < 1024
|
|
|
Assert( Mod2Flt = Flt2Fix,
|
Assert( Mod2Flt = Flt2Fix,
|
"Mod2Flt = Flt2Fix" ); -- 2.0 = 2.0
|
"Mod2Flt = Flt2Fix" ); -- 2.0 = 2.0
|
|
|
end Check_Values;
|
end Check_Values;
|
|
|
end C332001_0;
|
end C332001_0;
|
|
|
------------------------------------------------------------------- C332001
|
------------------------------------------------------------------- C332001
|
|
|
with Report;
|
with Report;
|
with C332001_0;
|
with C332001_0;
|
procedure C332001 is
|
procedure C332001 is
|
|
|
begin -- Main test procedure.
|
begin -- Main test procedure.
|
|
|
Report.Test ("C332001", "Check that the static expression given for a " &
|
Report.Test ("C332001", "Check that the static expression given for a " &
|
"number declaration may be of any numeric type. " &
|
"number declaration may be of any numeric type. " &
|
"Check that the type of the named number is " &
|
"Check that the type of the named number is " &
|
"universal_integer of universal_real regardless " &
|
"universal_integer of universal_real regardless " &
|
"of the type of the static expression that " &
|
"of the type of the static expression that " &
|
"provides its value" );
|
"provides its value" );
|
|
|
C332001_0.Check_Values;
|
C332001_0.Check_Values;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end C332001;
|
end C332001;
|
|
|
