diff options
author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
---|---|---|
committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a | |
download | cbb-gcc-4.6.4-upstream.tar.bz2 cbb-gcc-4.6.4-upstream.tar.xz |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.
downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.
if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
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, 448 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a b/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a new file mode 100644 index 000000000..002c59d6c --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a @@ -0,0 +1,448 @@ +-- 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; |