From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; 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. --- gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a | 354 ++++++++++++++++++++++++++++ 1 file changed, 354 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a (limited to 'gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a') 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; -- cgit v1.2.3