| -- 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; |
