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/cxg/cxg2006.a | 281 ++++++++++++++++++++++++++++ 1 file changed, 281 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/cxg/cxg2006.a (limited to 'gcc/testsuite/ada/acats/tests/cxg/cxg2006.a') diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2006.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2006.a new file mode 100644 index 000000000..da15dc3be --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxg/cxg2006.a @@ -0,0 +1,281 @@ +-- CXG2006.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 complex Argument function returns +-- results that are within the error bound allowed. +-- Check that Argument_Error is raised if the Cycle parameter +-- is less than or equal to zero. +-- +-- TEST DESCRIPTION: +-- This test uses a generic package to compute and check the +-- values of the Argument function. +-- Of special interest is the case where either the real or +-- the imaginary part of the parameter is very large while the +-- other part is very small or 0. +-- +-- SPECIAL REQUIREMENTS +-- The Strict Mode for the numerical accuracy must be +-- selected. The method by which this mode is selected +-- is implementation dependent. +-- +-- APPLICABILITY CRITERIA: +-- This test applies only to implementations supporting the +-- Numerics Annex. +-- This test only applies to the Strict Mode for numerical +-- accuracy. +-- +-- +-- CHANGE HISTORY: +-- 15 FEB 96 SAIC Initial release for 2.1 +-- 03 MAR 97 PWB.CTA Removed checks involving explicit cycle => 2.0*Pi +-- +-- CHANGE NOTE: +-- According to Ken Dritz, author of the Numerics Annex of the RM, +-- one should never specify the cycle 2.0*Pi for the trigonometric +-- functions. In particular, if the machine number for the first +-- argument is not an exact multiple of the machine number for the +-- explicit cycle, then the specified exact results cannot be +-- reasonably expected. The affected checks in this test have been +-- marked as comments, with the additional notation "pwb-math". +-- Phil Brashear +--! + +-- +-- Reference: +-- Problems and Methodologies in Mathematical Software Production; +-- editors: P. C. Messina and A Murli; +-- Lecture Notes in Computer Science +-- Volume 142 +-- Springer Verlag 1982 +-- + +with System; +with Report; +with ImpDef.Annex_G; +with Ada.Numerics; +with Ada.Numerics.Generic_Complex_Types; +with Ada.Numerics.Complex_Types; +procedure CXG2006 is + Verbose : constant Boolean := False; + + + -- CRC Standard Mathematical Tables; 23rd Edition; pg 738 + Sqrt2 : constant := + 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695; + Sqrt3 : constant := + 1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039; + + Pi : constant := Ada.Numerics.Pi; + + generic + type Real is digits <>; + package Generic_Check is + procedure Do_Test; + end Generic_Check; + + package body Generic_Check is + package Complex_Types is new + Ada.Numerics.Generic_Complex_Types (Real); + use Complex_Types; + + + procedure Check (Actual, Expected : Real; + Test_Name : String; + MRE : Real) is + Rel_Error : Real; + Abs_Error : Real; + Max_Error : Real; + begin + -- In the case where the expected result is very small or 0 + -- we compute the maximum error as a multiple of Model_Epsilon instead + -- of Model_Epsilon and Expected. + Rel_Error := MRE * abs Expected * Real'Model_Epsilon; + Abs_Error := MRE * Real'Model_Epsilon; + if Rel_Error > Abs_Error then + Max_Error := Rel_Error; + else + Max_Error := Abs_Error; + end if; + + if abs (Actual - Expected) > Max_Error then + Report.Failed (Test_Name & + " actual: " & Real'Image (Actual) & + " expected: " & Real'Image (Expected) & + " difference: " & + Real'Image (Actual - Expected) & + " mre:" & Real'Image (Max_Error) ); + elsif Verbose then + if Actual = Expected then + Report.Comment (Test_Name & " exact result"); + else + Report.Comment (Test_Name & " passed"); + end if; + end if; + end Check; + + + procedure Special_Cases is + type Data_Point is + record + Re, + Im, + Radians, + Degrees, + Error_Bound : Real; + end record; + + type Test_Data_Type is array (Positive range <>) of Data_Point; + + -- the values in the following table only involve static + -- expressions to minimize errors in precision introduced by the + -- test. For cases where Pi is used in the argument we must + -- allow an extra 1.0*MRE to account for roundoff error in the + -- argument. Where the result involves a square root we allow + -- an extra 0.5*MRE to allow for roundoff error. + Test_Data : constant Test_Data_Type := ( +-- Re Im Radians Degrees Err Test # + (0.0, 0.0, 0.0, 0.0, 4.0 ), -- 1 + (1.0, 0.0, 0.0, 0.0, 4.0 ), -- 2 + (Real'Safe_Last, 0.0, 0.0, 0.0, 4.0 ), -- 3 + (Real'Model_Small, 0.0, 0.0, 0.0, 4.0 ), -- 4 + (1.0, 1.0, Pi/4.0, 45.0, 5.0 ), -- 5 + (1.0, -1.0, -Pi/4.0, -45.0, 5.0 ), -- 6 + (-1.0, -1.0, -3.0*Pi/4.0,-135.0, 5.0 ), -- 7 + (-1.0, 1.0, 3.0*Pi/4.0, 135.0, 5.0 ), -- 8 + (Sqrt3, 1.0, Pi/6.0, 30.0, 5.5 ), -- 9 + (-Sqrt3, 1.0, 5.0*Pi/6.0, 150.0, 5.5 ), -- 10 + (Sqrt3, -1.0, -Pi/6.0, -30.0, 5.5 ), -- 11 + (-Sqrt3, -1.0, -5.0*Pi/6.0,-150.0, 5.5 ), -- 12 + (Real'Model_Small, Real'Model_Small, Pi/4.0, 45.0, 5.0 ), -- 13 + (-Real'Safe_Last, 0.0, Pi, 180.0, 5.0 ), -- 14 + (-Real'Safe_Last, -Real'Model_Small, -Pi,-180.0, 5.0 ), -- 15 + (100000.0, 100000.0, Pi/4.0, 45.0, 5.0 )); -- 16 + + X : Real; + Z : Complex; + begin + for I in Test_Data'Range loop + begin + Z := (Test_Data(I).Re, Test_Data(I).Im); + X := Argument (Z); + Check (X, Test_Data(I).Radians, + "test" & Integer'Image (I) & " argument(z)", + Test_Data (I).Error_Bound); +--pwb-math X := Argument (Z, 2.0*Pi); +--pwb-math Check (X, Test_Data(I).Radians, +--pwb-math "test" & Integer'Image (I) & " argument(z, 2pi)", +--pwb-math Test_Data (I).Error_Bound); + X := Argument (Z, 360.0); + Check (X, Test_Data(I).Degrees, + "test" & Integer'Image (I) & " argument(z, 360)", + Test_Data (I).Error_Bound); + + exception + when Constraint_Error => + Report.Failed ("Constraint_Error raised in test" & + Integer'Image (I)); + when others => + Report.Failed ("exception in test" & + Integer'Image (I)); + end; + end loop; + + if Real'Signed_Zeros then + begin + X := Argument ((-1.0, Real(ImpDef.Annex_G.Negative_Zero))); + Check (X, -Pi, "test of arg((-1,-0)", 4.0); + exception + when others => + Report.Failed ("exception in signed zero test"); + end; + end if; + end Special_Cases; + + + procedure Exception_Cases is + -- check that Argument_Error is raised if Cycle is <= 0 + Z : Complex := (1.0, 1.0); + X : Real; + Y : Real; + begin + begin + X := Argument (Z, Cycle => 0.0); + Report.Failed ("no exception for cycle = 0.0"); + exception + when Ada.Numerics.Argument_Error => null; + when others => + Report.Failed ("wrong exception for cycle = 0.0"); + end; + + begin + Y := Argument (Z, Cycle => -3.0); + Report.Failed ("no exception for cycle < 0.0"); + exception + when Ada.Numerics.Argument_Error => null; + when others => + Report.Failed ("wrong exception for cycle < 0.0"); + end; + + if Report.Ident_Int (2) = 1 then + -- optimization thwarting code - never executed + Report.Failed("2=1" & Real'Image (X+Y)); + end if; + end Exception_Cases; + + + procedure Do_Test is + begin + Special_Cases; + Exception_Cases; + end Do_Test; + end Generic_Check; + + package Chk_Float is new Generic_Check (Float); + + -- check the floating point type with the most digits + type A_Long_Float is digits System.Max_Digits; + package Chk_A_Long_Float is new Generic_Check (A_Long_Float); +begin + Report.Test ("CXG2006", + "Check the accuracy of the complex argument" & + " function"); + + if Verbose then + Report.Comment ("checking Standard.Float"); + end if; + + Chk_Float.Do_Test; + + if Verbose then + Report.Comment ("checking a digits" & + Integer'Image (System.Max_Digits) & + " floating point type"); + end if; + + Chk_A_Long_Float.Do_Test; + + Report.Result; +end CXG2006; -- cgit v1.2.3