| -- 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; |
