summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.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/cxf2a02.a')
-rw-r--r--gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a354
1 files changed, 354 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a b/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a
new file mode 100644
index 000000000..e9977b0f5
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a
@@ -0,0 +1,354 @@
+-- CXF2A02.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 the operand and result types are the same.
+--
+-- Check that if the mathematical result is between multiples of the
+-- small of the result type, the result is truncated toward zero.
+--
+-- TEST DESCRIPTION:
+-- The test verifies that decimal multiplication and division behave as
+-- expected for types with various digits, delta, and Machine_Radix
+-- values.
+--
+-- The iteration, operation, and operand counts in the foundation, and
+-- the operations and operand tables in the test, are given values such
+-- that, when the operations loop is complete, truncation of inexact
+-- results should cause the result returned by the operations loop to be
+-- the same as that used to initialize the loop's cumulator variable (in
+-- this test, one).
+--
+-- TEST FILES:
+-- This test consists of the following files:
+--
+-- FXF2A00.A
+-- -> CXF2A02.A
+--
+-- APPLICABILITY CRITERIA:
+-- This test is only applicable for a compiler attempting validation
+-- for the Information Systems Annex.
+--
+--
+-- CHANGE HISTORY:
+-- 13 Mar 96 SAIC Prerelease version for ACVC 2.1.
+-- 04 Aug 96 SAIC Updated prologue.
+--
+--!
+
+package CXF2A02_0 is
+
+ ---=---=---=---=---=---=---=---=---=---=---
+
+ type Micro is delta 10.0**(-5) digits 6; -- range -9.99999 ..
+ for Micro'Machine_Radix use 2; -- +9.99999
+
+ function Multiply (Left, Right : Micro) return Micro;
+ function Divide (Left, Right : Micro) return Micro;
+
+
+ type Micro_Optr_Ptr is access function (Left, Right : Micro) return Micro;
+
+ Micro_Mult : Micro_Optr_Ptr := Multiply'Access;
+ Micro_Div : Micro_Optr_Ptr := Divide'Access;
+
+ ---=---=---=---=---=---=---=---=---=---=---
+
+ type Basic is delta 0.01 digits 11; -- range -999,999,999.99 ..
+ for Basic'Machine_Radix use 10; -- +999,999,999.99
+
+ function Multiply (Left, Right : Basic) return Basic;
+ function Divide (Left, Right : Basic) return Basic;
+
+
+ type Basic_Optr_Ptr is access function (Left, Right : Basic) return Basic;
+
+ Basic_Mult : Basic_Optr_Ptr := Multiply'Access;
+ Basic_Div : Basic_Optr_Ptr := Divide'Access;
+
+ ---=---=---=---=---=---=---=---=---=---=---
+
+ type Broad is delta 10.0**(-3) digits 10; -- range -9,999,999.999 ..
+ for Broad'Machine_Radix use 2; -- +9,999,999.999
+
+ function Multiply (Left, Right : Broad) return Broad;
+ function Divide (Left, Right : Broad) return Broad;
+
+
+ type Broad_Optr_Ptr is access function (Left, Right : Broad) return Broad;
+
+ Broad_Mult : Broad_Optr_Ptr := Multiply'Access;
+ Broad_Div : Broad_Optr_Ptr := Divide'Access;
+
+ ---=---=---=---=---=---=---=---=---=---=---
+
+end CXF2A02_0;
+
+
+ --==================================================================--
+
+
+package body CXF2A02_0 is
+
+ ---=---=---=---=---=---=---=---=---=---=---
+
+ function Multiply (Left, Right : Micro) return Micro is
+ begin
+ return (Left * Right); -- Decimal fixed multiplication.
+ end Multiply;
+
+ function Divide (Left, Right : Micro) return Micro is
+ begin
+ return (Left / Right); -- Decimal fixed division.
+ end Divide;
+
+ ---=---=---=---=---=---=---=---=---=---=---
+
+ function Multiply (Left, Right : Basic) return Basic is
+ begin
+ return (Left * Right); -- Decimal fixed multiplication.
+ end Multiply;
+
+ function Divide (Left, Right : Basic) return Basic is
+ begin
+ return (Left / Right); -- Decimal fixed division.
+ end Divide;
+
+ ---=---=---=---=---=---=---=---=---=---=---
+
+ function Multiply (Left, Right : Broad) return Broad is
+ begin
+ return (Left * Right); -- Decimal fixed multiplication.
+ end Multiply;
+
+ function Divide (Left, Right : Broad) return Broad is
+ begin
+ return (Left / Right); -- Decimal fixed division.
+ end Divide;
+
+ ---=---=---=---=---=---=---=---=---=---=---
+
+end CXF2A02_0;
+
+
+ --==================================================================--
+
+
+with FXF2A00;
+package CXF2A02_0.CXF2A02_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_Mult_Operator_Table : Micro_Ops := ( Micro_Mult, Micro_Mult,
+ Micro_Mult, Micro_Mult,
+ Micro_Mult, Micro_Mult );
+
+ Micro_Div_Operator_Table : Micro_Ops := ( Micro_Div, Micro_Div,
+ Micro_Div, Micro_Div,
+ Micro_Div, Micro_Div );
+
+ Micro_Mult_Operand_Table : Micro_Opnds := ( 2.35119,
+ 0.05892,
+ 9.58122,
+ 0.80613,
+ 0.93462 );
+
+ Micro_Div_Operand_Table : Micro_Opnds := ( 0.58739,
+ 4.90012,
+ 0.08765,
+ 0.71577,
+ 5.53768 );
+
+ 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 Basic_Ops is array (FXF2A00.Optr_Range) of Basic_Optr_Ptr;
+ type Basic_Opnds is array (FXF2A00.Opnd_Range) of Basic;
+
+ Basic_Mult_Operator_Table : Basic_Ops := ( Basic_Mult, Basic_Mult,
+ Basic_Mult, Basic_Mult,
+ Basic_Mult, Basic_Mult );
+
+ Basic_Div_Operator_Table : Basic_Ops := ( Basic_Div, Basic_Div,
+ Basic_Div, Basic_Div,
+ Basic_Div, Basic_Div );
+
+ Basic_Mult_Operand_Table : Basic_Opnds := ( 127.10,
+ 0.02,
+ 0.87,
+ 45.67,
+ 0.01 );
+
+ Basic_Div_Operand_Table : Basic_Opnds := ( 0.03,
+ 0.08,
+ 23.57,
+ 0.11,
+ 159.11 );
+
+ function Test_Basic_Ops is new FXF2A00.Operations_Loop
+ (Decimal_Fixed => Basic,
+ Operator_Ptr => Basic_Optr_Ptr,
+ Operator_Table => Basic_Ops,
+ Operand_Table => Basic_Opnds);
+
+ ---=---=---=---=---=---=---=---=---=---=---
+
+ type Broad_Ops is array (FXF2A00.Optr_Range) of Broad_Optr_Ptr;
+ type Broad_Opnds is array (FXF2A00.Opnd_Range) of Broad;
+
+ Broad_Mult_Operator_Table : Broad_Ops := ( Broad_Mult, Broad_Mult,
+ Broad_Mult, Broad_Mult,
+ Broad_Mult, Broad_Mult );
+
+ Broad_Div_Operator_Table : Broad_Ops := ( Broad_Div, Broad_Div,
+ Broad_Div, Broad_Div,
+ Broad_Div, Broad_Div );
+
+ Broad_Mult_Operand_Table : Broad_Opnds := ( 589.720,
+ 0.106,
+ 21.018,
+ 0.002,
+ 0.381 );
+
+ Broad_Div_Operand_Table : Broad_Opnds := ( 0.008,
+ 0.793,
+ 9.092,
+ 214.300,
+ 0.080 );
+
+ 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 CXF2A02_0.CXF2A02_1;
+
+
+ --==================================================================--
+
+
+with CXF2A02_0.CXF2A02_1;
+
+with Report;
+procedure CXF2A02 is
+ package Data renames CXF2A02_0.CXF2A02_1;
+
+ use type CXF2A02_0.Micro;
+ use type CXF2A02_0.Basic;
+ use type CXF2A02_0.Broad;
+
+ Micro_Expected : constant CXF2A02_0.Micro := 1.0;
+ Basic_Expected : constant CXF2A02_0.Basic := 1.0;
+ Broad_Expected : constant CXF2A02_0.Broad := 1.0;
+
+ Micro_Actual : CXF2A02_0.Micro;
+ Basic_Actual : CXF2A02_0.Basic;
+ Broad_Actual : CXF2A02_0.Broad;
+begin
+
+ Report.Test ("CXF2A02", "Check decimal multiplication and division, " &
+ "where the operand and result types are the same");
+
+ ---=---=---=---=---=---=---=---=---=---=---
+
+ Micro_Actual := 0.0;
+ Micro_Actual := Data.Test_Micro_Ops (1.0,
+ Data.Micro_Mult_Operator_Table,
+ Data.Micro_Mult_Operand_Table);
+
+ if Micro_Actual /= Micro_Expected then
+ Report.Failed ("Wrong result for type Micro multiplication");
+ end if;
+
+
+ Micro_Actual := 0.0;
+ Micro_Actual := Data.Test_Micro_Ops (1.0,
+ Data.Micro_Div_Operator_Table,
+ Data.Micro_Div_Operand_Table);
+
+ if Micro_Actual /= Micro_Expected then
+ Report.Failed ("Wrong result for type Micro division");
+ end if;
+
+ ---=---=---=---=---=---=---=---=---=---=---
+
+ Basic_Actual := 0.0;
+ Basic_Actual := Data.Test_Basic_Ops (1.0,
+ Data.Basic_Mult_Operator_Table,
+ Data.Basic_Mult_Operand_Table);
+
+ if Basic_Actual /= Basic_Expected then
+ Report.Failed ("Wrong result for type Basic multiplication");
+ end if;
+
+
+ Basic_Actual := 0.0;
+ Basic_Actual := Data.Test_Basic_Ops (1.0,
+ Data.Basic_Div_Operator_Table,
+ Data.Basic_Div_Operand_Table);
+
+ if Basic_Actual /= Basic_Expected then
+ Report.Failed ("Wrong result for type Basic division");
+ end if;
+
+ ---=---=---=---=---=---=---=---=---=---=---
+
+ Broad_Actual := 0.0;
+ Broad_Actual := Data.Test_Broad_Ops (1.0,
+ Data.Broad_Mult_Operator_Table,
+ Data.Broad_Mult_Operand_Table);
+
+ if Broad_Actual /= Broad_Expected then
+ Report.Failed ("Wrong result for type Broad multiplication");
+ end if;
+
+
+ Broad_Actual := 0.0;
+ Broad_Actual := Data.Test_Broad_Ops (1.0,
+ Data.Broad_Div_Operator_Table,
+ Data.Broad_Div_Operand_Table);
+
+ if Broad_Actual /= Broad_Expected then
+ Report.Failed ("Wrong result for type Broad division");
+ end if;
+
+ ---=---=---=---=---=---=---=---=---=---=---
+
+ Report.Result;
+
+end CXF2A02;