URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxf/] [cxf2a01.a] - Rev 338
Compare with Previous | Blame | View Log
-- CXF2A01.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 the binary adding operators for a decimal fixed point type
-- return values that are integral multiples of the small of the type.
--
-- TEST DESCRIPTION:
-- The test verifies that decimal addition and subtraction behave as
-- expected for types with various digits, delta, and Machine_Radix
-- values. Types with the minimum values for Decimal.Max_Digits and
-- Decimal.Max_Scale (18) are included.
--
-- Two kinds of checks are performed for each type. In the first check,
-- the iteration, operation, and operand counts in the foundation and
-- the operation tables in this test are given values such that, when the
-- operations loop is complete, each operand will have been added to and
-- subtracted from the loop's cumulator variable the same number of times,
-- albeit in varying order. Thus, the result returned by the operations
-- loop should have the same value as that used to initialize the
-- cumulator (in this test, zero).
--
-- In the second check, the same operation (addition for some types and
-- subtraction for others) is performed during each loop iteration,
-- resulting in a cumulative total which is checked against an expected
-- value.
--
-- TEST FILES:
-- The following files comprise this test:
--
-- FXF2A00.A
-- -> CXF2A01.A
--
-- APPLICABILITY CRITERIA:
-- This test is only applicable for a compiler attempting validation
-- for the Information Systems Annex.
--
--
-- CHANGE HISTORY:
-- 08 Apr 96 SAIC Prerelease version for ACVC 2.1.
--
--!
package CXF2A01_0 is
---=---=---=---=---=---=---=---=---=---=---
type Micro is delta 10.0**(-18) digits 18; -- range -0.999999999999999999 ..
for Micro'Machine_Radix use 10; -- +0.999999999999999999
function Add (Left, Right : Micro) return Micro;
function Subtract (Left, Right : Micro) return Micro;
type Micro_Optr_Ptr is access function (Left, Right : Micro) return Micro;
Micro_Add : Micro_Optr_Ptr := Add'Access;
Micro_Sub : Micro_Optr_Ptr := Subtract'Access;
---=---=---=---=---=---=---=---=---=---=---
type Money is delta 0.01 digits 11; -- range -999,999,999.99 ..
for Money'Machine_Radix use 2; -- +999,999,999.99
function Add (Left, Right : Money) return Money;
function Subtract (Left, Right : Money) return Money;
type Money_Optr_Ptr is access function (Left, Right : Money) return Money;
Money_Add : Money_Optr_Ptr := Add'Access;
Money_Sub : Money_Optr_Ptr := Subtract'Access;
---=---=---=---=---=---=---=---=---=---=---
-- Same as Money, but with Radix 10:
type Cash is delta 0.01 digits 11; -- range -999,999,999.99 ..
for Cash'Machine_Radix use 10; -- +999,999,999.99
function Add (Left, Right : Cash) return Cash;
function Subtract (Left, Right : Cash) return Cash;
type Cash_Optr_Ptr is access function (Left, Right : Cash) return Cash;
Cash_Add : Cash_Optr_Ptr := Add'Access;
Cash_Sub : Cash_Optr_Ptr := Subtract'Access;
---=---=---=---=---=---=---=---=---=---=---
type Broad is delta 10.0**(-9) digits 18; -- range -999,999,999.999999999 ..
for Broad'Machine_Radix use 10; -- +999,999,999.999999999
function Add (Left, Right : Broad) return Broad;
function Subtract (Left, Right : Broad) return Broad;
type Broad_Optr_Ptr is access function (Left, Right : Broad) return Broad;
Broad_Add : Broad_Optr_Ptr := Add'Access;
Broad_Sub : Broad_Optr_Ptr := Subtract'Access;
---=---=---=---=---=---=---=---=---=---=---
end CXF2A01_0;
--==================================================================--
package body CXF2A01_0 is
---=---=---=---=---=---=---=---=---=---=---
function Add (Left, Right : Micro) return Micro is
begin
return (Left + Right); -- Decimal fixed addition.
end Add;
function Subtract (Left, Right : Micro) return Micro is
begin
return (Left - Right); -- Decimal fixed subtraction.
end Subtract;
---=---=---=---=---=---=---=---=---=---=---
function Add (Left, Right : Money) return Money is
begin
return (Left + Right); -- Decimal fixed addition.
end Add;
function Subtract (Left, Right : Money) return Money is
begin
return (Left - Right); -- Decimal fixed subtraction.
end Subtract;
---=---=---=---=---=---=---=---=---=---=---
function Add (Left, Right : Cash) return Cash is
begin
return (Left + Right); -- Decimal fixed addition.
end Add;
function Subtract (Left, Right : Cash) return Cash is
begin
return (Left - Right); -- Decimal fixed subtraction.
end Subtract;
---=---=---=---=---=---=---=---=---=---=---
function Add (Left, Right : Broad) return Broad is
begin
return (Left + Right); -- Decimal fixed addition.
end Add;
function Subtract (Left, Right : Broad) return Broad is
begin
return (Left - Right); -- Decimal fixed subtraction.
end Subtract;
---=---=---=---=---=---=---=---=---=---=---
end CXF2A01_0;
--==================================================================--
with FXF2A00;
package CXF2A01_0.CXF2A01_1 is
---=---=---=---=---=---=---=---=---=---=---
type Micro_Ops is array (FXF2A00.Optr_Range) of Micro_Optr_Ptr;
type Micro_Opnds is array (FXF2A00.Opnd_Range) of Micro;
Micro_Optr_Table_Cancel : Micro_Ops := ( Micro_Add, Micro_Sub,
Micro_Add, Micro_Sub,
Micro_Add, Micro_Sub );
Micro_Optr_Table_Cumul : Micro_Ops := ( others => Micro_Add );
Micro_Opnd_Table_Cancel : Micro_Opnds := ( 0.001025000235111997,
0.000000000000000003,
0.724902903219925400,
0.000459228020000011,
0.049832104921096533 );
Micro_Opnd_Table_Cumul : Micro_Opnds := ( 0.000002309540000000,
0.000000278060000000,
0.000000000000070000,
0.000010003000000000,
0.000000023090000000 );
function Test_Micro_Ops is new FXF2A00.Operations_Loop
(Decimal_Fixed => Micro,
Operator_Ptr => Micro_Optr_Ptr,
Operator_Table => Micro_Ops,
Operand_Table => Micro_Opnds);
---=---=---=---=---=---=---=---=---=---=---
type Money_Ops is array (FXF2A00.Optr_Range) of Money_Optr_Ptr;
type Money_Opnds is array (FXF2A00.Opnd_Range) of Money;
Money_Optr_Table_Cancel : Money_Ops := ( Money_Add, Money_Add,
Money_Sub, Money_Add,
Money_Sub, Money_Sub );
Money_Optr_Table_Cumul : Money_Ops := ( others => Money_Sub );
Money_Opnd_Table_Cancel : Money_Opnds := ( 127.10,
5600.44,
0.05,
189662.78,
226900402.99 );
Money_Opnd_Table_Cumul : Money_Opnds := ( 17.99,
500.41,
92.78,
0.38,
2942.99 );
function Test_Money_Ops is new FXF2A00.Operations_Loop
(Decimal_Fixed => Money,
Operator_Ptr => Money_Optr_Ptr,
Operator_Table => Money_Ops,
Operand_Table => Money_Opnds);
---=---=---=---=---=---=---=---=---=---=---
type Cash_Ops is array (FXF2A00.Optr_Range) of Cash_Optr_Ptr;
type Cash_Opnds is array (FXF2A00.Opnd_Range) of Cash;
Cash_Optr_Table_Cancel : Cash_Ops := ( Cash_Add, Cash_Add,
Cash_Sub, Cash_Add,
Cash_Sub, Cash_Sub );
Cash_Optr_Table_Cumul : Cash_Ops := ( others => Cash_Add );
Cash_Opnd_Table_Cancel : Cash_Opnds := ( 127.10,
5600.44,
0.05,
189662.78,
226900402.99 );
Cash_Opnd_Table_Cumul : Cash_Opnds := ( 3.33,
100056.14,
22.87,
3901.55,
111.21 );
function Test_Cash_Ops is new FXF2A00.Operations_Loop
(Decimal_Fixed => Cash,
Operator_Ptr => Cash_Optr_Ptr,
Operator_Table => Cash_Ops,
Operand_Table => Cash_Opnds);
---=---=---=---=---=---=---=---=---=---=---
type Broad_Ops is array (FXF2A00.Optr_Range) of Broad_Optr_Ptr;
type Broad_Opnds is array (FXF2A00.Opnd_Range) of Broad;
Broad_Optr_Table_Cancel : Broad_Ops := ( Broad_Sub, Broad_Add,
Broad_Add, Broad_Sub,
Broad_Sub, Broad_Add );
Broad_Optr_Table_Cumul : Broad_Ops := ( others => Broad_Sub );
Broad_Opnd_Table_Cancel : Broad_Opnds := ( 1.000009092,
732919479.445022293,
89662.787000006,
660.101010133,
1121127.999905594 );
Broad_Opnd_Table_Cumul : Broad_Opnds := ( 12.000450223,
479.430320780,
0.003492096,
8.112888400,
1002.994937800 );
function Test_Broad_Ops is new FXF2A00.Operations_Loop
(Decimal_Fixed => Broad,
Operator_Ptr => Broad_Optr_Ptr,
Operator_Table => Broad_Ops,
Operand_Table => Broad_Opnds);
---=---=---=---=---=---=---=---=---=---=---
end CXF2A01_0.CXF2A01_1;
--==================================================================--
with CXF2A01_0.CXF2A01_1;
with Report;
procedure CXF2A01 is
package Data renames CXF2A01_0.CXF2A01_1;
use type CXF2A01_0.Micro;
use type CXF2A01_0.Money;
use type CXF2A01_0.Cash;
use type CXF2A01_0.Broad;
Micro_Cancel_Expected : constant CXF2A01_0.Micro := 0.0;
Money_Cancel_Expected : constant CXF2A01_0.Money := 0.0;
Cash_Cancel_Expected : constant CXF2A01_0.Cash := 0.0;
Broad_Cancel_Expected : constant CXF2A01_0.Broad := 0.0;
Micro_Cumul_Expected : constant CXF2A01_0.Micro := 0.075682140420000000;
Money_Cumul_Expected : constant CXF2A01_0.Money := -21327300.00;
Cash_Cumul_Expected : constant CXF2A01_0.Cash := 624570600.00;
Broad_Cumul_Expected : constant CXF2A01_0.Broad := -9015252.535794000;
Micro_Actual : CXF2A01_0.Micro;
Money_Actual : CXF2A01_0.Money;
Cash_Actual : CXF2A01_0.Cash;
Broad_Actual : CXF2A01_0.Broad;
begin
Report.Test ("CXF2A01", "Check decimal addition and subtraction");
---=---=---=---=---=---=---=---=---=---=---
Micro_Actual := Data.Test_Micro_Ops (0.0,
Data.Micro_Optr_Table_Cancel,
Data.Micro_Opnd_Table_Cancel);
if Micro_Actual /= Micro_Cancel_Expected then
Report.Failed ("Wrong cancellation result for type Micro");
end if;
---=---=---=---=---=---=---
Micro_Actual := Data.Test_Micro_Ops (0.0,
Data.Micro_Optr_Table_Cumul,
Data.Micro_Opnd_Table_Cumul);
if Micro_Actual /= Micro_Cumul_Expected then
Report.Failed ("Wrong cumulation result for type Micro");
end if;
---=---=---=---=---=---=---=---=---=---=---
Money_Actual := Data.Test_Money_Ops (0.0,
Data.Money_Optr_Table_Cancel,
Data.Money_Opnd_Table_Cancel);
if Money_Actual /= Money_Cancel_Expected then
Report.Failed ("Wrong cancellation result for type Money");
end if;
---=---=---=---=---=---=---
Money_Actual := Data.Test_Money_Ops (0.0,
Data.Money_Optr_Table_Cumul,
Data.Money_Opnd_Table_Cumul);
if Money_Actual /= Money_Cumul_Expected then
Report.Failed ("Wrong cumulation result for type Money");
end if;
---=---=---=---=---=---=---=---=---=---=---
Cash_Actual := Data.Test_Cash_Ops (0.0,
Data.Cash_Optr_Table_Cancel,
Data.Cash_Opnd_Table_Cancel);
if Cash_Actual /= Cash_Cancel_Expected then
Report.Failed ("Wrong cancellation result for type Cash");
end if;
---=---=---=---=---=---=---
Cash_Actual := Data.Test_Cash_Ops (0.0,
Data.Cash_Optr_Table_Cumul,
Data.Cash_Opnd_Table_Cumul);
if Cash_Actual /= Cash_Cumul_Expected then
Report.Failed ("Wrong cumulation result for type Cash");
end if;
---=---=---=---=---=---=---=---=---=---=---
Broad_Actual := Data.Test_Broad_Ops (0.0,
Data.Broad_Optr_Table_Cancel,
Data.Broad_Opnd_Table_Cancel);
if Broad_Actual /= Broad_Cancel_Expected then
Report.Failed ("Wrong cancellation result for type Broad");
end if;
---=---=---=---=---=---=---
Broad_Actual := Data.Test_Broad_Ops (0.0,
Data.Broad_Optr_Table_Cumul,
Data.Broad_Opnd_Table_Cumul);
if Broad_Actual /= Broad_Cumul_Expected then
Report.Failed ("Wrong cumulation result for type Broad");
end if;
---=---=---=---=---=---=---=---=---=---=---
Report.Result;
end CXF2A01;