aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a
diff options
context:
space:
mode:
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, 0 insertions, 354 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a b/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a
deleted file mode 100644
index e9977b0f502..00000000000
--- a/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a
+++ /dev/null
@@ -1,354 +0,0 @@
--- 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;
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-20 13:31:09 +0000