URL
https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk
Subversion Repositories openrisc_me
[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxf/] [cxf2a02.a] - Rev 316
Go to most recent revision | Compare with Previous | Blame | View Log
-- 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;
Go to most recent revision | Compare with Previous | Blame | View Log