diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxf/cxf2004.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cxf/cxf2004.a | 513 |
1 files changed, 0 insertions, 513 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf2004.a b/gcc/testsuite/ada/acats/tests/cxf/cxf2004.a deleted file mode 100644 index 9651384ce7e..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf2004.a +++ /dev/null @@ -1,513 +0,0 @@ --- CXF2004.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 multiplying operators for a decimal fixed point type --- return values that are integral multiples of the small of the type. --- Check the case where one operand is of an ordinary fixed point type. --- --- Check that if the mathematical result is between multiples of the --- small of the result type, the result is truncated toward zero. --- Check that if the attribute 'Round is applied to the mathematical --- result, however, the result is rounded to the nearest multiple of --- the small (away from zero if the result is midway between two --- multiples of the small). --- --- TEST DESCRIPTION: --- Two decimal fixed point types A and B are declared, one with a --- Machine_Radix value of 2, and one with a value of 10. An ordinary --- fixed point type C is declared with a delta value different from --- those of A and B (although still a power of 10). For type A (and B), --- checks are performed on the following operations, where one operand --- type is C, and the other operand type and the result type is A (or B): --- --- - Multiplication. --- - Multiplication, where the attribute 'Round is applied to the --- result. --- - Division. --- - Division, where the attribute 'Round is applied to the result. --- --- Each operation is performed within a loop, where one operand is --- always the same variable. After the loop completes, the cumulative --- total contained in this variable is compared with the expected --- result. --- --- APPLICABILITY CRITERIA: --- This test is only applicable for a compiler attempting validation --- for the Information Systems Annex. --- --- --- CHANGE HISTORY: --- 22 Mar 96 SAIC Prerelease version for ACVC 2.1. --- 11 Aug 96 SAIC ACVC 2.1: In RADIX_2_MULTIPLICATION, corrected --- value of Rate. Corrected associated commentary. --- ---! - -generic - type Decimal_Fixed is delta <> digits <>; - type Ordinary_Fixed is delta <>; -package CXF2004_0 is - - procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed; - Factor : in Ordinary_Fixed); - - procedure Divide_And_Truncate (Balance : in out Decimal_Fixed; - Divisor : in Ordinary_Fixed); - - procedure Multiply_And_Round (Balance : in out Decimal_Fixed; - Factor : in Ordinary_Fixed); - - procedure Divide_And_Round (Balance : in out Decimal_Fixed; - Divisor : in Ordinary_Fixed); - -end CXF2004_0; - - - --==================================================================-- - - -package body CXF2004_0 is - - procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed; - Factor : in Ordinary_Fixed) is - Interest : Decimal_Fixed; - begin - Interest := Factor * Balance; -- Fixed-fixed multiplication. - Balance := Balance + Interest; - end Multiply_And_Truncate; - - - procedure Divide_And_Truncate (Balance : in out Decimal_Fixed; - Divisor : in Ordinary_Fixed) is - Interest : Decimal_Fixed; - begin - Interest := Balance / Divisor; -- Fixed-fixed division. - Balance := Balance + Interest; - end Divide_And_Truncate; - - - procedure Multiply_And_Round (Balance : in out Decimal_Fixed; - Factor : in Ordinary_Fixed) is - Interest : Decimal_Fixed; - begin - -- Fixed-fixed multiplication. - Interest := Decimal_Fixed'Round ( Factor * Balance ); - Balance := Balance + Interest; - end Multiply_And_Round; - - - procedure Divide_And_Round (Balance : in out Decimal_Fixed; - Divisor : in Ordinary_Fixed) is - Interest : Decimal_Fixed; - begin - -- Fixed-fixed division. - Interest := Decimal_Fixed'Round ( Balance / Divisor ); - Balance := Balance + Interest; - end Divide_And_Round; - -end CXF2004_0; - - - --==================================================================-- - - -package CXF2004_1 is - - type Money_Radix2 is delta 0.01 digits 11; -- range -999,999,999.99 .. - for Money_Radix2'Machine_Radix use 2; -- +999,999,999.99 - - - type Money_Radix10 is delta 0.01 digits 11; -- range -999,999,999.99 .. - for Money_Radix10'Machine_Radix use 10; -- +999,999,999.99 - - - type Interest_Rate is delta 0.001 range 0.0 .. 1_000.0; - for Interest_Rate'Small use 0.001; -- Power of 10. - -end CXF2004_1; - - - --==================================================================-- - - -with CXF2004_0; -with CXF2004_1; - -with Report; -procedure CXF2004 is - - Loop_Count : constant := 180; - type Loop_Range is range 1 .. Loop_Count; - - type Rounding_Scheme is ( Rounds, Truncates ); - Machine : Rounding_Scheme; - -begin - - Report.Test ("CXF2004", "Check decimal multiplication and division, and " & - "'Round, where one operand type is ordinary fixed"); - - - ---=---=---=---=---=---=---=---=---=---=--- - - if CXF2004_1.Interest_Rate'Machine_Rounds then -- Determine machine's - Machine := Rounds; -- rounding scheme. - else - Machine := Truncates; - end if; - - ---=---=---=---=---=---=---=---=---=---=--- - - - RADIX_2_SUBTESTS: - declare - package Radix_2 is new CXF2004_0 (CXF2004_1.Money_Radix2, - CXF2004_1.Interest_Rate); - use type CXF2004_1.Money_Radix2; - use type CXF2004_1.Interest_Rate; - begin - - RADIX_2_MULTIPLICATION: - declare - Rate : constant CXF2004_1.Interest_Rate := 0.154; - Period : constant Integer := 12; - Factor : CXF2004_1.Interest_Rate := Rate / Period; - - -- The exact value of Factor is: - -- - -- 0.154/12 = 0.01283333... - -- - -- The adjacent multiples of small are 0.012 and 0.013. Since - -- Factor is of an ordinary fixed point type, it may contain either - -- of these values. However, since "Rate / Period" is a static - -- expression, the value Factor contains is determined by the - -- value of CXF2004_1.Interest_Rate'Machine_Rounds: - -- - -- If Machine_Rounds = FALSE : Factor = 0.012 - -- If Machine_Rounds = TRUE : Factor = 0.013 - - Initial : constant CXF2004_1.Money_Radix2 := 1_000.00; - - Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 := 8_557.07; - Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 := 8_560.47; - - Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix2 := 10_222.65; - Round_Expected_MachRnds: constant CXF2004_1.Money_Radix2 := 10_225.81; - - Balance : CXF2004_1.Money_Radix2; - begin - ---=---=---=---=---=---=--- - - Balance := Initial; - - for I in Loop_Range loop - Radix_2.Multiply_And_Truncate (Balance, Factor); - end loop; - - case (Machine) is - when Rounds => - if Balance /= Trunc_Expected_MachRnds then - Report.Failed ("Error (R): Radix 2 multiply and truncate"); - end if; - when Truncates => - if Balance /= Trunc_Expected_MachTrnc then - Report.Failed ("Error (T): Radix 2 multiply and truncate"); - end if; - end case; - - ---=---=---=---=---=---=--- - - Balance := Initial; - - for I in Loop_Range loop - Radix_2.Multiply_And_Round (Balance, Factor); - end loop; - - case (Machine) is - when Rounds => - if Balance /= Round_Expected_MachRnds then - Report.Failed ("Error (R): Radix 2 multiply and round"); - end if; - when Truncates => - if Balance /= Round_Expected_MachTrnc then - Report.Failed ("Error (T): Radix 2 multiply and round"); - end if; - end case; - - ---=---=---=---=---=---=--- - end RADIX_2_MULTIPLICATION; - - - RADIX_2_DIVISION: - declare - Rate : constant CXF2004_1.Interest_Rate := 0.210; - Period : constant Integer := 12; - Factor : constant CXF2004_1.Interest_Rate := Rate / Period; - Divisor : CXF2004_1.Interest_Rate := 1.0 / Factor; - - -- The exact value of Factor is: - -- - -- 0.210/12 = 0.0175 - -- - -- The adjacent multiples of small are 0.017 and 0.018. Since - -- Factor is of an ordinary fixed point type, it may contain either - -- of these values. However, since "Rate / Period" is a static - -- expression, the value Factor contains is determined by the - -- value of CXF2004_1.Interest_Rate'Machine_Rounds: - -- - -- If Machine_Rounds = FALSE : Factor = 0.017 - -- If Machine_Rounds = TRUE : Factor = 0.018 - -- - -- The exact value of Divisor is one of the following values: - -- - -- 1.0/0.017 = 58.82352... (Adjacent smalls 58.823 and 58.824) - -- 1.0/0.018 = 55.55555... (Adjacent smalls 55.555 and 55.556) - -- - -- Again, since "1.0 / Factor" is static, the value Divisor contains - -- is determined by the value of CXF2004_1.Interest_Rate'Rounds: - -- - -- If Machine_Rounds = FALSE : Divisor = 58.823 - -- If Machine_Rounds = TRUE : Divisor = 55.556 - - Initial : constant CXF2004_1.Money_Radix2 := 260.13; - - Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 := 5_401.46; - Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 := 5_406.95; - - Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix2 := 6_446.56; - Round_Expected_MachRnds: constant CXF2004_1.Money_Radix2 := 6_453.78; - - Balance : CXF2004_1.Money_Radix2; - begin - ---=---=---=---=---=---=--- - - Balance := Initial; - - for I in Loop_Range loop - Radix_2.Divide_And_Truncate (Balance, Divisor); - end loop; - - case (Machine) is - when Rounds => - if Balance /= Trunc_Expected_MachRnds then - Report.Failed ("Error (R): Radix 2 divide and truncate"); - end if; - when Truncates => - if Balance /= Trunc_Expected_MachTrnc then - Report.Failed ("Error (T): Radix 2 divide and truncate"); - end if; - end case; - - ---=---=---=---=---=---=--- - - Balance := Initial; - - for I in Loop_Range loop - Radix_2.Divide_And_Round (Balance, Divisor); - end loop; - - case (Machine) is - when Rounds => - if Balance /= Round_Expected_MachRnds then - Report.Failed ("Error (R): Radix 2 divide and round"); - end if; - when Truncates => - if Balance /= Round_Expected_MachTrnc then - Report.Failed ("Error (T): Radix 2 divide and round"); - end if; - end case; - - ---=---=---=---=---=---=--- - end RADIX_2_DIVISION; - - end RADIX_2_SUBTESTS; - - - ---=---=---=---=---=---=---=---=---=---=--- - - - RADIX_10_SUBTESTS: - declare - package Radix_10 is new CXF2004_0 (CXF2004_1.Money_Radix10, - CXF2004_1.Interest_Rate); - use type CXF2004_1.Money_Radix10; - use type CXF2004_1.Interest_Rate; - begin - - RADIX_10_MULTIPLICATION: - declare - Rate : constant CXF2004_1.Interest_Rate := 0.095; - Period : constant Integer := 12; - Factor : CXF2004_1.Interest_Rate := Rate / Period; - - -- The exact value of Factor is: - -- - -- 0.095/12 = 0.00791666... - -- - -- The adjacent multiples of small are 0.007 and 0.008. Since - -- Factor is of an ordinary fixed point type, it may contain either - -- of these values. However, since "Rate / Period" is a static - -- expression, the value Factor contains can be determined based - -- on the value of CXF2004_1.Interest_Rate'Machine_Rounds: - -- - -- If Machine_Rounds = FALSE : Factor = 0.007 - -- If Machine_Rounds = TRUE : Factor = 0.008 - - Initial : constant CXF2004_1.Money_Radix10 := 2_125.00; - - Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 7_456.90; - Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 7_458.77; - - Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 8_915.74; - Round_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 8_917.84; - - Balance : CXF2004_1.Money_Radix10; - begin - ---=---=---=---=---=---=--- - - Balance := Initial; - - for I in Loop_Range loop - Radix_10.Multiply_And_Truncate (Balance, Factor); - end loop; - - case (Machine) is - when Rounds => - if Balance /= Trunc_Expected_MachRnds then - Report.Failed ("Error (R): Radix 10 multiply and truncate"); - end if; - when Truncates => - if Balance /= Trunc_Expected_MachTrnc then - Report.Failed ("Error (T): Radix 10 multiply and truncate"); - end if; - end case; - - ---=---=---=---=---=---=--- - - Balance := Initial; - - for I in Loop_Range loop - Radix_10.Multiply_And_Round (Balance, Factor); - end loop; - - case (Machine) is - when Rounds => - if Balance /= Round_Expected_MachRnds then - Report.Failed ("Error (R): Radix 10 multiply and round"); - end if; - when Truncates => - if Balance /= Round_Expected_MachTrnc then - Report.Failed ("Error (T): Radix 10 multiply and round"); - end if; - end case; - - ---=---=---=---=---=---=--- - end RADIX_10_MULTIPLICATION; - - - RADIX_10_DIVISION: - declare - Rate : constant CXF2004_1.Interest_Rate := 0.295; - Period : constant Integer := 12; - Factor : constant CXF2004_1.Interest_Rate := Rate / Period; - Divisor : CXF2004_1.Interest_Rate := 1.0 / Factor; - - -- The exact value of Factor is: - -- - -- 0.295/12 = 0.02458333... - -- - -- The adjacent multiples of small are 0.024 and 0.025. Thus, the - -- exact value of Divisor is one of the following: - -- - -- 1.0/0.024 = 41.66666... (Adjacent smalls 41.666 and 41.667) - -- 1.0/0.025 = 40.0 - -- - -- The value of CXF2004_1.Interest_Rate'Machine_Rounds determines - -- what Divisor contains: - -- - -- If Machine_Rounds = FALSE : Divisor = 41.666 - -- If Machine_Rounds = TRUE : Divisor = 40.000 - - Initial : constant CXF2004_1.Money_Radix10 := 72.19; - - Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 5_144.60; - Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 5_157.80; - - Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 6_133.28; - Round_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 6_149.06; - - Balance : CXF2004_1.Money_Radix10; - begin - ---=---=---=---=---=---=--- - - Balance := Initial; - - for I in Loop_Range loop - Radix_10.Divide_And_Truncate (Balance, Divisor); - end loop; - - case (Machine) is - when Rounds => - if Balance /= Trunc_Expected_MachRnds then - Report.Failed ("Error (R): Radix 10 divide and truncate"); - end if; - when Truncates => - if Balance /= Trunc_Expected_MachTrnc then - Report.Failed ("Error (T): Radix 10 divide and truncate"); - end if; - end case; - - ---=---=---=---=---=---=--- - - Balance := Initial; - - for I in Loop_Range loop - Radix_10.Divide_And_Round (Balance, Divisor); - end loop; - - case (Machine) is - when Rounds => - if Balance /= Round_Expected_MachRnds then - Report.Failed ("Error (R): Radix 10 divide and round"); - end if; - when Truncates => - if Balance /= Round_Expected_MachTrnc then - Report.Failed ("Error (T): Radix 10 divide and round"); - end if; - end case; - - ---=---=---=---=---=---=--- - end RADIX_10_DIVISION; - - end RADIX_10_SUBTESTS; - - - ---=---=---=---=---=---=---=---=---=---=--- - - - Report.Result; - -end CXF2004; |