--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a	Fri Oct 27 22:46:09 2017 +0900
@@ -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;