diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a')
-rw-r--r-- | gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a | 448 |
1 files changed, 0 insertions, 448 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a b/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a deleted file mode 100644 index 002c59d6c8e..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a +++ /dev/null @@ -1,448 +0,0 @@ --- 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; |