URL
https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk
Subversion Repositories openrisc_2011-10-31
Compare Revisions
- This comparison shows the changes necessary to convert path
/openrisc/tags/gnu-src/gcc-4.5.1/gcc-4.5.1-or32-1.0rc1/gcc/testsuite/ada/acats/tests/cxg
- from Rev 294 to Rev 338
- ↔ Reverse comparison
Rev 294 → Rev 338
/cxg1001.a
0,0 → 1,276
-- CXG1001.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 subprograms defined in the package |
-- Ada.Numerics.Generic_Complex_Types provide correct results. |
-- Specifically, check the functions Re, Im (both versions), procedures |
-- Set_Re, Set_Im (both versions), functions Compose_From_Cartesian (all |
-- versions), Compose_From_Polar, Modulus, Argument, and "abs". |
-- |
-- TEST DESCRIPTION: |
-- The generic package Generic_Complex_Types |
-- is instantiated with a real type (new Float), and the results |
-- produced by the specified subprograms are verified. |
-- |
-- APPLICABILITY CRITERIA: |
-- This test applies only to implementations supporting the |
-- Numerics Annex. |
-- |
-- |
-- CHANGE HISTORY: |
-- 06 Dec 94 SAIC ACVC 2.0 |
-- 15 Nov 95 SAIC Corrected visibility problems for ACVC 2.0.1. |
-- Modified subtest for Compose_From_Polar. |
-- 29 Sep 96 SAIC Incorporated reviewer comments. |
-- |
--! |
|
with Ada.Numerics.Generic_Complex_Types; |
with Report; |
|
procedure CXG1001 is |
|
begin |
|
Report.Test ("CXG1001", "Check that the subprograms defined in " & |
"the package Ada.Numerics.Generic_Complex_Types " & |
"provide correct results"); |
|
Test_Block: |
declare |
|
type Real_Type is new Float; |
|
package Complex_Pack is new |
Ada.Numerics.Generic_Complex_Types(Real_Type); |
|
use type Complex_Pack.Complex; |
|
-- Declare a zero valued complex number. |
Complex_Zero : constant Complex_Pack.Complex := (0.0, 0.0); |
|
TC_Complex : Complex_Pack.Complex := Complex_Zero; |
TC_Imaginary : Complex_Pack.Imaginary; |
|
begin |
|
-- Check that the procedures Set_Re and Set_Im (both versions) provide |
-- correct results. |
|
declare |
TC_Complex_Real_Field : Complex_Pack.Complex := (5.0, 0.0); |
TC_Complex_Both_Fields : Complex_Pack.Complex := (5.0, 7.0); |
begin |
|
Complex_Pack.Set_Re(X => TC_Complex, Re => 5.0); |
|
if TC_Complex /= TC_Complex_Real_Field then |
Report.Failed("Incorrect results from Procedure Set_Re"); |
end if; |
|
Complex_Pack.Set_Im(X => TC_Complex, Im => 7.0); |
|
if TC_Complex.Re /= 5.0 or |
TC_Complex.Im /= 7.0 or |
TC_Complex /= TC_Complex_Both_Fields |
then |
Report.Failed("Incorrect results from Procedure Set_Im " & |
"with Complex argument"); |
end if; |
|
Complex_Pack.Set_Im(X => TC_Imaginary, Im => 3.0); |
|
|
if Complex_Pack.Im(TC_Imaginary) /= 3.0 then |
Report.Failed("Incorrect results returned following the use " & |
"of Procedure Set_Im with Imaginary argument"); |
end if; |
|
end; |
|
|
-- Check that the functions Re and Im (both versions) provide |
-- correct results. |
|
declare |
TC_Complex_1 : Complex_Pack.Complex := (1.0, 0.0); |
TC_Complex_2 : Complex_Pack.Complex := (0.0, 2.0); |
TC_Complex_3 : Complex_Pack.Complex := (4.0, 3.0); |
begin |
|
-- Function Re. |
|
if Complex_Pack.Re(X => TC_Complex_1) /= 1.0 or |
Complex_Pack.Re(X => TC_Complex_2) /= 0.0 or |
Complex_Pack.Re(X => TC_Complex_3) /= 4.0 |
then |
Report.Failed("Incorrect results from Function Re"); |
end if; |
|
-- Function Im; version with Complex argument. |
|
if Complex_Pack.Im(X => TC_Complex_1) /= 0.0 or |
Complex_Pack.Im(X => TC_Complex_2) /= 2.0 or |
Complex_Pack.Im(X => TC_Complex_3) /= 3.0 |
then |
Report.Failed("Incorrect results from Function Im " & |
"with Complex argument"); |
end if; |
|
|
-- Function Im; version with Imaginary argument. |
|
if Complex_Pack.Im(Complex_Pack.i) /= 1.0 or |
Complex_Pack.Im(Complex_Pack.j) /= 1.0 |
then |
Report.Failed("Incorrect results from use of Function Im " & |
"when used with an Imaginary argument"); |
end if; |
|
end; |
|
|
-- Verify the results of the three versions of Function |
-- Compose_From_Cartesian |
|
declare |
|
Zero : constant Real_Type := 0.0; |
Six : constant Real_Type := 6.0; |
|
TC_Complex_1 : Complex_Pack.Complex := (3.0, 8.0); |
TC_Complex_2 : Complex_Pack.Complex := (Six, Zero); |
TC_Complex_3 : Complex_Pack.Complex := (Zero, 1.0); |
|
begin |
|
TC_Complex := Complex_Pack.Compose_From_Cartesian(3.0, 8.0); |
|
if TC_Complex /= TC_Complex_1 then |
Report.Failed("Incorrect results from Function " & |
"Compose_From_Cartesian - 1"); |
end if; |
|
-- If only one component is given, the other component is |
-- implicitly zero (Both components are set by the following two |
-- function calls). |
|
TC_Complex := Complex_Pack.Compose_From_Cartesian(Re => 6.0); |
|
if TC_Complex /= TC_Complex_2 then |
Report.Failed("Incorrect results from Function " & |
"Compose_From_Cartesian - 2"); |
end if; |
|
TC_Complex := |
Complex_Pack.Compose_From_Cartesian(Im => Complex_Pack.i); |
|
if TC_Complex /= TC_Complex_3 then |
Report.Failed("Incorrect results from Function " & |
"Compose_From_Cartesian - 3"); |
end if; |
|
end; |
|
|
-- Verify the results of Function Compose_From_Polar, Modulus, "abs", |
-- and Argument. |
|
declare |
|
use Complex_Pack; |
|
TC_Modulus, |
TC_Argument : Real_Type := 0.0; |
|
|
Angle_0 : constant Real_Type := 0.0; |
Angle_90 : constant Real_Type := 90.0; |
Angle_180 : constant Real_Type := 180.0; |
Angle_270 : constant Real_Type := 270.0; |
Angle_360 : constant Real_Type := 360.0; |
|
begin |
|
-- Verify the result of Function Compose_From_Polar. |
-- When the value of the parameter Modulus is zero, the |
-- Compose_From_Polar function yields a result of zero. |
|
if Compose_From_Polar(0.0, 30.0, 360.0) /= Complex_Zero |
then |
Report.Failed("Incorrect result from Function " & |
"Compose_From_Polar - 1"); |
end if; |
|
-- When the value of the parameter Argument is equal to a multiple |
-- of the quarter cycle, the result of the Compose_From_Polar |
-- function with specified cycle lies on one of the axes. |
|
if Compose_From_Polar( 5.0, Angle_0, Angle_360) /= (5.0, 0.0) or |
Compose_From_Polar( 5.0, Angle_90, Angle_360) /= (0.0, 5.0) or |
Compose_From_Polar(-5.0, Angle_180, Angle_360) /= (5.0, 0.0) or |
Compose_From_Polar(-5.0, Angle_270, Angle_360) /= (0.0, 5.0) or |
Compose_From_Polar(-5.0, Angle_90, Angle_360) /= (0.0, -5.0) or |
Compose_From_Polar( 5.0, Angle_270, Angle_360) /= (0.0, -5.0) |
then |
Report.Failed("Incorrect result from Function " & |
"Compose_From_Polar - 2"); |
end if; |
|
-- When the parameter to Function Argument represents a point on |
-- the non-negative real axis, the function yields a zero result. |
|
if Argument(Complex_Zero, Angle_360) /= 0.0 then |
Report.Failed("Incorrect result from Function Argument"); |
end if; |
|
-- Function Modulus |
|
if Modulus(Complex_Zero) /= 0.0 or |
Modulus(Compose_From_Polar( 5.0, Angle_90, Angle_360)) /= 5.0 or |
Modulus(Compose_From_Polar(-5.0, Angle_180, Angle_360)) /= 5.0 |
then |
Report.Failed("Incorrect results from Function Modulus"); |
end if; |
|
-- Function "abs", a rename of Function Modulus. |
|
if "abs"(Complex_Zero) /= 0.0 or |
"abs"(Compose_From_Polar( 5.0, Angle_90, Angle_360)) /= 5.0 or |
"abs"(Compose_From_Polar(-5.0, Angle_180, Angle_360)) /= 5.0 |
then |
Report.Failed("Incorrect results from Function abs"); |
end if; |
|
end; |
|
exception |
when others => Report.Failed ("Exception raised in Test_Block"); |
end Test_Block; |
|
Report.Result; |
|
end CXG1001; |
/cxg1002.a
0,0 → 1,198
-- CXG1002.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 subprograms defined in the package |
-- Ada.Numerics.Generic_Complex_Types provide the prescribed results. |
-- Specifically, check the various versions of functions "+" and "-". |
-- |
-- TEST DESCRIPTION: |
-- This test checks that the subprograms "+" and "-" defined in the |
-- Generic_Complex_Types package provide the results prescribed for the |
-- evaluation of these complex arithmetic operations. The functions |
-- Re and Im are used to extract the appropriate component of the |
-- complex result, in order that the prescribed result component can be |
-- verified. |
-- The generic package is instantiated with a real type (new Float), |
-- and the results produced by the specified subprograms are verified. |
-- |
-- SPECIAL REQUIREMENTS: |
-- This test can be run in either "relaxed" or "strict" mode. |
-- |
-- |
-- CHANGE HISTORY: |
-- 06 Dec 94 SAIC ACVC 2.0 |
-- |
--! |
|
with Ada.Numerics.Generic_Complex_Types; |
with Report; |
|
procedure CXG1002 is |
|
begin |
|
Report.Test ("CXG1002", "Check that the subprograms defined in " & |
"the package Ada.Numerics.Generic_Complex_Types " & |
"provide the prescribed results"); |
|
Test_Block: |
declare |
|
type Real_Type is new Float; |
|
package Complex_Pack is new |
Ada.Numerics.Generic_Complex_Types(Real_Type); |
use Complex_Pack; |
|
-- Declare a zero valued complex number using the record |
-- aggregate approach. |
|
Complex_Zero : constant Complex_Pack.Complex := (0.0, 0.0); |
|
TC_Complex, |
TC_Complex_Right, |
TC_Complex_Left : Complex_Pack.Complex := Complex_Zero; |
|
TC_Real : Real_Type := 0.0; |
|
TC_Imaginary : Complex_Pack.Imaginary; |
|
begin |
|
|
-- Check that the imaginary component of the result of a binary addition |
-- operator that yields a result of complex type is exact when either |
-- of its operands is of pure-real type. |
|
TC_Complex := Compose_From_Cartesian(2.0, 3.0); |
TC_Real := 3.0; |
|
if Im("+"(Left => TC_Complex, Right => TC_Real)) /= 3.0 or |
Im("+"(TC_Complex, 6.0)) /= 3.0 or |
Im(TC_Complex + TC_Real) /= 3.0 or |
Im(TC_Complex + 5.0) /= 3.0 or |
Im((7.0, 2.0) + 1.0) /= 2.0 or |
Im((7.0, 5.0) + (-2.0)) /= 5.0 or |
Im((-7.0, -2.0) + 1.0) /= -2.0 or |
Im((-7.0, -3.0) + (-3.0)) /= -3.0 |
then |
Report.Failed("Incorrect results from Function ""+"" with " & |
"one Complex and one Real argument - 1"); |
end if; |
|
if Im("+"(Left => TC_Real, Right => TC_Complex)) /= 3.0 or |
Im("+"(4.0, TC_Complex)) /= 3.0 or |
Im(TC_Real + TC_Complex) /= 3.0 or |
Im(9.0 + TC_Complex) /= 3.0 or |
Im(1.0 + (7.0, -9.0)) /= -9.0 or |
Im((-2.0) + (7.0, 2.0)) /= 2.0 or |
Im(1.0 + (-7.0, -5.0)) /= -5.0 or |
Im((-3.0) + (-7.0, 16.0)) /= 16.0 |
then |
Report.Failed("Incorrect results from Function ""+"" with " & |
"one Complex and one Real argument - 2"); |
end if; |
|
|
-- Check that the imaginary component of the result of a binary |
-- subtraction operator that yields a result of complex type is exact |
-- when its right operand is of pure-real type. |
|
TC_Complex := (8.0, -4.0); |
TC_Real := 2.0; |
|
if Im("-"(Left => TC_Complex, Right => TC_Real)) /= -4.0 or |
Im("-"(TC_Complex, 5.0)) /= -4.0 or |
Im(TC_Complex - TC_Real) /= -4.0 or |
Im(TC_Complex - 4.0) /= -4.0 or |
Im((6.0, 5.0) - 1.0) /= 5.0 or |
Im((6.0, 13.0) - 7.0) /= 13.0 or |
Im((-5.0, 3.0) - (2.0)) /= 3.0 or |
Im((-5.0, -6.0) - (-3.0)) /= -6.0 |
then |
Report.Failed("Incorrect results from Function ""-"" with " & |
"one Complex and one Real argument"); |
end if; |
|
|
-- Check that the real component of the result of a binary addition |
-- operator that yields a result of complex type is exact when either |
-- of its operands is of pure-imaginary type. |
|
TC_Complex := (5.0, 0.0); |
|
if Re("+"(Left => TC_Complex, Right => i)) /= 5.0 or |
Re("+"(Complex_Pack.j, TC_Complex)) /= 5.0 or |
Re((-8.0, 5.0) + ( 2.0*i)) /= -8.0 or |
Re((2.0, 5.0) + (-2.0*i)) /= 2.0 or |
Re((-20.0, -5.0) + ( 3.0*i)) /= -20.0 or |
Re((6.0, -5.0) + (-3.0*i)) /= 6.0 |
then |
Report.Failed("Incorrect results from Function ""+"" with " & |
"one Complex and one Imaginary argument"); |
end if; |
|
|
-- Check that the real component of the result of a binary |
-- subtraction operator that yields a result of complex type is exact |
-- when its right operand is of pure-imaginary type. |
|
TC_Complex := TC_Complex + i; -- Should produce (5.0, 1.0) |
|
if Re("-"(TC_Complex, i)) /= 5.0 or |
Re((-4.0, 4.0) - ( 2.0*i)) /= -4.0 or |
Re((9.0, 4.0) - ( 5.0*i)) /= 9.0 or |
Re((16.0, -5.0) - ( 3.0*i)) /= 16.0 or |
Re((-3.0, -5.0) - (-4.0*i)) /= -3.0 |
then |
Report.Failed("Incorrect results from Function ""-"" with " & |
"one Complex and one Imaginary argument"); |
end if; |
|
|
-- Check that the result of a binary addition operation is exact when |
-- one of its operands is of real type and the other is of |
-- pure-imaginary type; the operator is analogous to the |
-- Compose_From_Cartesian function; it performs no arithmetic. |
|
TC_Complex := Complex_Pack."+"(5.0, Complex_Pack.i); |
|
if TC_Complex /= (5.0, 1.0) or |
(4.0 + i) /= (4.0, 1.0) or |
"+"(Left => j, Right => 3.0) /= (3.0, 1.0) |
then |
Report.Failed("Incorrect results from Function ""+"" with " & |
"one Real and one Imaginary argument"); |
end if; |
|
|
exception |
when others => Report.Failed ("Exception raised in Test_Block"); |
end Test_Block; |
|
Report.Result; |
|
end CXG1002; |
/cxg2001.a
0,0 → 1,322
-- CXG2001.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 floating point attributes Model_Mantissa, |
-- Machine_Mantissa, Machine_Radix, and Machine_Rounds |
-- are properly reported. |
-- |
-- TEST DESCRIPTION: |
-- This test uses a generic package to compute and check the |
-- values of the Machine_ attributes listed above. The |
-- generic package is instantiated with the standard FLOAT |
-- type and a floating point type for the maximum number |
-- of digits of precision. |
-- |
-- APPLICABILITY CRITERIA: |
-- This test applies only to implementations supporting the |
-- Numerics Annex. |
-- |
-- |
-- CHANGE HISTORY: |
-- 26 JAN 96 SAIC Initial Release for 2.1 |
-- |
--! |
|
-- References: |
-- |
-- "Algorithms To Reveal Properties of Floating-Point Arithmetic" |
-- Michael A. Malcolm; CACM November 1972; pgs 949-951. |
-- |
-- Software Manual for Elementary Functions; W. J. Cody and W. Waite; |
-- Prentice-Hall; 1980 |
----------------------------------------------------------------------- |
-- |
-- This test relies upon the fact that |
-- (A+2.0)-A is not necessarily 2.0. If A is large enough then adding |
-- a small value to A does not change the value of A. Consider the case |
-- where we have a decimal based floating point representation with 4 |
-- digits of precision. A floating point number would logically be |
-- represented as "DDDD * 10 ** exp" where D is a value in the range 0..9. |
-- The first loop of the test starts A at 2.0 and doubles it until |
-- ((A+1.0)-A)-1.0 is no longer zero. For our decimal floating point |
-- number this will be 1638 * 10**1 (the value 16384 rounded or truncated |
-- to fit in 4 digits). |
-- The second loop starts B at 2.0 and keeps doubling B until (A+B)-A is |
-- no longer 0. This will keep looping until B is 8.0 because that is |
-- the first value where rounding (assuming our machine rounds and addition |
-- employs a guard digit) will change the upper 4 digits of the result: |
-- 1638_ |
-- + 8 |
-- ------- |
-- 1639_ |
-- Without rounding the second loop will continue until |
-- B is 16: |
-- 1638_ |
-- + 16 |
-- ------- |
-- 1639_ |
-- |
-- The radix is then determined by (A+B)-A which will give 10. |
-- |
-- The use of Tmp and ITmp in the test is to force values to be |
-- stored into memory in the event that register precision is greater |
-- than the stored precision of the floating point values. |
-- |
-- |
-- The test for rounding is (ignoring the temporary variables used to |
-- get the stored precision) is |
-- Rounds := A + Radix/2.0 - A /= 0.0 ; |
-- where A is the value determined in the first step that is the smallest |
-- power of 2 such that A + 1.0 = A. This means that the true value of |
-- A has one more digit in its value than 'Machine_Mantissa. |
-- This check will detect the case where a value is always rounded. |
-- There is an additional case where values are rounded to the nearest |
-- even value. That is referred to as IEEE style rounding in the test. |
-- |
----------------------------------------------------------------------- |
|
with System; |
with Report; |
with Ada.Numerics.Generic_Elementary_Functions; |
procedure CXG2001 is |
Verbose : constant Boolean := False; |
|
-- if one of the attribute computation loops exceeds Max_Iterations |
-- it is most likely due to the compiler reordering an expression |
-- that should not be reordered. |
Illegal_Optimization : exception; |
Max_Iterations : constant := 10_000; |
|
generic |
type Real is digits <>; |
package Chk_Attrs is |
procedure Do_Test; |
end Chk_Attrs; |
|
package body Chk_Attrs is |
package EF is new Ada.Numerics.Generic_Elementary_Functions (Real); |
function Log (X : Real) return Real renames EF.Log; |
|
|
-- names used in paper |
Radix : Integer; -- Beta |
Mantissa_Digits : Integer; -- t |
Rounds : Boolean; -- RND |
|
-- made global to Determine_Attributes to help thwart optimization |
A, B : Real := 2.0; |
Tmp, Tmpa, Tmp1 : Real; |
ITmp : Integer; |
Half_Radix : Real; |
|
-- special constants - not declared as constants so that |
-- the "stored" precision will be used instead of a "register" |
-- precision. |
Zero : Real := 0.0; |
One : Real := 1.0; |
Two : Real := 2.0; |
|
|
procedure Thwart_Optimization is |
-- the purpose of this procedure is to reference the |
-- global variables used by Determine_Attributes so |
-- that the compiler is not likely to keep them in |
-- a higher precision register for their entire lifetime. |
begin |
if Report.Ident_Bool (False) then |
-- never executed |
A := A + 5.0; |
B := B + 6.0; |
Tmp := Tmp + 1.0; |
Tmp1 := Tmp1 + 2.0; |
Tmpa := Tmpa + 2.0; |
One := 12.34; Two := 56.78; Zero := 90.12; |
end if; |
end Thwart_Optimization; |
|
|
-- determines values for Radix, Mantissa_Digits, and Rounds |
-- This is mostly a straight translation of the C code. |
-- The only significant addition is the iteration count |
-- to prevent endless looping if things are really screwed up. |
procedure Determine_Attributes is |
Iterations : Integer; |
begin |
Rounds := True; |
|
Iterations := 0; |
Tmp := Real'Machine (((A + One) - A) - One); |
while Tmp = Zero loop |
A := Real'Machine(A + A); |
Tmp := Real'Machine(A + One); |
Tmp1 := Real'Machine(Tmp - A); |
Tmp := Real'Machine(Tmp1 - One); |
|
Iterations := Iterations + 1; |
if Iterations > Max_Iterations then |
raise Illegal_Optimization; |
end if; |
end loop; |
|
Iterations := 0; |
Tmp := Real'Machine(A + B); |
ITmp := Integer (Tmp - A); |
while ITmp = 0 loop |
B := Real'Machine(B + B); |
Tmp := Real'Machine(A + B); |
ITmp := Integer (Tmp - A); |
|
Iterations := Iterations + 1; |
if Iterations > Max_Iterations then |
raise Illegal_Optimization; |
end if; |
end loop; |
|
Radix := ITmp; |
|
Mantissa_Digits := 0; |
B := 1.0; |
Tmp := Real'Machine(((B + One) - B) - One); |
Iterations := 0; |
while (Tmp = Zero) loop |
Mantissa_Digits := Mantissa_Digits + 1; |
B := B * Real (Radix); |
Tmp := Real'Machine(B + One); |
Tmp1 := Real'Machine(Tmp - B); |
Tmp := Real'Machine(Tmp1 - One); |
|
Iterations := Iterations + 1; |
if Iterations > Max_Iterations then |
raise Illegal_Optimization; |
end if; |
end loop; |
|
Rounds := False; |
Half_Radix := Real (Radix) / Two; |
Tmp := Real'Machine(A + Half_Radix); |
Tmp1 := Real'Machine(Tmp - A); |
if (Tmp1 /= Zero) then |
Rounds := True; |
end if; |
Tmpa := Real'Machine(A + Real (Radix)); |
Tmp := Real'Machine(Tmpa + Half_Radix); |
if not Rounds and (Tmp - TmpA /= Zero) then |
Rounds := True; |
if Verbose then |
Report.Comment ("IEEE style rounding"); |
end if; |
end if; |
|
exception |
when others => |
Thwart_Optimization; |
raise; |
end Determine_Attributes; |
|
|
procedure Do_Test is |
Show_Results : Boolean := Verbose; |
Min_Mantissa_Digits : Integer; |
begin |
-- compute the actual Machine_* attribute values |
Determine_Attributes; |
|
if Real'Machine_Radix /= Radix then |
Report.Failed ("'Machine_Radix incorrectly reports" & |
Integer'Image (Real'Machine_Radix)); |
Show_Results := True; |
end if; |
|
if Real'Machine_Mantissa /= Mantissa_Digits then |
Report.Failed ("'Machine_Mantissa incorrectly reports" & |
Integer'Image (Real'Machine_Mantissa)); |
Show_Results := True; |
end if; |
|
if Real'Machine_Rounds /= Rounds then |
Report.Failed ("'Machine_Rounds incorrectly reports " & |
Boolean'Image (Real'Machine_Rounds)); |
Show_Results := True; |
end if; |
|
if Show_Results then |
Report.Comment ("computed Machine_Mantissa is" & |
Integer'Image (Mantissa_Digits)); |
Report.Comment ("computed Radix is" & |
Integer'Image (Radix)); |
Report.Comment ("computed Rounds is " & |
Boolean'Image (Rounds)); |
end if; |
|
-- check the model attributes against the machine attributes |
-- G.2.2(3)/3;6.0 |
if Real'Model_Mantissa > Real'Machine_Mantissa then |
Report.Failed ("model mantissa > machine mantissa"); |
end if; |
|
-- G.2.2(3)/2;6.0 |
-- 'Model_Mantissa >= ceiling(d*log(10)/log(radix))+1 |
Min_Mantissa_Digits := |
Integer ( |
Real'Ceiling ( |
Real(Real'Digits) * Log(10.0) / Log(Real(Real'Machine_Radix)) |
) ) + 1; |
if Real'Model_Mantissa < Min_Mantissa_Digits then |
Report.Failed ("Model_Mantissa [" & |
Integer'Image (Real'Model_Mantissa) & |
"] < minimum mantissa digits [" & |
Integer'Image (Min_Mantissa_Digits) & |
"]"); |
end if; |
|
exception |
when Illegal_Optimization => |
Report.Failed ("illegal optimization of" & |
" floating point expression"); |
end Do_Test; |
end Chk_Attrs; |
|
package Chk_Float is new Chk_Attrs (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 Chk_Attrs (A_Long_Float); |
begin |
Report.Test ("CXG2001", |
"Check the attributes Model_Mantissa," & |
" Machine_Mantissa, Machine_Radix," & |
" and Machine_Rounds"); |
|
Report.Comment ("checking Standard.Float"); |
Chk_Float.Do_Test; |
|
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
Chk_A_Long_Float.Do_Test; |
|
Report.Result; |
end CXG2001; |
/cxg2010.a
0,0 → 1,892
-- CXG2010.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 exp function returns |
-- results that are within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test contains three test packages that are almost |
-- identical. The first two packages differ only in the |
-- floating point type that is being tested. The first |
-- and third package differ only in whether the generic |
-- elementary functions package or the pre-instantiated |
-- package is used. |
-- The test package is not generic so that the arguments |
-- and expected results for some of the test values |
-- can be expressed as universal real instead of being |
-- computed at runtime. |
-- |
-- 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 and where the Machine_Radix is 2, 4, 8, or 16. |
-- This test only applies to the Strict Mode for numerical |
-- accuracy. |
-- |
-- |
-- CHANGE HISTORY: |
-- 1 Mar 96 SAIC Initial release for 2.1 |
-- 2 Sep 96 SAIC Improved check routine |
-- |
--! |
|
-- |
-- References: |
-- |
-- Software Manual for the Elementary Functions |
-- William J. Cody, Jr. and William Waite |
-- Prentice-Hall, 1980 |
-- |
-- CRC Standard Mathematical Tables |
-- 23rd Edition |
-- |
-- Implementation and Testing of Function Software |
-- W. J. Cody |
-- Problems and Methodologies in Mathematical Software Production |
-- editors P. C. Messina and A. Murli |
-- Lecture Notes in Computer Science Volume 142 |
-- Springer Verlag, 1982 |
-- |
|
-- |
-- Notes on derivation of error bound for exp(p)*exp(-p) |
-- |
-- Let a = true value of exp(p) and ac be the computed value. |
-- Then a = ac(1+e1), where |e1| <= 4*Model_Epsilon. |
-- Similarly, let b = true value of exp(-p) and bc be the computed value. |
-- Then b = bc(1+e2), where |e2| <= 4*ME. |
-- |
-- The product of x and y is (x*y)(1+e3), where |e3| <= 1.0ME |
-- |
-- Hence, the computed ab is [ac(1+e1)*bc(1+e2)](1+e3) = |
-- (ac*bc)[1 + e1 + e2 + e3 + e1e2 + e1e3 + e2e3 + e1e2e3). |
-- |
-- Throwing away the last four tiny terms, we have (ac*bc)(1 + eta), |
-- |
-- where |eta| <= (4+4+1)ME = 9.0Model_Epsilon. |
|
with System; |
with Report; |
with Ada.Numerics.Generic_Elementary_Functions; |
with Ada.Numerics.Elementary_Functions; |
procedure CXG2010 is |
Verbose : constant Boolean := False; |
Max_Samples : constant := 1000; |
Accuracy_Error_Reported : Boolean := False; |
|
package Float_Check is |
subtype Real is Float; |
procedure Do_Test; |
end Float_Check; |
|
package body Float_Check is |
package Elementary_Functions is new |
Ada.Numerics.Generic_Elementary_Functions (Real); |
function Sqrt (X : Real) return Real renames |
Elementary_Functions.Sqrt; |
function Exp (X : Real) return Real renames |
Elementary_Functions.Exp; |
|
|
-- The following value is a lower bound on the accuracy |
-- required. It is normally 0.0 so that the lower bound |
-- is computed from Model_Epsilon. However, for tests |
-- where the expected result is only known to a certain |
-- amount of precision this bound takes on a non-zero |
-- value to account for that level of precision. |
Error_Low_Bound : Real := 0.0; |
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real) is |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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; |
|
-- take into account the low bound on the error |
if Max_Error < Error_Low_Bound then |
Max_Error := Error_Low_Bound; |
end if; |
|
if abs (Actual - Expected) > Max_Error then |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & 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 Argument_Range_Check_1 (A, B : Real; |
Test : String) is |
-- test a evenly distributed selection of |
-- arguments selected from the range A to B. |
-- Test using identity: EXP(X-V) = EXP(X) * EXP (-V) |
-- The parameter One_Minus_Exp_Minus_V is the value |
-- 1.0 - Exp (-V) |
-- accurate to machine precision. |
-- This procedure is a translation of part of Cody's test |
X : Real; |
Y : Real; |
ZX, ZY : Real; |
V : constant := 1.0 / 16.0; |
One_Minus_Exp_Minus_V : constant := 6.058693718652421388E-2; |
|
begin |
Accuracy_Error_Reported := False; |
for I in 1..Max_Samples loop |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
Y := X - V; |
if Y < 0.0 then |
X := Y + V; |
end if; |
|
ZX := Exp (X); |
ZY := Exp (Y); |
|
-- ZX := Exp(X) - Exp(X) * (1 - Exp(-V); |
-- which simplifies to ZX := Exp (X-V); |
ZX := ZX - ZX * One_Minus_Exp_Minus_V; |
|
-- note that since the expected value is computed, we |
-- must take the error in that computation into account. |
Check (ZY, ZX, |
"test " & Test & " -" & |
Integer'Image (I) & |
" exp (" & Real'Image (X) & ")", |
9.0); |
exit when Accuracy_Error_Reported; |
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in argument range check 1"); |
when others => |
Report.Failed ("exception in argument range check 1"); |
end Argument_Range_Check_1; |
|
|
|
procedure Argument_Range_Check_2 (A, B : Real; |
Test : String) is |
-- test a evenly distributed selection of |
-- arguments selected from the range A to B. |
-- Test using identity: EXP(X-V) = EXP(X) * EXP (-V) |
-- The parameter One_Minus_Exp_Minus_V is the value |
-- 1.0 - Exp (-V) |
-- accurate to machine precision. |
-- This procedure is a translation of part of Cody's test |
X : Real; |
Y : Real; |
ZX, ZY : Real; |
V : constant := 45.0 / 16.0; |
-- 1/16 - Exp(45/16) |
Coeff : constant := 2.4453321046920570389E-3; |
|
begin |
Accuracy_Error_Reported := False; |
for I in 1..Max_Samples loop |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
Y := X - V; |
if Y < 0.0 then |
X := Y + V; |
end if; |
|
ZX := Exp (X); |
ZY := Exp (Y); |
|
-- ZX := Exp(X) * 1/16 - Exp(X) * Coeff; |
-- where Coeff is 1/16 - Exp(45/16) |
-- which simplifies to ZX := Exp (X-V); |
ZX := ZX * 0.0625 - ZX * Coeff; |
|
-- note that since the expected value is computed, we |
-- must take the error in that computation into account. |
Check (ZY, ZX, |
"test " & Test & " -" & |
Integer'Image (I) & |
" exp (" & Real'Image (X) & ")", |
9.0); |
exit when Accuracy_Error_Reported; |
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in argument range check 2"); |
when others => |
Report.Failed ("exception in argument range check 2"); |
end Argument_Range_Check_2; |
|
|
procedure Do_Test is |
begin |
|
--- test 1 --- |
declare |
Y : Real; |
begin |
Y := Exp(1.0); |
-- normal accuracy requirements |
Check (Y, Ada.Numerics.e, "test 1 -- exp(1)", 4.0); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 1"); |
when others => |
Report.Failed ("exception in test 1"); |
end; |
|
--- test 2 --- |
declare |
Y : Real; |
begin |
Y := Exp(16.0) * Exp(-16.0); |
Check (Y, 1.0, "test 2 -- exp(16)*exp(-16)", 9.0); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 2"); |
when others => |
Report.Failed ("exception in test 2"); |
end; |
|
--- test 3 --- |
declare |
Y : Real; |
begin |
Y := Exp (Ada.Numerics.Pi) * Exp (-Ada.Numerics.Pi); |
Check (Y, 1.0, "test 3 -- exp(pi)*exp(-pi)", 9.0); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 3"); |
when others => |
Report.Failed ("exception in test 3"); |
end; |
|
--- test 4 --- |
declare |
Y : Real; |
begin |
Y := Exp(0.0); |
Check (Y, 1.0, "test 4 -- exp(0.0)", |
0.0); -- no error allowed |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 4"); |
when others => |
Report.Failed ("exception in test 4"); |
end; |
|
--- test 5 --- |
-- constants used here only have 19 digits of precision |
if Real'Digits > 19 then |
Error_Low_Bound := 0.00000_00000_00000_0001; |
Report.Comment ("exp accuracy checked to 19 digits"); |
end if; |
|
Argument_Range_Check_1 ( 1.0/Sqrt(Real(Real'Machine_Radix)), |
1.0, |
"5"); |
Error_Low_Bound := 0.0; -- reset |
|
--- test 6 --- |
-- constants used here only have 19 digits of precision |
if Real'Digits > 19 then |
Error_Low_Bound := 0.00000_00000_00000_0001; |
Report.Comment ("exp accuracy checked to 19 digits"); |
end if; |
|
Argument_Range_Check_2 (1.0, |
Sqrt(Real(Real'Machine_Radix)), |
"6"); |
Error_Low_Bound := 0.0; -- reset |
|
end Do_Test; |
end Float_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
-- check the floating point type with the most digits |
type A_Long_Float is digits System.Max_Digits; |
|
|
package A_Long_Float_Check is |
subtype Real is A_Long_Float; |
procedure Do_Test; |
end A_Long_Float_Check; |
|
package body A_Long_Float_Check is |
package Elementary_Functions is new |
Ada.Numerics.Generic_Elementary_Functions (Real); |
function Sqrt (X : Real) return Real renames |
Elementary_Functions.Sqrt; |
function Exp (X : Real) return Real renames |
Elementary_Functions.Exp; |
|
|
-- The following value is a lower bound on the accuracy |
-- required. It is normally 0.0 so that the lower bound |
-- is computed from Model_Epsilon. However, for tests |
-- where the expected result is only known to a certain |
-- amount of precision this bound takes on a non-zero |
-- value to account for that level of precision. |
Error_Low_Bound : Real := 0.0; |
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real) is |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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; |
|
-- take into account the low bound on the error |
if Max_Error < Error_Low_Bound then |
Max_Error := Error_Low_Bound; |
end if; |
|
if abs (Actual - Expected) > Max_Error then |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & 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 Argument_Range_Check_1 (A, B : Real; |
Test : String) is |
-- test a evenly distributed selection of |
-- arguments selected from the range A to B. |
-- Test using identity: EXP(X-V) = EXP(X) * EXP (-V) |
-- The parameter One_Minus_Exp_Minus_V is the value |
-- 1.0 - Exp (-V) |
-- accurate to machine precision. |
-- This procedure is a translation of part of Cody's test |
X : Real; |
Y : Real; |
ZX, ZY : Real; |
V : constant := 1.0 / 16.0; |
One_Minus_Exp_Minus_V : constant := 6.058693718652421388E-2; |
|
begin |
Accuracy_Error_Reported := False; |
for I in 1..Max_Samples loop |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
Y := X - V; |
if Y < 0.0 then |
X := Y + V; |
end if; |
|
ZX := Exp (X); |
ZY := Exp (Y); |
|
-- ZX := Exp(X) - Exp(X) * (1 - Exp(-V); |
-- which simplifies to ZX := Exp (X-V); |
ZX := ZX - ZX * One_Minus_Exp_Minus_V; |
|
-- note that since the expected value is computed, we |
-- must take the error in that computation into account. |
Check (ZY, ZX, |
"test " & Test & " -" & |
Integer'Image (I) & |
" exp (" & Real'Image (X) & ")", |
9.0); |
exit when Accuracy_Error_Reported; |
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in argument range check 1"); |
when others => |
Report.Failed ("exception in argument range check 1"); |
end Argument_Range_Check_1; |
|
|
|
procedure Argument_Range_Check_2 (A, B : Real; |
Test : String) is |
-- test a evenly distributed selection of |
-- arguments selected from the range A to B. |
-- Test using identity: EXP(X-V) = EXP(X) * EXP (-V) |
-- The parameter One_Minus_Exp_Minus_V is the value |
-- 1.0 - Exp (-V) |
-- accurate to machine precision. |
-- This procedure is a translation of part of Cody's test |
X : Real; |
Y : Real; |
ZX, ZY : Real; |
V : constant := 45.0 / 16.0; |
-- 1/16 - Exp(45/16) |
Coeff : constant := 2.4453321046920570389E-3; |
|
begin |
Accuracy_Error_Reported := False; |
for I in 1..Max_Samples loop |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
Y := X - V; |
if Y < 0.0 then |
X := Y + V; |
end if; |
|
ZX := Exp (X); |
ZY := Exp (Y); |
|
-- ZX := Exp(X) * 1/16 - Exp(X) * Coeff; |
-- where Coeff is 1/16 - Exp(45/16) |
-- which simplifies to ZX := Exp (X-V); |
ZX := ZX * 0.0625 - ZX * Coeff; |
|
-- note that since the expected value is computed, we |
-- must take the error in that computation into account. |
Check (ZY, ZX, |
"test " & Test & " -" & |
Integer'Image (I) & |
" exp (" & Real'Image (X) & ")", |
9.0); |
exit when Accuracy_Error_Reported; |
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in argument range check 2"); |
when others => |
Report.Failed ("exception in argument range check 2"); |
end Argument_Range_Check_2; |
|
|
procedure Do_Test is |
begin |
|
--- test 1 --- |
declare |
Y : Real; |
begin |
Y := Exp(1.0); |
-- normal accuracy requirements |
Check (Y, Ada.Numerics.e, "test 1 -- exp(1)", 4.0); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 1"); |
when others => |
Report.Failed ("exception in test 1"); |
end; |
|
--- test 2 --- |
declare |
Y : Real; |
begin |
Y := Exp(16.0) * Exp(-16.0); |
Check (Y, 1.0, "test 2 -- exp(16)*exp(-16)", 9.0); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 2"); |
when others => |
Report.Failed ("exception in test 2"); |
end; |
|
--- test 3 --- |
declare |
Y : Real; |
begin |
Y := Exp (Ada.Numerics.Pi) * Exp (-Ada.Numerics.Pi); |
Check (Y, 1.0, "test 3 -- exp(pi)*exp(-pi)", 9.0); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 3"); |
when others => |
Report.Failed ("exception in test 3"); |
end; |
|
--- test 4 --- |
declare |
Y : Real; |
begin |
Y := Exp(0.0); |
Check (Y, 1.0, "test 4 -- exp(0.0)", |
0.0); -- no error allowed |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 4"); |
when others => |
Report.Failed ("exception in test 4"); |
end; |
|
--- test 5 --- |
-- constants used here only have 19 digits of precision |
if Real'Digits > 19 then |
Error_Low_Bound := 0.00000_00000_00000_0001; |
Report.Comment ("exp accuracy checked to 19 digits"); |
end if; |
|
Argument_Range_Check_1 ( 1.0/Sqrt(Real(Real'Machine_Radix)), |
1.0, |
"5"); |
Error_Low_Bound := 0.0; -- reset |
|
--- test 6 --- |
-- constants used here only have 19 digits of precision |
if Real'Digits > 19 then |
Error_Low_Bound := 0.00000_00000_00000_0001; |
Report.Comment ("exp accuracy checked to 19 digits"); |
end if; |
|
Argument_Range_Check_2 (1.0, |
Sqrt(Real(Real'Machine_Radix)), |
"6"); |
Error_Low_Bound := 0.0; -- reset |
|
end Do_Test; |
end A_Long_Float_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
package Non_Generic_Check is |
procedure Do_Test; |
subtype Real is Float; |
end Non_Generic_Check; |
|
package body Non_Generic_Check is |
|
package Elementary_Functions renames |
Ada.Numerics.Elementary_Functions; |
function Sqrt (X : Real) return Real renames |
Elementary_Functions.Sqrt; |
function Exp (X : Real) return Real renames |
Elementary_Functions.Exp; |
|
|
-- The following value is a lower bound on the accuracy |
-- required. It is normally 0.0 so that the lower bound |
-- is computed from Model_Epsilon. However, for tests |
-- where the expected result is only known to a certain |
-- amount of precision this bound takes on a non-zero |
-- value to account for that level of precision. |
Error_Low_Bound : Real := 0.0; |
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real) is |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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; |
|
-- take into account the low bound on the error |
if Max_Error < Error_Low_Bound then |
Max_Error := Error_Low_Bound; |
end if; |
|
if abs (Actual - Expected) > Max_Error then |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & 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 Argument_Range_Check_1 (A, B : Real; |
Test : String) is |
-- test a evenly distributed selection of |
-- arguments selected from the range A to B. |
-- Test using identity: EXP(X-V) = EXP(X) * EXP (-V) |
-- The parameter One_Minus_Exp_Minus_V is the value |
-- 1.0 - Exp (-V) |
-- accurate to machine precision. |
-- This procedure is a translation of part of Cody's test |
X : Real; |
Y : Real; |
ZX, ZY : Real; |
V : constant := 1.0 / 16.0; |
One_Minus_Exp_Minus_V : constant := 6.058693718652421388E-2; |
|
begin |
Accuracy_Error_Reported := False; |
for I in 1..Max_Samples loop |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
Y := X - V; |
if Y < 0.0 then |
X := Y + V; |
end if; |
|
ZX := Exp (X); |
ZY := Exp (Y); |
|
-- ZX := Exp(X) - Exp(X) * (1 - Exp(-V); |
-- which simplifies to ZX := Exp (X-V); |
ZX := ZX - ZX * One_Minus_Exp_Minus_V; |
|
-- note that since the expected value is computed, we |
-- must take the error in that computation into account. |
Check (ZY, ZX, |
"test " & Test & " -" & |
Integer'Image (I) & |
" exp (" & Real'Image (X) & ")", |
9.0); |
exit when Accuracy_Error_Reported; |
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in argument range check 1"); |
when others => |
Report.Failed ("exception in argument range check 1"); |
end Argument_Range_Check_1; |
|
|
|
procedure Argument_Range_Check_2 (A, B : Real; |
Test : String) is |
-- test a evenly distributed selection of |
-- arguments selected from the range A to B. |
-- Test using identity: EXP(X-V) = EXP(X) * EXP (-V) |
-- The parameter One_Minus_Exp_Minus_V is the value |
-- 1.0 - Exp (-V) |
-- accurate to machine precision. |
-- This procedure is a translation of part of Cody's test |
X : Real; |
Y : Real; |
ZX, ZY : Real; |
V : constant := 45.0 / 16.0; |
-- 1/16 - Exp(45/16) |
Coeff : constant := 2.4453321046920570389E-3; |
|
begin |
Accuracy_Error_Reported := False; |
for I in 1..Max_Samples loop |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
Y := X - V; |
if Y < 0.0 then |
X := Y + V; |
end if; |
|
ZX := Exp (X); |
ZY := Exp (Y); |
|
-- ZX := Exp(X) * 1/16 - Exp(X) * Coeff; |
-- where Coeff is 1/16 - Exp(45/16) |
-- which simplifies to ZX := Exp (X-V); |
ZX := ZX * 0.0625 - ZX * Coeff; |
|
-- note that since the expected value is computed, we |
-- must take the error in that computation into account. |
Check (ZY, ZX, |
"test " & Test & " -" & |
Integer'Image (I) & |
" exp (" & Real'Image (X) & ")", |
9.0); |
exit when Accuracy_Error_Reported; |
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in argument range check 2"); |
when others => |
Report.Failed ("exception in argument range check 2"); |
end Argument_Range_Check_2; |
|
|
procedure Do_Test is |
begin |
|
--- test 1 --- |
declare |
Y : Real; |
begin |
Y := Exp(1.0); |
-- normal accuracy requirements |
Check (Y, Ada.Numerics.e, "test 1 -- exp(1)", 4.0); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 1"); |
when others => |
Report.Failed ("exception in test 1"); |
end; |
|
--- test 2 --- |
declare |
Y : Real; |
begin |
Y := Exp(16.0) * Exp(-16.0); |
Check (Y, 1.0, "test 2 -- exp(16)*exp(-16)", 9.0); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 2"); |
when others => |
Report.Failed ("exception in test 2"); |
end; |
|
--- test 3 --- |
declare |
Y : Real; |
begin |
Y := Exp (Ada.Numerics.Pi) * Exp (-Ada.Numerics.Pi); |
Check (Y, 1.0, "test 3 -- exp(pi)*exp(-pi)", 9.0); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 3"); |
when others => |
Report.Failed ("exception in test 3"); |
end; |
|
--- test 4 --- |
declare |
Y : Real; |
begin |
Y := Exp(0.0); |
Check (Y, 1.0, "test 4 -- exp(0.0)", |
0.0); -- no error allowed |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 4"); |
when others => |
Report.Failed ("exception in test 4"); |
end; |
|
--- test 5 --- |
-- constants used here only have 19 digits of precision |
if Real'Digits > 19 then |
Error_Low_Bound := 0.00000_00000_00000_0001; |
Report.Comment ("exp accuracy checked to 19 digits"); |
end if; |
|
Argument_Range_Check_1 ( 1.0/Sqrt(Real(Real'Machine_Radix)), |
1.0, |
"5"); |
Error_Low_Bound := 0.0; -- reset |
|
--- test 6 --- |
-- constants used here only have 19 digits of precision |
if Real'Digits > 19 then |
Error_Low_Bound := 0.00000_00000_00000_0001; |
Report.Comment ("exp accuracy checked to 19 digits"); |
end if; |
|
Argument_Range_Check_2 (1.0, |
Sqrt(Real(Real'Machine_Radix)), |
"6"); |
Error_Low_Bound := 0.0; -- reset |
|
end Do_Test; |
end Non_Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
begin |
Report.Test ("CXG2010", |
"Check the accuracy of the exp function"); |
|
-- the test only applies to machines with a radix of 2,4,8, or 16 |
case Float'Machine_Radix is |
when 2 | 4 | 8 | 16 => null; |
when others => |
Report.Not_Applicable ("only applicable to binary radix"); |
Report.Result; |
return; |
end case; |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking non-generic package"); |
end if; |
|
Non_Generic_Check.Do_Test; |
|
Report.Result; |
end CXG2010; |
/cxg2020.a
0,0 → 1,351
-- CXG2020.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 SQRT function returns |
-- a result that is within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test consists of a generic package that is |
-- instantiated to check complex numbers based upon |
-- both Float and a long float type. |
-- The test for each floating point type is divided into |
-- several parts: |
-- Special value checks where the result is a known constant. |
-- Checks that use an identity for determining the result. |
-- |
-- 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: |
-- 24 Mar 96 SAIC Initial release for 2.1 |
-- 17 Aug 96 SAIC Incorporated reviewer comments. |
-- 03 Jun 98 EDS Added parens to ensure that the expression is not |
-- evaluated by multiplying its two large terms |
-- together and overflowing. |
--! |
|
-- |
-- References: |
-- |
-- W. J. Cody |
-- CELEFUNT: A Portable Test Package for Complex Elementary Functions |
-- Algorithm 714, Collected Algorithms from ACM. |
-- Published in Transactions On Mathematical Software, |
-- Vol. 19, No. 1, March, 1993, pp. 1-21. |
-- |
-- CRC Standard Mathematical Tables |
-- 23rd Edition |
-- |
|
with System; |
with Report; |
with Ada.Numerics.Generic_Complex_Types; |
with Ada.Numerics.Generic_Complex_Elementary_Functions; |
procedure CXG2020 is |
Verbose : constant Boolean := False; |
-- Note that Max_Samples is the number of samples taken in |
-- both the real and imaginary directions. Thus, for Max_Samples |
-- of 100 the number of values checked is 10000. |
Max_Samples : constant := 100; |
|
E : constant := Ada.Numerics.E; |
Pi : constant := Ada.Numerics.Pi; |
|
-- 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; |
|
generic |
type Real is digits <>; |
package Generic_Check is |
procedure Do_Test; |
end Generic_Check; |
|
package body Generic_Check is |
package Complex_Type is new |
Ada.Numerics.Generic_Complex_Types (Real); |
use Complex_Type; |
|
package CEF is new |
Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type); |
|
function Sqrt (X : Complex) return Complex renames CEF.Sqrt; |
|
-- flag used to terminate some tests early |
Accuracy_Error_Reported : Boolean := False; |
|
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real) is |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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 |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & 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 Check (Actual, Expected : Complex; |
Test_Name : String; |
MRE : Real) is |
begin |
Check (Actual.Re, Expected.Re, Test_Name & " real part", MRE); |
Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", MRE); |
end Check; |
|
|
procedure Special_Value_Test is |
-- In the following tests the expected result is accurate |
-- to the machine precision so the minimum guaranteed error |
-- bound can be used if the argument is exact. |
-- |
-- One or i is added to the actual and expected results in |
-- order to prevent the expected result from having a |
-- real or imaginary part of 0. This is to allow a reasonable |
-- relative error for that component. |
Minimum_Error : constant := 6.0; |
Z1, Z2 : Complex; |
begin |
Check (Sqrt(9.0+0.0*i) + i, |
3.0+1.0*i, |
"sqrt(9+0i)+i", |
Minimum_Error); |
Check (Sqrt (-2.0 + 0.0 * i) + 1.0, |
1.0 + Sqrt2 * i, |
"sqrt(-2)+1 ", |
Minimum_Error); |
|
-- make sure no exception occurs when taking the sqrt of |
-- very large and very small values. |
|
Z1 := (Real'Safe_Last * 0.9, Real'Safe_Last * 0.9); |
Z2 := Sqrt (Z1); |
begin |
Check (Z2 * Z2, |
Z1, |
"sqrt((big,big))", |
Minimum_Error + 5.0); -- +5 for multiply |
exception |
when others => |
Report.Failed ("unexpected exception in sqrt((big,big))"); |
end; |
|
Z1 := (Real'Model_Epsilon * 10.0, Real'Model_Epsilon * 10.0); |
Z2 := Sqrt (Z1); |
begin |
Check (Z2 * Z2, |
Z1, |
"sqrt((little,little))", |
Minimum_Error + 5.0); -- +5 for multiply |
exception |
when others => |
Report.Failed ("unexpected exception in " & |
"sqrt((little,little))"); |
end; |
|
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in special value test"); |
when others => |
Report.Failed ("exception in special value test"); |
end Special_Value_Test; |
|
|
|
procedure Exact_Result_Test is |
No_Error : constant := 0.0; |
begin |
-- G.1.2(36);6.0 |
Check (Sqrt(0.0 + 0.0*i), 0.0 + 0.0 * i, "sqrt(0+0i)", No_Error); |
|
-- G.1.2(37);6.0 |
Check (Sqrt(1.0 + 0.0*i), 1.0 + 0.0 * i, "sqrt(1+0i)", No_Error); |
|
-- G.1.2(38-39);6.0 |
Check (Sqrt(-1.0 + 0.0*i), 0.0 + 1.0 * i, "sqrt(-1+0i)", No_Error); |
|
-- G.1.2(40);6.0 |
if Real'Signed_Zeros then |
Check (Sqrt(-1.0-0.0*i), 0.0 - 1.0 * i, "sqrt(-1-0i)", No_Error); |
end if; |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in Exact_Result Test"); |
when others => |
Report.Failed ("exception in Exact_Result Test"); |
end Exact_Result_Test; |
|
|
procedure Identity_Test (RA, RB, IA, IB : Real) is |
-- Tests an identity over a range of values specified |
-- by the 4 parameters. RA and RB denote the range for the |
-- real part while IA and IB denote the range for the |
-- imaginary part of the result. |
-- |
-- For this test we use the identity |
-- Sqrt(Z*Z) = Z |
-- |
|
Scale : Real := Real (Real'Machine_Radix) ** (Real'Mantissa / 2 + 4); |
W, X, Y, Z : Real; |
CX : Complex; |
Actual, Expected : Complex; |
begin |
Accuracy_Error_Reported := False; -- reset |
for II in 1..Max_Samples loop |
X := (RB - RA) * Real (II) / Real (Max_Samples) + RA; |
for J in 1..Max_Samples loop |
Y := (IB - IA) * Real (J) / Real (Max_Samples) + IA; |
|
-- purify the arguments to minimize roundoff error. |
-- We construct the values so that the products X*X, |
-- Y*Y, and X*Y are all exact machine numbers. |
-- See Cody page 7 and CELEFUNT code. |
Z := X * Scale; |
W := Z + X; |
X := W - Z; |
Z := Y * Scale; |
W := Z + Y; |
Y := W - Z; |
-- G.1.2(21);6.0 - real part of result is non-negative |
Expected := Compose_From_Cartesian( abs X,Y); |
Z := X*X - Y*Y; |
W := X*Y; |
CX := Compose_From_Cartesian(Z,W+W); |
|
-- The arguments are now ready so on with the |
-- identity computation. |
Actual := Sqrt(CX); |
|
Check (Actual, Expected, |
"Identity_1_Test " & Integer'Image (II) & |
Integer'Image (J) & ": Sqrt((" & |
Real'Image (CX.Re) & ", " & |
Real'Image (CX.Im) & ")) ", |
8.5); -- 6.0 from sqrt, 2.5 from argument. |
-- See Cody pg 7-8 for analysis of additional error amount. |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
end loop; |
end loop; |
|
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Identity_Test" & |
" for X=(" & Real'Image (X) & |
", " & Real'Image (X) & ")"); |
when others => |
Report.Failed ("exception in Identity_Test" & |
" for X=(" & Real'Image (X) & |
", " & Real'Image (X) & ")"); |
end Identity_Test; |
|
|
procedure Do_Test is |
begin |
Special_Value_Test; |
Exact_Result_Test; |
-- ranges where the sign is the same and where it |
-- differs. |
Identity_Test ( 0.0, 10.0, 0.0, 10.0); |
Identity_Test ( 0.0, 100.0, -100.0, 0.0); |
end Do_Test; |
end Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
package Float_Check is new Generic_Check (Float); |
|
-- check the floating point type with the most digits |
type A_Long_Float is digits System.Max_Digits; |
package A_Long_Float_Check is new Generic_Check (A_Long_Float); |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
|
begin |
Report.Test ("CXG2020", |
"Check the accuracy of the complex SQRT function"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
|
Report.Result; |
end CXG2020; |
/cxg1003.a
0,0 → 1,478
-- CXG1003.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 subprograms defined in the package Text_IO.Complex_IO |
-- provide correct results. |
-- |
-- TEST DESCRIPTION: |
-- The generic package Ada.Numerics.Generic_Complex_Types is instantiated |
-- with a real type (new Float). The resulting new package is used as |
-- the generic actual to package Complex_IO. |
-- Two different versions of Put and Get are examined in this test, |
-- those that input/output complex data values from/to Text_IO files, |
-- and those that input/output complex data values from/to strings. |
-- Two procedures are defined to perform the file data manipulations; |
-- one to place complex data into the file, and one to retrieve the data |
-- from the file and verify its correctness. |
-- Complex data is also put into string variables using the Procedure |
-- Put for strings, and this data is then retrieved and reconverted into |
-- complex values using the Get procedure. |
-- |
-- |
-- APPLICABILITY CRITERIA: |
-- This test is only applicable to implementations that: |
-- support Annex G, |
-- support Text_IO and external files |
-- |
-- |
-- CHANGE HISTORY: |
-- 06 Dec 94 SAIC ACVC 2.0 |
-- 29 Dec 94 SAIC Modified Width parameter in Get function calls. |
-- 16 Nov 95 SAIC Corrected visibility problems for ACVC 2.0.1. |
-- 29 Sep 96 SAIC Incorporated reviewer comments. |
-- |
--! |
|
with Ada.Text_IO.Complex_IO; |
with Ada.Numerics.Generic_Complex_Types; |
with Report; |
|
procedure CXG1003 is |
begin |
|
Report.Test ("CXG1003", "Check that the subprograms defined in " & |
"the package Text_IO.Complex_IO " & |
"provide correct results"); |
|
Test_for_Text_IO_Support: |
declare |
use Ada; |
|
Data_File : Ada.Text_IO.File_Type; |
Data_Filename : constant String := Report.Legal_File_Name; |
|
begin |
|
-- An application creates a text file in mode Out_File, with the |
-- intention of entering complex data into the file as appropriate. |
-- In the event that the particular environment where the application |
-- is running does not support Text_IO, Use_Error or Name_Error will be |
-- raised on calls to Text_IO operations. Either of these exceptions |
-- will be handled to produce a Not_Applicable result. |
|
Text_IO.Create (File => Data_File, |
Mode => Ada.Text_IO.Out_File, |
Name => Data_Filename); |
|
Test_Block: |
declare |
|
TC_Verbose : Boolean := False; |
|
type Real_Type is new Float; |
|
package Complex_Pack is new |
Ada.Numerics.Generic_Complex_Types(Real_Type); |
|
package C_IO is new Ada.Text_IO.Complex_IO(Complex_Pack); |
|
use Ada.Text_IO, C_IO; |
use type Complex_Pack.Complex; |
|
Number_Of_Complex_Items : constant := 6; |
Number_Of_Error_Items : constant := 2; |
|
TC_Complex : Complex_Pack.Complex; |
TC_Last_Character_Read : Positive; |
|
Complex_Array : array (1..Number_Of_Complex_Items) |
of Complex_Pack.Complex := ( (3.0, 9.0), |
(4.0, 7.0), |
(5.0, 6.0), |
(6.0, 3.0), |
(2.0, 5.0), |
(3.0, 7.0) ); |
|
|
procedure Load_Data_File (The_File : in out Text_IO.File_Type) is |
use Ada.Text_IO; |
begin |
-- This procedure does not create, open, or close the data file; |
-- The_File file object must be Open at this point. |
-- This procedure is designed to load complex data into a data |
-- file twice, first using Text_IO, then Complex_IO. In this |
-- first case, the complex data values are entered as strings, |
-- assuming a variety of legal formats, as provided in the |
-- reference manual. |
|
Put_Line(The_File, "(3.0, 9.0)"); |
Put_Line(The_File, "+4. +7."); -- Relaxed real literal format. |
Put_Line(The_File, "(5.0 6.)"); |
Put_Line(The_File, "6., 3.0"); |
Put_Line(The_File, " ( 2.0 , 5.0 ) "); |
Put_Line(The_File, "("); -- Complex data separated over |
Put_Line(The_File, "3.0"); -- several (5) lines. |
Put_Line(The_File, " , "); |
Put_Line(The_File, "7.0 "); |
Put_Line(The_File, ")"); |
|
if TC_Verbose then |
Report.Comment("Complex values entered into data file using " & |
"Text_IO, Procedure Load_Data_File"); |
end if; |
|
-- Use the Complex_IO procedure Put to enter Complex data items |
-- into the data file. |
-- Note: Data is being entered into the file for the *second* time |
-- at this point. (Using Complex_IO here, Text_IO above) |
|
for i in 1..Number_Of_Complex_Items loop |
C_IO.Put(File => The_File, |
Item => Complex_Array(i), |
Fore => 1, |
Aft => 1, |
Exp => 0); |
end loop; |
|
if TC_Verbose then |
Report.Comment("Complex values entered into data file using " & |
"Complex_IO, Procedure Load_Data_File"); |
end if; |
|
Put_Line(The_File, "(5A,3)"); -- data to raise Data_Error. |
Put_Line(The_File, "(3.0,,8.0)"); -- data to raise Data_Error. |
|
end Load_Data_File; |
|
|
|
procedure Process_Data_File (The_File : in out Text_IO.File_Type) is |
TC_Complex : Complex_Pack.Complex := (0.0, 0.0); |
TC_Width : Integer := 0; |
begin |
-- This procedure does not create, open, or close the data file; |
-- The_File file object must be Open at this point. |
-- Use procedure Get (for Files) to extract the complex data from |
-- the Text_IO file. This data was placed into the file using |
-- Text_IO. |
|
|
for i in 1..Number_Of_Complex_Items loop |
|
C_IO.Get(The_File, TC_Complex, TC_Width); |
|
if TC_Complex /= Complex_Array(i) then |
Report.Failed("Incorrect complex data read from file " & |
"when using Text_IO procedure Get, " & |
"data item #" & Integer'Image(i)); |
end if; |
end loop; |
|
if TC_Verbose then |
Report.Comment("First set of complex values extracted " & |
"from data file using Complex_IO, " & |
"Procedure Process_Data_File"); |
end if; |
|
-- Use procedure Get (for Files) to extract the complex data from |
-- the Text_IO file. This data was placed into the file using |
-- procedure Complex_IO.Put. |
-- Note: Data is being extracted from the file for the *second* |
-- time at this point (Using Complex_IO here, Text_IO above) |
|
for i in 1..Number_Of_Complex_Items loop |
|
C_IO.Get(The_File, TC_Complex, TC_Width); |
|
if TC_Complex /= Complex_Array(i) then |
Report.Failed("Incorrect complex data read from file " & |
"when using Complex_IO procedure Get, " & |
"data item #" & Integer'Image(i)); |
end if; |
end loop; |
|
if TC_Verbose then |
Report.Comment("Second set of complex values extracted " & |
"from data file using Complex_IO, " & |
"Procedure Process_Data_File"); |
end if; |
|
-- The final items in the Data_File are complex values with |
-- incorrect syntax, which should raise Data_Error on an attempt |
-- to read them from the file. |
TC_Width := 10; |
for i in 1..Number_Of_Error_Items loop |
begin |
C_IO.Get(The_File, TC_Complex, TC_Width); |
Report.Failed |
("Exception Data_Error not raised when Complex_IO.Get " & |
"was used to read complex data with incorrect " & |
"syntax from the Data_File, data item #" & |
Integer'Image(i)); |
exception |
when Ada.Text_IO.Data_Error => -- OK, expected exception. |
Text_IO.Skip_Line(The_File); |
when others => |
Report.Failed |
("Unexpected exception raised when Complex_IO.Get " & |
"was used to read complex data with incorrect " & |
"syntax from the Data_File, data item #" & |
Integer'Image(i)); |
end; |
end loop; |
|
if TC_Verbose then |
Report.Comment("Erroneous set of complex values extracted " & |
"from data file using Complex_IO, " & |
"Procedure Process_Data_File"); |
end if; |
|
|
exception |
when others => |
Report.Failed |
("Unexpected exception raised in Process_Data_File"); |
end Process_Data_File; |
|
|
|
begin -- Test_Block. |
|
-- Place complex values into data file. |
|
Load_Data_File(Data_File); |
Text_IO.Close(Data_File); |
|
if TC_Verbose then |
Report.Comment("Data file loaded with Complex values"); |
end if; |
|
-- Read complex values from data file. |
|
Text_IO.Open(Data_File, Text_IO.In_File, Data_Filename); |
Process_Data_File(Data_File); |
|
if TC_Verbose then |
Report.Comment("Complex values extracted from data file"); |
end if; |
|
|
|
-- Verify versions of Procedures Put and Get for Strings. |
|
declare |
TC_String_Array : array (1..Number_Of_Complex_Items) |
of String(1..15) := (others =>(others => ' ')); |
begin |
|
-- Place complex values into strings using the Procedure Put. |
|
for i in 1..Number_Of_Complex_Items loop |
C_IO.Put(To => TC_String_Array(i), |
Item => Complex_Array(i), |
Aft => 1, |
Exp => 0); |
end loop; |
|
if TC_Verbose then |
Report.Comment("Complex values placed into string array"); |
end if; |
|
-- Check the format of the strings containing a complex number. |
-- The resulting strings are of 15 character length, with the |
-- real component left justified within the string, followed by |
-- a comma, and with the imaginary component and closing |
-- parenthesis right justified in the string, with blank fill |
-- for the balance of the string. |
|
if TC_String_Array(1) /= "(3.0, 9.0)" or |
TC_String_Array(2) /= "(4.0, 7.0)" or |
TC_String_Array(3) /= "(5.0, 6.0)" or |
TC_String_Array(4) /= "(6.0, 3.0)" or |
TC_String_Array(5) /= "(2.0, 5.0)" or |
TC_String_Array(6) /= "(3.0, 7.0)" |
then |
Report.Failed("Incorrect format for complex values that " & |
"have been placed into string variables " & |
"using the Complex_IO.Put procedure for " & |
"strings"); |
end if; |
|
if TC_Verbose then |
Report.Comment("String format of Complex values verified"); |
end if; |
|
-- Get complex values from strings using the Procedure Get. |
-- Compare with expected complex values. |
|
for i in 1..Number_Of_Complex_Items loop |
|
C_IO.Get(From => TC_String_Array(i), |
Item => TC_Complex, |
Last => TC_Last_Character_Read); |
|
if TC_Complex /= Complex_Array(i) then |
Report.Failed("Incorrect complex data value obtained " & |
"from String following use of Procedures " & |
"Put and Get from Strings, Complex_Array " & |
"item #" & Integer'Image(i)); |
end if; |
end loop; |
|
if TC_Verbose then |
Report.Comment("Complex values removed from String array"); |
end if; |
|
-- Verify that Layout_Error is raised if the given string is |
-- too short to hold the formatted output. |
Layout_Error_On_Put: |
declare |
Much_Too_Short : String(1..2); |
Complex_Value : Complex_Pack.Complex := (5.0, 0.0); |
begin |
C_IO.Put(Much_Too_Short, Complex_Value); |
Report.Failed("Layout_Error not raised by Procedure Put " & |
"when the given string was too short to " & |
"hold the formatted output"); |
exception |
when Layout_Error => null; -- OK, expected exception. |
when others => |
Report.Failed |
("Unexpected exception raised by Procedure Put when " & |
"the given string was too short to hold the " & |
"formatted output"); |
end Layout_Error_On_Put; |
|
if TC_Verbose then |
Report.Comment("Layout Errors verified"); |
end if; |
|
exception |
when others => |
Report.Failed("Unexpected exception raised during the " & |
"evaluation of Put and Get for Strings"); |
end; |
|
|
-- Place complex values into strings using a variety of legal |
-- complex data formats. |
declare |
|
type String_Ptr is access String; |
|
TC_Complex_String_Array : |
array (1..Number_Of_Complex_Items) of String_Ptr := |
(new String'( "(3.0, 9.0 )" ), |
new String'( "+4.0 +7.0" ), |
new String'( "(5.0 6.0)" ), |
new String'( "6.0, 3.0" ), |
new String'( " ( 2.0 , 5.0 ) " ), |
new String'( "(3.0 7.0)" )); |
|
-- The following array contains Positive values that correspond |
-- to the last character that will be read by Procedure Get when |
-- given each of the above strings as input. |
|
TC_Last_Char_Array : array (1..Number_Of_Complex_Items) |
of Positive := (12,10,9,8,20,22); |
|
begin |
|
-- Get complex values from strings using the Procedure Get. |
-- Compare with expected complex values. |
|
for i in 1..Number_Of_Complex_Items loop |
|
C_IO.Get(TC_Complex_String_Array(i).all, |
TC_Complex, |
TC_Last_Character_Read); |
|
if TC_Complex /= Complex_Array(i) then |
Report.Failed |
("Incorrect complex data value obtained from " & |
"Procedure Get with complex data input of: " & |
TC_Complex_String_Array(i).all); |
end if; |
|
if TC_Last_Character_Read /= TC_Last_Char_Array(i) then |
Report.Failed |
("Incorrect value returned as the last character of " & |
"the input string processed by Procedure Get, " & |
"string value : " & TC_Complex_String_Array(i).all & |
" expected last character value read : " & |
Positive'Image(TC_Last_Char_Array(i)) & |
" last character value read : " & |
Positive'Image(TC_Last_Character_Read)); |
end if; |
|
end loop; |
|
if TC_Verbose then |
Report.Comment("Complex values removed from strings and " & |
"verified against expected values"); |
end if; |
|
exception |
when others => |
Report.Failed("Unexpected exception raised during the " & |
"evaluation of Get for Strings"); |
end; |
|
exception |
when others => Report.Failed ("Exception raised in Test_Block"); |
end Test_Block; |
|
|
-- Delete the external file. |
if Ada.Text_IO.Is_Open(Data_File) then |
Ada.Text_IO.Delete(Data_File); |
else |
Ada.Text_IO.Open(Data_File, |
Ada.Text_IO.In_File, |
Data_Filename); |
Ada.Text_IO.Delete(Data_File); |
end if; |
|
exception |
|
-- Since Use_Error can be raised if, for the specified mode, |
-- the environment does not support Text_IO operations, the |
-- following handlers are included: |
|
when Ada.Text_IO.Use_Error => |
Report.Not_Applicable ("Use_Error raised on Text_IO Create"); |
|
when Ada.Text_IO.Name_Error => |
Report.Not_Applicable ("Name_Error raised on Text_IO Create"); |
|
when others => |
Report.Failed ("Unexpected exception raised on text file Create"); |
|
end Test_for_Text_IO_Support; |
|
Report.Result; |
|
end CXG1003; |
/cxg2002.a
0,0 → 1,468
-- CXG2002.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 "abs" or modulus function returns |
-- results that are within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test uses a generic package to compute and check the |
-- values of the modulus function. In addition, a non-generic |
-- copy of this package is used to check the non-generic package |
-- Ada.Numerics.Complex_Types. |
-- Of special interest is the case where either the real or |
-- the imaginary part of the argument is very large while the |
-- other part is very small or 0. |
-- We want to check that the value is computed such that |
-- an overflow does not occur. If computed directly from the |
-- definition |
-- abs (x+yi) = sqrt(x**2 + y**2) |
-- then overflow or underflow is much more likely than if the |
-- argument is normalized first. |
-- |
-- 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: |
-- 31 JAN 96 SAIC Initial release for 2.1 |
-- 02 JUN 98 EDS Add parens to intermediate calculations. |
--! |
|
-- |
-- 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 Ada.Numerics.Generic_Complex_Types; |
with Ada.Numerics.Complex_Types; |
procedure CXG2002 is |
Verbose : constant Boolean := False; |
Maximum_Relative_Error : constant := 3.0; |
|
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 := Maximum_Relative_Error) is |
Rel_Error, |
Abs_Error, |
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 (Expected - Actual) & |
" max_err:" & 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 Do_Test is |
Z : Complex; |
X : Real; |
T : Real; |
begin |
|
--- test 1 --- |
begin |
T := Real'Safe_Last; |
Z := T + 0.0*i; |
X := abs Z; |
Check (X, T, "test 1 -- abs(bigreal + 0i)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 1"); |
when others => |
Report.Failed ("exception in test 1"); |
end; |
|
--- test 2 --- |
begin |
T := Real'Safe_Last; |
Z := 0.0 + T*i; |
X := Modulus (Z); |
Check (X, T, "test 2 -- abs(0 + bigreal*i)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 2"); |
when others => |
Report.Failed ("exception in test 2"); |
end; |
|
--- test 3 --- |
begin |
Z := 3.0 + 4.0*i; |
X := abs Z; |
Check (X, 5.0 , "test 3 -- abs(3 + 4*i)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 3"); |
when others => |
Report.Failed ("exception in test 3"); |
end; |
|
--- test 4 --- |
declare |
S : Real; |
begin |
S := Real(Real'Machine_Radix) ** (Real'Machine_EMax - 3); |
Z := 3.0 * S + 4.0*S*i; |
X := abs Z; |
Check (X, 5.0*S, "test 4 -- abs(3S + 4S*i) for large S", |
5.0*Real'Model_Epsilon); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 4"); |
when others => |
Report.Failed ("exception in test 4"); |
end; |
|
--- test 5 --- |
begin |
T := Real'Model_Small; |
Z := T + 0.0*i; |
X := abs Z; |
Check (X, T , "test 5 -- abs(small + 0*i)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 5"); |
when others => |
Report.Failed ("exception in test 5"); |
end; |
|
--- test 6 --- |
begin |
T := Real'Model_Small; |
Z := 0.0 + T*i; |
X := abs Z; |
Check (X, T , "test 6 -- abs(0 + small*i)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 6"); |
when others => |
Report.Failed ("exception in test 6"); |
end; |
|
--- test 7 --- |
declare |
S : Real; |
begin |
S := Real(Real'Machine_Radix) ** (Real'Model_EMin + 3); |
Z := 3.0 * S + 4.0*S*i; |
X := abs Z; |
Check (X, 5.0*S, "test 7 -- abs(3S + 4S*i) for small S", |
5.0*Real'Model_Epsilon); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 7"); |
when others => |
Report.Failed ("exception in test 7"); |
end; |
|
--- test 8 --- |
declare |
-- CRC Standard Mathematical Tables; 23rd Edition; pg 738 |
Sqrt2 : constant := |
1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695; |
begin |
Z := 1.0 + 1.0*i; |
X := abs Z; |
Check (X, Sqrt2 , "test 8 -- abs(1 + 1*i)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 8"); |
when others => |
Report.Failed ("exception in test 8"); |
end; |
|
--- test 9 --- |
begin |
T := 0.0; |
Z := T + 0.0*i; |
X := abs Z; |
Check (X, T , "test 5 -- abs(0 + 0*i)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 9"); |
when others => |
Report.Failed ("exception in test 9"); |
end; |
end Do_Test; |
end Generic_Check; |
|
----------------------------------------------------------------------- |
--- non generic copy of the above generic package |
----------------------------------------------------------------------- |
|
package Non_Generic_Check is |
subtype Real is Float; |
procedure Do_Test; |
end Non_Generic_Check; |
|
package body Non_Generic_Check is |
use Ada.Numerics.Complex_Types; |
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real := Maximum_Relative_Error) is |
Rel_Error, |
Abs_Error, |
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 (Expected - Actual) & |
" max_err:" & 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 Do_Test is |
Z : Complex; |
X : Real; |
T : Real; |
begin |
|
--- test 1 --- |
begin |
T := Real'Safe_Last; |
Z := T + 0.0*i; |
X := abs Z; |
Check (X, T, "test 1 -- abs(bigreal + 0i)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 1"); |
when others => |
Report.Failed ("exception in test 1"); |
end; |
|
--- test 2 --- |
begin |
T := Real'Safe_Last; |
Z := 0.0 + T*i; |
X := Modulus (Z); |
Check (X, T, "test 2 -- abs(0 + bigreal*i)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 2"); |
when others => |
Report.Failed ("exception in test 2"); |
end; |
|
--- test 3 --- |
begin |
Z := 3.0 + 4.0*i; |
X := abs Z; |
Check (X, 5.0 , "test 3 -- abs(3 + 4*i)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 3"); |
when others => |
Report.Failed ("exception in test 3"); |
end; |
|
--- test 4 --- |
declare |
S : Real; |
begin |
S := Real(Real'Machine_Radix) ** (Real'Machine_EMax - 3); |
Z := 3.0 * S + 4.0*S*i; |
X := abs Z; |
Check (X, 5.0*S, "test 4 -- abs(3S + 4S*i) for large S", |
5.0*Real'Model_Epsilon); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 4"); |
when others => |
Report.Failed ("exception in test 4"); |
end; |
|
--- test 5 --- |
begin |
T := Real'Model_Small; |
Z := T + 0.0*i; |
X := abs Z; |
Check (X, T , "test 5 -- abs(small + 0*i)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 5"); |
when others => |
Report.Failed ("exception in test 5"); |
end; |
|
--- test 6 --- |
begin |
T := Real'Model_Small; |
Z := 0.0 + T*i; |
X := abs Z; |
Check (X, T , "test 6 -- abs(0 + small*i)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 6"); |
when others => |
Report.Failed ("exception in test 6"); |
end; |
|
--- test 7 --- |
declare |
S : Real; |
begin |
S := Real(Real'Machine_Radix) ** (Real'Model_EMin + 3); |
Z := 3.0 * S + 4.0*S*i; |
X := abs Z; |
Check (X, 5.0*S, "test 7 -- abs(3S + 4S*i) for small S", |
5.0*Real'Model_Epsilon); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 7"); |
when others => |
Report.Failed ("exception in test 7"); |
end; |
|
--- test 8 --- |
declare |
-- CRC Standard Mathematical Tables; 23rd Edition; pg 738 |
Sqrt2 : constant := |
1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695; |
begin |
Z := 1.0 + 1.0*i; |
X := abs Z; |
Check (X, Sqrt2 , "test 8 -- abs(1 + 1*i)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 8"); |
when others => |
Report.Failed ("exception in test 8"); |
end; |
|
--- test 9 --- |
begin |
T := 0.0; |
Z := T + 0.0*i; |
X := abs Z; |
Check (X, T , "test 5 -- abs(0 + 0*i)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 9"); |
when others => |
Report.Failed ("exception in test 9"); |
end; |
end Do_Test; |
end Non_Generic_Check; |
|
----------------------------------------------------------------------- |
--- end of "manual instantiation" |
----------------------------------------------------------------------- |
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 ("CXG2002", |
"Check the accuracy of the complex modulus" & |
" 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; |
|
if Verbose then |
Report.Comment ("checking non-generic package"); |
end if; |
Non_Generic_Check.Do_Test; |
Report.Result; |
end CXG2002; |
/cxg2011.a
0,0 → 1,490
-- CXG2011.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 log function returns |
-- results that are within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test consists of a generic package that is |
-- instantiated to check both Float and a long float type. |
-- The test for each floating point type is divided into |
-- several parts: |
-- Special value checks where the result is a known constant. |
-- Checks in a range where a Taylor series can be used to compute |
-- the expected result. |
-- Checks that use an identity for determining the result. |
-- Exception checks. |
-- |
-- 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: |
-- 1 Mar 96 SAIC Initial release for 2.1 |
-- 22 Aug 96 SAIC Improved Check routine |
-- 02 DEC 97 EDS Log (0.0) must raise Constraint_Error, |
-- not Argument_Error |
--! |
|
-- |
-- References: |
-- |
-- Software Manual for the Elementary Functions |
-- William J. Cody, Jr. and William Waite |
-- Prentice-Hall, 1980 |
-- |
-- CRC Standard Mathematical Tables |
-- 23rd Edition |
-- |
-- Implementation and Testing of Function Software |
-- W. J. Cody |
-- 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 Ada.Numerics.Generic_Elementary_Functions; |
procedure CXG2011 is |
Verbose : constant Boolean := False; |
Max_Samples : constant := 1000; |
|
-- CRC Handbook Page 738 |
Ln10 : constant := 2.30258_50929_94045_68401_79914_54684_36420_76011_01489; |
Ln2 : constant := 0.69314_71805_59945_30941_72321_21458_17656_80755_00134; |
|
generic |
type Real is digits <>; |
package Generic_Check is |
procedure Do_Test; |
end Generic_Check; |
|
package body Generic_Check is |
package Elementary_Functions is new |
Ada.Numerics.Generic_Elementary_Functions (Real); |
function Sqrt (X : Real'Base) return Real'Base renames |
Elementary_Functions.Sqrt; |
function Exp (X : Real'Base) return Real'Base renames |
Elementary_Functions.Exp; |
function Log (X : Real'Base) return Real'Base renames |
Elementary_Functions.Log; |
function Log (X, Base : Real'Base) return Real'Base renames |
Elementary_Functions.Log; |
|
-- flag used to terminate some tests early |
Accuracy_Error_Reported : Boolean := False; |
|
|
-- The following value is a lower bound on the accuracy |
-- required. It is normally 0.0 so that the lower bound |
-- is computed from Model_Epsilon. However, for tests |
-- where the expected result is only known to a certain |
-- amount of precision this bound takes on a non-zero |
-- value to account for that level of precision. |
Error_Low_Bound : Real := 0.0; |
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real) is |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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; |
|
-- take into account the low bound on the error |
if Max_Error < Error_Low_Bound then |
Max_Error := Error_Low_Bound; |
end if; |
|
if abs (Actual - Expected) > Max_Error then |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & 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_Value_Test is |
begin |
|
--- test 1 --- |
declare |
Y : Real; |
begin |
Y := Log(1.0); |
Check (Y, 0.0, "special value test 1 -- log(1)", |
0.0); -- no error allowed |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 1"); |
when others => |
Report.Failed ("exception in test 1"); |
end; |
|
--- test 2 --- |
declare |
Y : Real; |
begin |
Y := Log(10.0); |
Check (Y, Ln10, "special value test 2 -- log(10)", 4.0); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 2"); |
when others => |
Report.Failed ("exception in test 2"); |
end; |
|
--- test 3 --- |
declare |
Y : Real; |
begin |
Y := Log (2.0); |
Check (Y, Ln2, "special value test 3 -- log(2)", 4.0); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 3"); |
when others => |
Report.Failed ("exception in test 3"); |
end; |
|
--- test 4 --- |
declare |
Y : Real; |
begin |
Y := Log (2.0 ** 18, 2.0); |
Check (Y, 18.0, "special value test 4 -- log(2**18,2)", 4.0); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 4"); |
when others => |
Report.Failed ("exception in test 4"); |
end; |
end Special_Value_Test; |
|
|
procedure Taylor_Series_Test is |
-- Use a 4 term taylor series expansion to check a selection of |
-- arguments very near 1.0. |
-- The range is chosen so that the 4 term taylor series will |
-- provide accuracy to machine precision. Cody pg 49-50. |
Half_Range : constant Real := Real'Model_Epsilon * 50.0; |
A : constant Real := 1.0 - Half_Range; |
B : constant Real := 1.0 + Half_Range; |
X : Real; |
Xm1 : Real; |
Expected : Real; |
Actual : Real; |
|
begin |
Accuracy_Error_Reported := False; -- reset |
for I in 1..Max_Samples loop |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
|
Xm1 := X - 1.0; |
-- The following is the first 4 terms of the taylor series |
-- that has been rearranged to minimize error in the calculation |
Expected := (Xm1 * (1.0/3.0 - Xm1/4.0) - 0.5) * Xm1 * Xm1 + Xm1; |
|
Actual := Log (X); |
Check (Actual, Expected, |
"Taylor Series Test -" & |
Integer'Image (I) & |
" log (" & Real'Image (X) & ")", |
4.0); |
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Taylor Series Test"); |
when others => |
Report.Failed ("exception in Taylor Series Test"); |
end Taylor_Series_Test; |
|
|
|
procedure Log_Difference_Identity is |
-- Check using the identity ln(x) = ln(17x/16) - ln(17/16) |
-- over the range A to B. |
-- The selected range assures that both X and 17x/16 will |
-- have the same exponents and neither argument gets too close |
-- to 1. Cody pg 50. |
A : constant Real := 1.0 / Sqrt (2.0); |
B : constant Real := 15.0 / 16.0; |
X : Real; |
Expected : Real; |
Actual : Real; |
begin |
Accuracy_Error_Reported := False; -- reset |
for I in 1..Max_Samples loop |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
-- magic argument purification |
X := Real'Machine (Real'Machine (X+8.0) - 8.0); |
|
Expected := Log (X + X / 16.0) - Log (17.0/16.0); |
|
Actual := Log (X); |
Check (Actual, Expected, |
"Log Difference Identity -" & |
Integer'Image (I) & |
" log (" & Real'Image (X) & ")", |
4.0); |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Log Difference Identity Test"); |
when others => |
Report.Failed ("exception in Log Difference Identity Test"); |
end Log_Difference_Identity; |
|
|
procedure Log_Product_Identity is |
-- Check using the identity ln(x**2) = 2ln(x) |
-- over the range A to B. |
-- This large range is chosen to minimize the possibility of |
-- undetected systematic errors. Cody pg 53. |
A : constant Real := 16.0; |
B : constant Real := 240.0; |
X : Real; |
Expected : Real; |
Actual : Real; |
begin |
Accuracy_Error_Reported := False; -- reset |
for I in 1..Max_Samples loop |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
-- magic argument purification |
X := Real'Machine (Real'Machine (X+8.0) - 8.0); |
|
Expected := 2.0 * Log (X); |
|
Actual := Log (X*X); |
Check (Actual, Expected, |
"Log Product Identity -" & |
Integer'Image (I) & |
" log (" & Real'Image (X) & ")", |
4.0); |
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Log Product Identity Test"); |
when others => |
Report.Failed ("exception in Log Product Identity Test"); |
end Log_Product_Identity; |
|
|
procedure Log10_Test is |
-- Check using the identity log(x) = log(11x/10) - log(1.1) |
-- over the range A to B. See Cody pg 52. |
A : constant Real := 1.0 / Sqrt (10.0); |
B : constant Real := 0.9; |
X : Real; |
Expected : Real; |
Actual : Real; |
begin |
if Real'Digits > 17 then |
-- constant used below is accuract to 17 digits |
Error_Low_Bound := 0.00000_00000_00000_01; |
Report.Comment ("log accuracy checked to 19 digits"); |
end if; |
Accuracy_Error_Reported := False; -- reset |
for I in 1..Max_Samples loop |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
|
Expected := Log (X + X/10.0, 10.0) |
- 3.77060_15822_50407_5E-4 - 21.0 / 512.0; |
|
Actual := Log (X, 10.0); |
Check (Actual, Expected, |
"Log 10 Test -" & |
Integer'Image (I) & |
" log (" & Real'Image (X) & ")", |
4.0); |
|
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
exit when Accuracy_Error_Reported; |
end loop; |
Error_Low_Bound := 0.0; -- reset |
|
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Log 10 Test"); |
when others => |
Report.Failed ("exception in Log 10 Test"); |
end Log10_Test; |
|
|
procedure Exception_Test is |
X1, X2, X3, X4 : Real; |
begin |
begin |
X1 := Log (0.0); |
Report.Failed ("exception not raised for LOG(0)"); |
exception |
-- Log (0.0) must raise Constraint_Error, not Argument_Error, |
-- as per A.5.1(28,29). Was incorrect in ACVC 2.1 release. |
when Ada.Numerics.Argument_Error => |
Report.Failed ("Argument_Error raised instead of" & |
" Constraint_Error for LOG(0)--A.5.1(28,29)"); |
when Constraint_Error => null; -- ok |
when others => |
Report.Failed ("wrong exception raised for LOG(0)"); |
end; |
|
begin |
X2 := Log ( 1.0, 0.0); |
Report.Failed ("exception not raised for LOG(1,0)"); |
exception |
when Ada.Numerics.Argument_Error => null; -- ok |
when Constraint_Error => |
Report.Failed ("constraint_error raised instead of" & |
" argument_error for LOG(1,0)"); |
when others => |
Report.Failed ("wrong exception raised for LOG(1,0)"); |
end; |
|
begin |
X3 := Log (1.0, 1.0); |
Report.Failed ("exception not raised for LOG(1,1)"); |
exception |
when Ada.Numerics.Argument_Error => null; -- ok |
when Constraint_Error => |
Report.Failed ("constraint_error raised instead of" & |
" argument_error for LOG(1,1)"); |
when others => |
Report.Failed ("wrong exception raised for LOG(1,1)"); |
end; |
|
begin |
X4 := Log (1.0, -10.0); |
Report.Failed ("exception not raised for LOG(1,-10)"); |
exception |
when Ada.Numerics.Argument_Error => null; -- ok |
when Constraint_Error => |
Report.Failed ("constraint_error raised instead of" & |
" argument_error for LOG(1,-10)"); |
when others => |
Report.Failed ("wrong exception raised for LOG(1,-10)"); |
end; |
|
-- optimizer thwarting |
if Report.Ident_Bool (False) then |
Report.Comment (Real'Image (X1+X2+X3+X4)); |
end if; |
end Exception_Test; |
|
|
procedure Do_Test is |
begin |
Special_Value_Test; |
Taylor_Series_Test; |
Log_Difference_Identity; |
Log_Product_Identity; |
Log10_Test; |
Exception_Test; |
end Do_Test; |
end Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
package Float_Check is new Generic_Check (Float); |
|
-- check the floating point type with the most digits |
type A_Long_Float is digits System.Max_Digits; |
package A_Long_Float_Check is new Generic_Check (A_Long_Float); |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
|
begin |
Report.Test ("CXG2011", |
"Check the accuracy of the log function"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
|
Report.Result; |
end CXG2011; |
/cxg2021.a
0,0 → 1,386
-- CXG2021.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 SIN and COS functions return |
-- a result that is within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test consists of a generic package that is |
-- instantiated to check complex numbers based upon |
-- both Float and a long float type. |
-- The test for each floating point type is divided into |
-- several parts: |
-- Special value checks where the result is a known constant. |
-- Checks that use an identity for determining the result. |
-- |
-- 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: |
-- 27 Mar 96 SAIC Initial release for 2.1 |
-- 22 Aug 96 SAIC No longer skips test for systems with |
-- more than 20 digits of precision. |
-- |
--! |
|
-- |
-- References: |
-- |
-- W. J. Cody |
-- CELEFUNT: A Portable Test Package for Complex Elementary Functions |
-- Algorithm 714, Collected Algorithms from ACM. |
-- Published in Transactions On Mathematical Software, |
-- Vol. 19, No. 1, March, 1993, pp. 1-21. |
-- |
-- CRC Standard Mathematical Tables |
-- 23rd Edition |
-- |
|
with System; |
with Report; |
with Ada.Numerics.Generic_Complex_Types; |
with Ada.Numerics.Generic_Complex_Elementary_Functions; |
procedure CXG2021 is |
Verbose : constant Boolean := False; |
-- Note that Max_Samples is the number of samples taken in |
-- both the real and imaginary directions. Thus, for Max_Samples |
-- of 100 the number of values checked is 10000. |
Max_Samples : constant := 100; |
|
E : constant := Ada.Numerics.E; |
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_Type is new |
Ada.Numerics.Generic_Complex_Types (Real); |
use Complex_Type; |
|
package CEF is new |
Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type); |
|
function Sin (X : Complex) return Complex renames CEF.Sin; |
function Cos (X : Complex) return Complex renames CEF.Cos; |
|
-- flag used to terminate some tests early |
Accuracy_Error_Reported : Boolean := False; |
|
-- The following value is a lower bound on the accuracy |
-- required. It is normally 0.0 so that the lower bound |
-- is computed from Model_Epsilon. However, for tests |
-- where the expected result is only known to a certain |
-- amount of precision this bound takes on a non-zero |
-- value to account for that level of precision. |
Error_Low_Bound : Real := 0.0; |
|
-- the E_Factor is an additional amount added to the Expected |
-- value prior to computing the maximum relative error. |
-- This is needed because the error analysis (Cody pg 17-20) |
-- requires this additional allowance. |
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real; |
E_Factor : Real := 0.0) is |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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 * Real'Model_Epsilon * (abs Expected + E_Factor); |
Abs_Error := MRE * Real'Model_Epsilon; |
if Rel_Error > Abs_Error then |
Max_Error := Rel_Error; |
else |
Max_Error := Abs_Error; |
end if; |
|
-- take into account the low bound on the error |
if Max_Error < Error_Low_Bound then |
Max_Error := Error_Low_Bound; |
end if; |
|
if abs (Actual - Expected) > Max_Error then |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & Real'Image (Max_Error) & |
" efactor:" & Real'Image (E_Factor) ); |
elsif Verbose then |
if Actual = Expected then |
Report.Comment (Test_Name & " exact result"); |
else |
Report.Comment (Test_Name & " passed" & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & Real'Image (Max_Error) & |
" efactor:" & Real'Image (E_Factor) ); |
end if; |
end if; |
end Check; |
|
|
procedure Check (Actual, Expected : Complex; |
Test_Name : String; |
MRE : Real; |
R_Factor, I_Factor : Real := 0.0) is |
begin |
Check (Actual.Re, Expected.Re, Test_Name & " real part", |
MRE, R_Factor); |
Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", |
MRE, I_Factor); |
end Check; |
|
|
procedure Special_Value_Test is |
-- In the following tests the expected result is accurate |
-- to the machine precision so the minimum guaranteed error |
-- bound can be used if the argument is exact. |
-- Since the argument involves Pi, we must allow for this |
-- inexact argument. |
Minimum_Error : constant := 11.0; |
begin |
Check (Sin (Pi/2.0 + 0.0*i), |
1.0 + 0.0*i, |
"sin(pi/2+0i)", |
Minimum_Error + 1.0); |
Check (Cos (Pi/2.0 + 0.0*i), |
0.0 + 0.0*i, |
"cos(pi/2+0i)", |
Minimum_Error + 1.0); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in special value test"); |
when others => |
Report.Failed ("exception in special value test"); |
end Special_Value_Test; |
|
|
|
procedure Exact_Result_Test is |
No_Error : constant := 0.0; |
begin |
-- G.1.2(36);6.0 |
Check (Sin(0.0 + 0.0*i), 0.0 + 0.0 * i, "sin(0+0i)", No_Error); |
Check (Cos(0.0 + 0.0*i), 1.0 + 0.0 * i, "cos(0+0i)", No_Error); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in Exact_Result Test"); |
when others => |
Report.Failed ("exception in Exact_Result Test"); |
end Exact_Result_Test; |
|
|
procedure Identity_Test (RA, RB, IA, IB : Real) is |
-- Tests an identity over a range of values specified |
-- by the 4 parameters. RA and RB denote the range for the |
-- real part while IA and IB denote the range for the |
-- imaginary part. |
-- |
-- For this test we use the identity |
-- Sin(Z) = Sin(Z-W) * Cos(W) + Cos(Z-W) * Sin(W) |
-- and |
-- Cos(Z) = Cos(Z-W) * Cos(W) - Sin(Z-W) * Sin(W) |
-- |
|
X, Y : Real; |
Z : Complex; |
W : constant Complex := Compose_From_Cartesian(0.0625, 0.0625); |
ZmW : Complex; -- Z - W |
Sin_ZmW, |
Cos_ZmW : Complex; |
Actual1, Actual2 : Complex; |
R_Factor : Real; -- additional real error factor |
I_Factor : Real; -- additional imaginary error factor |
Sin_W : constant Complex := (6.2581348413276935585E-2, |
6.2418588008436587236E-2); |
-- numeric stability is enhanced by using Cos(W) - 1.0 instead of |
-- Cos(W) in the computation. |
Cos_W_m_1 : constant Complex := (-2.5431314180235545803E-6, |
-3.9062493377261771826E-3); |
|
|
begin |
if Real'Digits > 20 then |
-- constants used here accurate to 20 digits. Allow 1 |
-- additional digit of error for computation. |
Error_Low_Bound := 0.00000_00000_00000_0001; |
Report.Comment ("accuracy checked to 19 digits"); |
end if; |
|
Accuracy_Error_Reported := False; -- reset |
for II in 0..Max_Samples loop |
X := (RB - RA) * Real (II) / Real (Max_Samples) + RA; |
for J in 0..Max_Samples loop |
Y := (IB - IA) * Real (J) / Real (Max_Samples) + IA; |
|
Z := Compose_From_Cartesian(X,Y); |
ZmW := Z - W; |
Sin_ZmW := Sin (ZmW); |
Cos_ZmW := Cos (ZmW); |
|
-- now for the first identity |
-- Sin(Z) = Sin(Z-W) * Cos(W) + Cos(Z-W) * Sin(W) |
-- = Sin(Z-W) * (1+(Cos(W)-1)) + Cos(Z-W) * Sin(W) |
-- = Sin(Z-W) + Sin(Z-W)*(Cos(W)-1) + Cos(Z-W)*Sin(W) |
|
|
Actual1 := Sin (Z); |
Actual2 := Sin_ZmW + (Sin_ZmW * Cos_W_m_1 + Cos_ZmW * Sin_W); |
|
-- The computation of the additional error factors are taken |
-- from Cody pages 17-20. |
|
R_Factor := abs (Re (Sin_ZmW) * Re (1.0 - Cos_W_m_1)) + |
abs (Im (Sin_ZmW) * Im (1.0 - Cos_W_m_1)) + |
abs (Re (Cos_ZmW) * Re (Sin_W)) + |
abs (Re (Cos_ZmW) * Re (1.0 - Cos_W_m_1)); |
|
I_Factor := abs (Re (Sin_ZmW) * Im (1.0 - Cos_W_m_1)) + |
abs (Im (Sin_ZmW) * Re (1.0 - Cos_W_m_1)) + |
abs (Re (Cos_ZmW) * Im (Sin_W)) + |
abs (Im (Cos_ZmW) * Re (1.0 - Cos_W_m_1)); |
|
Check (Actual1, Actual2, |
"Identity_1_Test " & Integer'Image (II) & |
Integer'Image (J) & ": Sin((" & |
Real'Image (Z.Re) & ", " & |
Real'Image (Z.Im) & ")) ", |
11.0, R_Factor, I_Factor); |
|
-- now for the second identity |
-- Cos(Z) = Cos(Z-W) * Cos(W) - Sin(Z-W) * Sin(W) |
-- = Cos(Z-W) * (1+(Cos(W)-1) - Sin(Z-W) * Sin(W) |
Actual1 := Cos (Z); |
Actual2 := Cos_ZmW + (Cos_ZmW * Cos_W_m_1 - Sin_ZmW * Sin_W); |
|
-- The computation of the additional error factors are taken |
-- from Cody pages 17-20. |
|
R_Factor := abs (Re (Sin_ZmW) * Re (Sin_W)) + |
abs (Im (Sin_ZmW) * Im (Sin_W)) + |
abs (Re (Cos_ZmW) * Re (1.0 - Cos_W_m_1)) + |
abs (Im (Cos_ZmW) * Im (1.0 - Cos_W_m_1)); |
|
I_Factor := abs (Re (Sin_ZmW) * Im (Sin_W)) + |
abs (Im (Sin_ZmW) * Re (Sin_W)) + |
abs (Re (Cos_ZmW) * Im (1.0 - Cos_W_m_1)) + |
abs (Im (Cos_ZmW) * Re (1.0 - Cos_W_m_1)); |
|
Check (Actual1, Actual2, |
"Identity_2_Test " & Integer'Image (II) & |
Integer'Image (J) & ": Cos((" & |
Real'Image (Z.Re) & ", " & |
Real'Image (Z.Im) & ")) ", |
11.0, R_Factor, I_Factor); |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
Error_Low_Bound := 0.0; -- reset |
return; |
end if; |
end loop; |
end loop; |
|
Error_Low_Bound := 0.0; -- reset |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Identity_Test" & |
" for Z=(" & Real'Image (X) & |
", " & Real'Image (Y) & ")"); |
when others => |
Report.Failed ("exception in Identity_Test" & |
" for Z=(" & Real'Image (X) & |
", " & Real'Image (Y) & ")"); |
end Identity_Test; |
|
|
procedure Do_Test is |
begin |
Special_Value_Test; |
Exact_Result_Test; |
-- test regions where sin and cos have the same sign and |
-- about the same magnitude. This will minimize subtraction |
-- errors in the identities. |
-- See Cody page 17. |
Identity_Test (0.0625, 10.0, 0.0625, 10.0); |
Identity_Test ( 16.0, 17.0, 16.0, 17.0); |
end Do_Test; |
end Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
package Float_Check is new Generic_Check (Float); |
|
-- check the floating point type with the most digits |
type A_Long_Float is digits System.Max_Digits; |
package A_Long_Float_Check is new Generic_Check (A_Long_Float); |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
|
begin |
Report.Test ("CXG2021", |
"Check the accuracy of the complex SIN and COS functions"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
|
Report.Result; |
end CXG2021; |
/cxg2012.a
0,0 → 1,438
-- CXG2012.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 exponentiation operator returns |
-- results that are within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test consists of a generic package that is |
-- instantiated to check both Float and a long float type. |
-- The test for each floating point type is divided into |
-- several parts: |
-- Special value checks where the result is a known constant. |
-- Checks that use an identity for determining the result. |
-- Exception checks. |
-- While this test concentrates on the "**" operator |
-- defined in Generic_Elementary_Functions, a check is also |
-- performed on the standard "**" operator. |
-- |
-- 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: |
-- 7 Mar 96 SAIC Initial release for 2.1 |
-- 2 Sep 96 SAIC Improvements as suggested by reviewers |
-- 3 Jun 98 EDS Add parens to ensure that the expression is not |
-- evaluated by multiplying its two large terms |
-- together and overflowing. |
-- 3 Dec 01 RLB Added 'Machine to insure that equality tests |
-- are certain to work. |
-- |
--! |
|
-- |
-- References: |
-- |
-- Software Manual for the Elementary Functions |
-- William J. Cody, Jr. and William Waite |
-- Prentice-Hall, 1980 |
-- |
-- CRC Standard Mathematical Tables |
-- 23rd Edition |
-- |
-- Implementation and Testing of Function Software |
-- W. J. Cody |
-- 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 Ada.Numerics.Generic_Elementary_Functions; |
procedure CXG2012 is |
Verbose : constant Boolean := False; |
Max_Samples : constant := 1000; |
|
-- 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; |
|
|
generic |
type Real is digits <>; |
package Generic_Check is |
procedure Do_Test; |
end Generic_Check; |
|
package body Generic_Check is |
package Elementary_Functions is new |
Ada.Numerics.Generic_Elementary_Functions (Real); |
function Sqrt (X : Real) return Real renames |
Elementary_Functions.Sqrt; |
function Exp (X : Real) return Real renames |
Elementary_Functions.Exp; |
function Log (X : Real) return Real renames |
Elementary_Functions.Log; |
function "**" (L, R : Real) return Real renames |
Elementary_Functions."**"; |
|
-- flag used to terminate some tests early |
Accuracy_Error_Reported : Boolean := False; |
|
|
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real) is |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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 |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & 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; |
|
|
-- the following version of Check computes the allowed error bound |
-- using the operands |
procedure Check (Actual, Expected : Real; |
Left, Right : Real; |
Test_Name : String; |
MRE_Factor : Real := 1.0) is |
MRE : Real; |
begin |
MRE := MRE_Factor * (4.0 + abs (Right * Log(Left)) / 32.0); |
Check (Actual, Expected, Test_Name, MRE); |
end Check; |
|
|
procedure Real_To_Integer_Test is |
type Int_Check is |
record |
Left : Real; |
Right : Integer; |
Expected : Real; |
end record; |
type Int_Checks is array (Positive range <>) of Int_Check; |
|
-- the following tests use only model numbers so the result |
-- is expected to be exact. |
IC : constant Int_Checks := |
( ( 2.0, 5, 32.0), |
( -2.0, 5, -32.0), |
( 0.5, -5, 32.0), |
( 2.0, 0, 1.0), |
( 0.0, 0, 1.0) ); |
begin |
for I in IC'Range loop |
declare |
Y : Real; |
begin |
Y := IC (I).Left ** IC (I).Right; |
Check (Y, IC (I).Expected, |
"real to integer test" & |
Real'Image (IC (I).Left) & " ** " & |
Integer'Image (IC (I).Right), |
0.0); -- no error allowed |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in rtoi test " & |
Integer'Image (I)); |
when others => |
Report.Failed ("exception in rtoi test " & |
Integer'Image (I)); |
end; |
end loop; |
end Real_To_Integer_Test; |
|
|
procedure Special_Value_Test is |
No_Error : constant := 0.0; |
begin |
Check (0.0 ** 1.0, 0.0, "0**1", No_Error); |
Check (1.0 ** 0.0, 1.0, "1**0", No_Error); |
|
Check ( 2.0 ** 5.0, 32.0, 2.0, 5.0, "2**5"); |
Check ( 0.5**(-5.0), 32.0, 0.5, -5.0, "0.5**-5"); |
|
Check (Sqrt2 ** 4.0, 4.0, Sqrt2, 4.0, "Sqrt2**4"); |
Check (Sqrt3 ** 6.0, 27.0, Sqrt3, 6.0, "Sqrt3**6"); |
|
Check (2.0 ** 0.5, Sqrt2, 2.0, 0.5, "2.0**0.5"); |
|
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in Special Value Test"); |
when others => |
Report.Failed ("exception in Special Value Test"); |
end Special_Value_Test; |
|
|
procedure Small_Range_Test is |
-- Several checks over the range 1/radix .. 1 |
A : constant Real := 1.0 / Real (Real'Machine_Radix); |
B : constant Real := 1.0; |
X : Real; |
-- In the cases below where the expected result is |
-- inexact we allow an additional error amount of |
-- 1.0 * Model_Epsilon to account for that error. |
-- This is accomplished by the factor of 1.25 times |
-- the computed error bound (which is > 4.0) thus |
-- increasing the error bound by at least |
-- 1.0 * Model_Epsilon |
begin |
Accuracy_Error_Reported := False; -- reset |
for I in 0..Max_Samples loop |
X := Real'Machine((B - A) * Real (I) / Real (Max_Samples) + A); |
|
Check (X ** 1.0, X, -- exact result required |
"Small range" & Integer'Image (I) & ": " & |
Real'Image (X) & " ** 1.0", |
0.0); |
|
Check ((X*X) ** 1.5, X**3, X*X, 1.5, |
"Small range" & Integer'Image (I) & ": " & |
Real'Image (X*X) & " ** 1.5", |
1.25); |
|
Check (X ** 13.5, 1.0 / (X ** (-13.5)), X, 13.5, |
"Small range" & Integer'Image (I) & ": " & |
Real'Image (X) & " ** 13.5", |
2.0); -- 2 ** computations |
|
Check ((X*X) ** 1.25, X**(2.5), X*X, 1.25, |
"Small range" & Integer'Image (I) & ": " & |
Real'Image (X*X) & " ** 1.25", |
2.0); -- 2 ** computations |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
|
end loop; |
|
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Small Range Test"); |
when others => |
Report.Failed ("exception in Small Range Test"); |
end Small_Range_Test; |
|
|
procedure Large_Range_Test is |
-- Check over the range A to B where A is 1.0 and |
-- B is a large value. |
A : constant Real := 1.0; |
B : Real; |
X : Real; |
Iteration : Integer := 0; |
Subtest : Character := 'X'; |
begin |
-- upper bound of range should be as large as possible where |
-- B**3 is still valid. |
B := Real'Safe_Last ** 0.333; |
Accuracy_Error_Reported := False; -- reset |
for I in 0..Max_Samples loop |
Iteration := I; |
Subtest := 'X'; |
X := Real'Machine((B - A) * (Real (I) / Real (Max_Samples)) + A); |
|
Subtest := 'A'; |
Check (X ** 1.0, X, -- exact result required |
"Large range" & Integer'Image (I) & ": " & |
Real'Image (X) & " ** 1.0", |
0.0); |
|
Subtest := 'B'; |
Check ((X*X) ** 1.5, X**3, X*X, 1.5, |
"Large range" & Integer'Image (I) & ": " & |
Real'Image (X*X) & " ** 1.5", |
1.25); -- inexact expected result |
|
Subtest := 'C'; |
Check ((X*X) ** 1.25, X**(2.5), X*X, 1.25, |
"Large range" & Integer'Image (I) & ": " & |
Real'Image (X*X) & " ** 1.25", |
2.0); -- two ** operators |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
|
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Large Range Test" & |
Integer'Image (Iteration) & Subtest); |
when others => |
Report.Failed ("exception in Large Range Test" & |
Integer'Image (Iteration) & Subtest); |
end Large_Range_Test; |
|
|
procedure Exception_Test is |
X1, X2, X3, X4 : Real; |
begin |
begin |
X1 := 0.0 ** (-1.0); |
Report.Failed ("exception not raised for 0**-1"); |
exception |
when Ada.Numerics.Argument_Error => |
Report.Failed ("argument_error raised instead of" & |
" constraint_error for 0**-1"); |
when Constraint_Error => null; -- ok |
when others => |
Report.Failed ("wrong exception raised for 0**-1"); |
end; |
|
begin |
X2 := 0.0 ** 0.0; |
Report.Failed ("exception not raised for 0**0"); |
exception |
when Ada.Numerics.Argument_Error => null; -- ok |
when Constraint_Error => |
Report.Failed ("constraint_error raised instead of" & |
" argument_error for 0**0"); |
when others => |
Report.Failed ("wrong exception raised for 0**0"); |
end; |
|
begin |
X3 := (-1.0) ** 1.0; |
Report.Failed ("exception not raised for -1**1"); |
exception |
when Ada.Numerics.Argument_Error => null; -- ok |
when Constraint_Error => |
Report.Failed ("constraint_error raised instead of" & |
" argument_error for -1**1"); |
when others => |
Report.Failed ("wrong exception raised for -1**1"); |
end; |
|
begin |
X4 := (-2.0) ** 2.0; |
Report.Failed ("exception not raised for -2**2"); |
exception |
when Ada.Numerics.Argument_Error => null; -- ok |
when Constraint_Error => |
Report.Failed ("constraint_error raised instead of" & |
" argument_error for -2**2"); |
when others => |
Report.Failed ("wrong exception raised for -2**2"); |
end; |
|
-- optimizer thwarting |
if Report.Ident_Bool (False) then |
Report.Comment (Real'Image (X1+X2+X3+X4)); |
end if; |
end Exception_Test; |
|
|
procedure Do_Test is |
begin |
Real_To_Integer_Test; |
Special_Value_Test; |
Small_Range_Test; |
Large_Range_Test; |
Exception_Test; |
end Do_Test; |
end Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
package Float_Check is new Generic_Check (Float); |
|
-- check the floating point type with the most digits |
type A_Long_Float is digits System.Max_Digits; |
package A_Long_Float_Check is new Generic_Check (A_Long_Float); |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
|
begin |
Report.Test ("CXG2012", |
"Check the accuracy of the ** operator"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
|
Report.Result; |
end CXG2012; |
/cxg1004.a
0,0 → 1,360
-- CXG1004.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 specified exceptions are raised by the subprograms |
-- defined in package Ada.Numerics.Generic_Complex_Elementary_Functions |
-- given the prescribed input parameter values. |
-- |
-- TEST DESCRIPTION: |
-- This test checks that specific subprograms defined in the |
-- package Ada.Numerics.Generic_Complex_Elementary_Functions raise the |
-- exceptions Argument_Error and Constraint_Error when their input |
-- parameter value are those specified as causing each exception. |
-- In the case of Constraint_Error, the exception will be raised in |
-- each test case, provided that the value of the attribute |
-- 'Machine_Overflows (for the actual type of package |
-- Generic_Complex_Type) is True. |
-- |
-- APPLICABILITY CRITERIA: |
-- This test only applies to implementations supporting the |
-- numerics annex. |
-- |
-- |
-- CHANGE HISTORY: |
-- 06 Dec 94 SAIC ACVC 2.0 |
-- 16 Nov 95 SAIC Corrected visibility problems for ACVC 2.0.1. |
-- 29 Sep 96 SAIC Incorporated reviewer comments. |
-- 02 Jun 98 EDS Replace "_i" with "_One". |
--! |
|
with Ada.Numerics.Generic_Complex_Types; |
with Ada.Numerics.Generic_Complex_Elementary_Functions; |
with Report; |
|
procedure CXG1004 is |
begin |
|
Report.Test ("CXG1004", "Check that the specified exceptions are " & |
"raised by the subprograms defined in package " & |
"Ada.Numerics.Generic_Complex_Elementary_" & |
"Functions given the prescribed input " & |
"parameter values"); |
|
Test_Block: |
declare |
|
type Real_Type is new Float; |
|
TC_Overflows : Boolean := Real_Type'Machine_Overflows; |
|
package Complex_Pack is |
new Ada.Numerics.Generic_Complex_Types(Real_Type); |
|
package CEF is |
new Ada.Numerics.Generic_Complex_Elementary_Functions(Complex_Pack); |
|
use Ada.Numerics, Complex_Pack, CEF; |
|
Complex_Zero : constant Complex := Compose_From_Cartesian(0.0, 0.0); |
Plus_One : constant Complex := Compose_From_Cartesian(1.0, 0.0); |
Minus_One : constant Complex := Compose_From_Cartesian(-1.0, 0.0); |
Plus_i : constant Complex := Compose_From_Cartesian(i); |
Minus_i : constant Complex := Compose_From_Cartesian(-i); |
|
Complex_Negative_Real : constant Complex := |
Compose_From_Cartesian(-4.0, 2.0); |
Complex_Negative_Imaginary : constant Complex := |
Compose_From_Cartesian(3.0, -5.0); |
|
TC_Complex : Complex; |
|
|
-- This procedure is used in "Exception Raising" calls below in an |
-- attempt to avoid elimination of the subtest through optimization. |
|
procedure No_Optimize (The_Complex_Number : Complex) is |
begin |
Report.Comment("No Optimize: Should never be printed " & |
Integer'Image(Integer(The_Complex_Number.Im))); |
end No_Optimize; |
|
|
begin |
|
-- Check that the exception Numerics.Argument_Error is raised by the |
-- exponentiation operator when the value of the left operand is zero, |
-- and the real component of the exponent (or the exponent itself) is |
-- zero. |
|
begin |
TC_Complex := "**"(Left => Complex_Zero, Right => Complex_Zero); |
Report.Failed("Argument_Error not raised by exponentiation " & |
"operator, left operand = complex zero, right " & |
"operand = complex zero"); |
No_Optimize(TC_Complex); |
exception |
when Argument_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised by exponentiation " & |
"operator, left operand = complex zero, right " & |
"operand = complex zero"); |
end; |
|
begin |
TC_Complex := Complex_Zero**0.0; |
Report.Failed("Argument_Error not raised by exponentiation " & |
"operator, left operand = complex zero, right " & |
"operand = real zero"); |
No_Optimize(TC_Complex); |
exception |
when Argument_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised by exponentiation " & |
"operator, left operand = complex zero, right " & |
"operand = real zero"); |
end; |
|
|
begin |
TC_Complex := "**"(Left => 0.0, Right => Complex_Zero); |
Report.Failed("Argument_Error not raised by exponentiation " & |
"operator, left operand = real zero, right " & |
"operand = complex zero"); |
No_Optimize(TC_Complex); |
exception |
when Argument_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised by exponentiation " & |
"operator, left operand = real zero, right " & |
"operand = complex zero"); |
end; |
|
|
-- Check that the exception Constraint_Error is raised under the |
-- specified circumstances, provided that |
-- Complex_Types.Real'Machine_Overflows is True. |
|
if TC_Overflows then |
|
-- Raised by Log, when the value of the parameter X is zero. |
begin |
TC_Complex := Log (X => Complex_Zero); |
Report.Failed("Constraint_Error not raised when Function " & |
"Log given parameter value of complex zero"); |
No_Optimize(TC_Complex); |
exception |
when Constraint_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised when Function " & |
"Log given parameter value of complex zero"); |
end; |
|
-- Raised by Cot, when the value of the parameter X is zero. |
begin |
TC_Complex := Cot (X => Complex_Zero); |
Report.Failed("Constraint_Error not raised when Function " & |
"Cot given parameter value of complex zero"); |
No_Optimize(TC_Complex); |
exception |
when Constraint_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised when Function " & |
"Cot given parameter value of complex zero"); |
end; |
|
-- Raised by Coth, when the value of the parameter X is zero. |
begin |
TC_Complex := Coth (Complex_Zero); |
Report.Failed("Constraint_Error not raised when Function " & |
"Coth given parameter value of complex zero"); |
No_Optimize(TC_Complex); |
exception |
when Constraint_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised when Function " & |
"Coth given parameter value of complex zero"); |
end; |
|
-- Raised by the exponentiation operator, when the value of the |
-- left operand is zero and the real component of the exponent |
-- is negative. |
begin |
TC_Complex := Complex_Zero**Complex_Negative_Real; |
Report.Failed("Constraint_Error not raised when the " & |
"exponentiation operator left operand is " & |
"complex zero, and the real component of " & |
"the exponent is negative"); |
No_Optimize(TC_Complex); |
exception |
when Constraint_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised when the " & |
"exponentiation operator left operand is " & |
"complex zero, and the real component of " & |
"the exponent is negative"); |
end; |
|
-- Raised by the exponentiation operator, when the value of the |
-- left operand is zero and the exponent itself (when it is of |
-- type real) is negative. |
declare |
Negative_Exponent : constant Real_Type := -4.0; |
begin |
TC_Complex := Complex_Zero**Negative_Exponent; |
Report.Failed("Constraint_Error not raised when the " & |
"exponentiation operator left operand is " & |
"complex zero, and the real exponent is " & |
"negative"); |
No_Optimize(TC_Complex); |
exception |
when Constraint_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised when the " & |
"exponentiation operator left operand is " & |
"complex zero, and the real exponent is " & |
"negative"); |
end; |
|
-- Raised by Arctan, when the value of the parameter is +i. |
begin |
TC_Complex := Arctan (Plus_i); |
Report.Failed("Constraint_Error not raised when Function " & |
"Arctan is given parameter value +i"); |
No_Optimize(TC_Complex); |
exception |
when Constraint_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised when Function " & |
"Arctan is given parameter value +i"); |
end; |
|
-- Raised by Arctan, when the value of the parameter is -i. |
begin |
TC_Complex := Arctan (Minus_i); |
Report.Failed("Constraint_Error not raised when Function " & |
"Arctan is given parameter value -i"); |
No_Optimize(TC_Complex); |
exception |
when Constraint_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised when Function " & |
"Arctan is given parameter value -i"); |
end; |
|
-- Raised by Arccot, when the value of the parameter is +i. |
begin |
TC_Complex := Arccot (Plus_i); |
Report.Failed("Constraint_Error not raised when Function " & |
"Arccot is given parameter value +i"); |
No_Optimize(TC_Complex); |
exception |
when Constraint_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised when Function " & |
"Arccot is given parameter value +i"); |
end; |
|
-- Raised by Arccot, when the value of the parameter is -i. |
begin |
TC_Complex := Arccot (Minus_i); |
Report.Failed("Constraint_Error not raised when Function " & |
"Arccot is given parameter value -i"); |
No_Optimize(TC_Complex); |
exception |
when Constraint_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised when Function " & |
"Arccot is given parameter value -i"); |
end; |
|
-- Raised by Arctanh, when the value of the parameter is +1. |
begin |
TC_Complex := Arctanh (Plus_One); |
Report.Failed("Constraint_Error not raised when Function " & |
"Arctanh is given parameter value +1"); |
No_Optimize(TC_Complex); |
exception |
when Constraint_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised when Function " & |
"Arctanh is given parameter value +1"); |
end; |
|
-- Raised by Arctanh, when the value of the parameter is -1. |
begin |
TC_Complex := Arctanh (Minus_One); |
Report.Failed("Constraint_Error not raised when Function " & |
"Arctanh is given parameter value -1"); |
No_Optimize(TC_Complex); |
exception |
when Constraint_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised when Function " & |
"Arctanh is given parameter value -1"); |
end; |
|
-- Raised by Arccoth, when the value of the parameter is +1. |
begin |
TC_Complex := Arccoth (Plus_One); |
Report.Failed("Constraint_Error not raised when Function " & |
"Arccoth is given parameter value +1"); |
No_Optimize(TC_Complex); |
exception |
when Constraint_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised when Function " & |
"Arccoth is given parameter value +1"); |
end; |
|
-- Raised by Arccoth, when the value of the parameter is -1. |
begin |
TC_Complex := Arccoth (Minus_One); |
Report.Failed("Constraint_Error not raised when Function " & |
"Arccoth is given parameter value -1"); |
No_Optimize(TC_Complex); |
exception |
when Constraint_Error => null; -- OK, expected exception. |
when others => |
Report.Failed("Incorrect exception raised when Function " & |
"Arccoth is given parameter value -1"); |
end; |
|
else |
Report.Comment |
("Attribute Complex_Pack.Real'Machine_Overflows is False; " & |
"evaluation of the complex elementary functions under " & |
"specified circumstances was not performed"); |
end if; |
|
|
exception |
when others => |
Report.Failed ("Unexpected exception raised in Test_Block"); |
end Test_Block; |
|
Report.Result; |
|
end CXG1004; |
/cxg2003.a
0,0 → 1,701
-- CXG2003.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 sqrt function returns |
-- results that are within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test contains three test packages that are almost |
-- identical. The first two packages differ only in the |
-- floating point type that is being tested. The first |
-- and third package differ only in whether the generic |
-- elementary functions package or the pre-instantiated |
-- package is used. |
-- The test package is not generic so that the arguments |
-- and expected results for some of the test values |
-- can be expressed as universal real instead of being |
-- computed at runtime. |
-- |
-- 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: |
-- 2 FEB 96 SAIC Initial release for 2.1 |
-- 18 AUG 96 SAIC Made Check consistent with other tests. |
-- |
--! |
|
with System; |
with Report; |
with Ada.Numerics.Generic_Elementary_Functions; |
with Ada.Numerics.Elementary_Functions; |
procedure CXG2003 is |
Verbose : constant Boolean := False; |
|
package Float_Check is |
subtype Real is Float; |
procedure Do_Test; |
end Float_Check; |
|
package body Float_Check is |
package Elementary_Functions is new |
Ada.Numerics.Generic_Elementary_Functions (Real); |
function Sqrt (X : Real) return Real renames |
Elementary_Functions.Sqrt; |
function Log (X : Real) return Real renames |
Elementary_Functions.Log; |
function Exp (X : Real) return Real renames |
Elementary_Functions.Exp; |
|
-- The default Maximum Relative Error is the value specified |
-- in the LRM. |
Default_MRE : constant Real := 2.0; |
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real := Default_MRE) 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 Argument_Range_Check (A, B : Real; |
Test : String) is |
-- test a logarithmically distributed selection of |
-- arguments selected from the range A to B. |
X : Real; |
Expected : Real; |
Y : Real; |
C : Real := Log(B/A); |
Max_Samples : constant := 1000; |
|
begin |
for I in 1..Max_Samples loop |
Expected := A * Exp(C * Real (I) / Real (Max_Samples)); |
X := Expected * Expected; |
Y := Sqrt (X); |
|
-- note that since the expected value is computed, we |
-- must take the error in that computation into account. |
Check (Y, Expected, |
"test " & Test & " -" & |
Integer'Image (I) & |
" of argument range", |
3.0); |
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in argument range check"); |
when others => |
Report.Failed ("exception in argument range check"); |
end Argument_Range_Check; |
|
procedure Do_Test is |
begin |
|
--- test 1 --- |
declare |
T : constant := (Real'Machine_EMax - 1) / 2; |
X : constant := (1.0 * Real'Machine_Radix) ** (2 * T); |
Expected : constant := (1.0 * Real'Machine_Radix) ** T; |
Y : Real; |
begin |
Y := Sqrt (X); |
Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 1"); |
when others => |
Report.Failed ("exception in test 1"); |
end; |
|
--- test 2 --- |
declare |
T : constant := (Real'Model_EMin + 1) / 2; |
X : constant := (1.0 * Real'Machine_Radix) ** (2 * T); |
Expected : constant := (1.0 * Real'Machine_Radix) ** T; |
Y : Real; |
begin |
Y := Sqrt (X); |
Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 2"); |
when others => |
Report.Failed ("exception in test 2"); |
end; |
|
--- test 3 --- |
declare |
X : constant := 1.0; |
Expected : constant := 1.0; |
Y : Real; |
begin |
Y := Sqrt(X); |
Check (Y, Expected, "test 3 -- sqrt(1.0)", |
0.0); -- no error allowed |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 3"); |
when others => |
Report.Failed ("exception in test 3"); |
end; |
|
--- test 4 --- |
declare |
X : constant := 0.0; |
Expected : constant := 0.0; |
Y : Real; |
begin |
Y := Sqrt(X); |
Check (Y, Expected, "test 4 -- sqrt(0.0)", |
0.0); -- no error allowed |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 4"); |
when others => |
Report.Failed ("exception in test 4"); |
end; |
|
--- test 5 --- |
declare |
X : constant := -1.0; |
Y : Real; |
begin |
Y := Sqrt(X); |
-- the following code should not be executed. |
-- The call to Check is to keep the call to Sqrt from |
-- appearing to be dead code. |
Check (Y, -1.0, "test 5 -- sqrt(-1)" ); |
Report.Failed ("test 5 - argument_error expected"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 5"); |
when Ada.Numerics.Argument_Error => |
if Verbose then |
Report.Comment ("test 5 correctly got argument_error"); |
end if; |
when others => |
Report.Failed ("exception in test 5"); |
end; |
|
--- test 6 --- |
declare |
X : constant := Ada.Numerics.Pi ** 2; |
Expected : constant := Ada.Numerics.Pi; |
Y : Real; |
begin |
Y := Sqrt (X); |
Check (Y, Expected, "test 6 -- sqrt(pi**2)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 6"); |
when others => |
Report.Failed ("exception in test 6"); |
end; |
|
--- test 7 & 8 --- |
Argument_Range_Check (1.0/Sqrt(Real(Real'Machine_Radix)), |
1.0, |
"7"); |
Argument_Range_Check (1.0, |
Sqrt(Real(Real'Machine_Radix)), |
"8"); |
end Do_Test; |
end Float_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
-- check the floating point type with the most digits |
type A_Long_Float is digits System.Max_Digits; |
|
|
package A_Long_Float_Check is |
subtype Real is A_Long_Float; |
procedure Do_Test; |
end A_Long_Float_Check; |
|
package body A_Long_Float_Check is |
package Elementary_Functions is new |
Ada.Numerics.Generic_Elementary_Functions (Real); |
function Sqrt (X : Real) return Real renames |
Elementary_Functions.Sqrt; |
function Log (X : Real) return Real renames |
Elementary_Functions.Log; |
function Exp (X : Real) return Real renames |
Elementary_Functions.Exp; |
|
-- The default Maximum Relative Error is the value specified |
-- in the LRM. |
Default_MRE : constant Real := 2.0; |
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real := Default_MRE) 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 Argument_Range_Check (A, B : Real; |
Test : String) is |
-- test a logarithmically distributed selection of |
-- arguments selected from the range A to B. |
X : Real; |
Expected : Real; |
Y : Real; |
C : Real := Log(B/A); |
Max_Samples : constant := 1000; |
|
begin |
for I in 1..Max_Samples loop |
Expected := A * Exp(C * Real (I) / Real (Max_Samples)); |
X := Expected * Expected; |
Y := Sqrt (X); |
|
-- note that since the expected value is computed, we |
-- must take the error in that computation into account. |
Check (Y, Expected, |
"test " & Test & " -" & |
Integer'Image (I) & |
" of argument range", |
3.0); |
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in argument range check"); |
when others => |
Report.Failed ("exception in argument range check"); |
end Argument_Range_Check; |
|
|
procedure Do_Test is |
begin |
|
--- test 1 --- |
declare |
T : constant := (Real'Machine_EMax - 1) / 2; |
X : constant := (1.0 * Real'Machine_Radix) ** (2 * T); |
Expected : constant := (1.0 * Real'Machine_Radix) ** T; |
Y : Real; |
begin |
Y := Sqrt (X); |
Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 1"); |
when others => |
Report.Failed ("exception in test 1"); |
end; |
|
--- test 2 --- |
declare |
T : constant := (Real'Model_EMin + 1) / 2; |
X : constant := (1.0 * Real'Machine_Radix) ** (2 * T); |
Expected : constant := (1.0 * Real'Machine_Radix) ** T; |
Y : Real; |
begin |
Y := Sqrt (X); |
Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 2"); |
when others => |
Report.Failed ("exception in test 2"); |
end; |
|
--- test 3 --- |
declare |
X : constant := 1.0; |
Expected : constant := 1.0; |
Y : Real; |
begin |
Y := Sqrt(X); |
Check (Y, Expected, "test 3 -- sqrt(1.0)", |
0.0); -- no error allowed |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 3"); |
when others => |
Report.Failed ("exception in test 3"); |
end; |
|
--- test 4 --- |
declare |
X : constant := 0.0; |
Expected : constant := 0.0; |
Y : Real; |
begin |
Y := Sqrt(X); |
Check (Y, Expected, "test 4 -- sqrt(0.0)", |
0.0); -- no error allowed |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 4"); |
when others => |
Report.Failed ("exception in test 4"); |
end; |
|
--- test 5 --- |
declare |
X : constant := -1.0; |
Y : Real; |
begin |
Y := Sqrt(X); |
-- the following code should not be executed. |
-- The call to Check is to keep the call to Sqrt from |
-- appearing to be dead code. |
Check (Y, -1.0, "test 5 -- sqrt(-1)" ); |
Report.Failed ("test 5 - argument_error expected"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 5"); |
when Ada.Numerics.Argument_Error => |
if Verbose then |
Report.Comment ("test 5 correctly got argument_error"); |
end if; |
when others => |
Report.Failed ("exception in test 5"); |
end; |
|
--- test 6 --- |
declare |
X : constant := Ada.Numerics.Pi ** 2; |
Expected : constant := Ada.Numerics.Pi; |
Y : Real; |
begin |
Y := Sqrt (X); |
Check (Y, Expected, "test 6 -- sqrt(pi**2)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 6"); |
when others => |
Report.Failed ("exception in test 6"); |
end; |
|
--- test 7 & 8 --- |
Argument_Range_Check (1.0/Sqrt(Real(Real'Machine_Radix)), |
1.0, |
"7"); |
Argument_Range_Check (1.0, |
Sqrt(Real(Real'Machine_Radix)), |
"8"); |
end Do_Test; |
end A_Long_Float_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
package Non_Generic_Check is |
procedure Do_Test; |
end Non_Generic_Check; |
|
package body Non_Generic_Check is |
package EF renames |
Ada.Numerics.Elementary_Functions; |
subtype Real is Float; |
|
-- The default Maximum Relative Error is the value specified |
-- in the LRM. |
Default_MRE : constant Real := 2.0; |
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real := Default_MRE) 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 Argument_Range_Check (A, B : Float; |
Test : String) is |
-- test a logarithmically distributed selection of |
-- arguments selected from the range A to B. |
X : Float; |
Expected : Float; |
Y : Float; |
C : Float := EF.Log(B/A); |
Max_Samples : constant := 1000; |
|
begin |
for I in 1..Max_Samples loop |
Expected := A * EF.Exp(C * Float (I) / Float (Max_Samples)); |
X := Expected * Expected; |
Y := EF.Sqrt (X); |
|
-- note that since the expected value is computed, we |
-- must take the error in that computation into account. |
Check (Y, Expected, |
"test " & Test & " -" & |
Integer'Image (I) & |
" of argument range", |
3.0); |
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in argument range check"); |
when others => |
Report.Failed ("exception in argument range check"); |
end Argument_Range_Check; |
|
|
procedure Do_Test is |
begin |
|
--- test 1 --- |
declare |
T : constant := (Float'Machine_EMax - 1) / 2; |
X : constant := (1.0 * Float'Machine_Radix) ** (2 * T); |
Expected : constant := (1.0 * Float'Machine_Radix) ** T; |
Y : Float; |
begin |
Y := EF.Sqrt (X); |
Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 1"); |
when others => |
Report.Failed ("exception in test 1"); |
end; |
|
--- test 2 --- |
declare |
T : constant := (Float'Model_EMin + 1) / 2; |
X : constant := (1.0 * Float'Machine_Radix) ** (2 * T); |
Expected : constant := (1.0 * Float'Machine_Radix) ** T; |
Y : Float; |
begin |
Y := EF.Sqrt (X); |
Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 2"); |
when others => |
Report.Failed ("exception in test 2"); |
end; |
|
--- test 3 --- |
declare |
X : constant := 1.0; |
Expected : constant := 1.0; |
Y : Float; |
begin |
Y := EF.Sqrt(X); |
Check (Y, Expected, "test 3 -- sqrt(1.0)", |
0.0); -- no error allowed |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 3"); |
when others => |
Report.Failed ("exception in test 3"); |
end; |
|
--- test 4 --- |
declare |
X : constant := 0.0; |
Expected : constant := 0.0; |
Y : Float; |
begin |
Y := EF.Sqrt(X); |
Check (Y, Expected, "test 4 -- sqrt(0.0)", |
0.0); -- no error allowed |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 4"); |
when others => |
Report.Failed ("exception in test 4"); |
end; |
|
--- test 5 --- |
declare |
X : constant := -1.0; |
Y : Float; |
begin |
Y := EF.Sqrt(X); |
-- the following code should not be executed. |
-- The call to Check is to keep the call to Sqrt from |
-- appearing to be dead code. |
Check (Y, -1.0, "test 5 -- sqrt(-1)" ); |
Report.Failed ("test 5 - argument_error expected"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 5"); |
when Ada.Numerics.Argument_Error => |
if Verbose then |
Report.Comment ("test 5 correctly got argument_error"); |
end if; |
when others => |
Report.Failed ("exception in test 5"); |
end; |
|
--- test 6 --- |
declare |
X : constant := Ada.Numerics.Pi ** 2; |
Expected : constant := Ada.Numerics.Pi; |
Y : Float; |
begin |
Y := EF.Sqrt (X); |
Check (Y, Expected, "test 6 -- sqrt(pi**2)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 6"); |
when others => |
Report.Failed ("exception in test 6"); |
end; |
|
--- test 7 & 8 --- |
Argument_Range_Check (1.0/EF.Sqrt(Float(Float'Machine_Radix)), |
1.0, |
"7"); |
Argument_Range_Check (1.0, |
EF.Sqrt(Float(Float'Machine_Radix)), |
"8"); |
end Do_Test; |
end Non_Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
begin |
Report.Test ("CXG2003", |
"Check the accuracy of the sqrt function"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking non-generic package"); |
end if; |
|
Non_Generic_Check.Do_Test; |
|
Report.Result; |
end CXG2003; |
/cxg2022.a
0,0 → 1,309
-- CXG2022.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 multiplication and division of binary fixed point |
-- numbers with compatible 'small values produce exact results. |
-- |
-- TEST DESCRIPTION: |
-- Signed, unsigned, and a mixture of signed and unsigned |
-- binary fixed point values are multiplied and divided. |
-- The result is checked against the expected "perfect result set" |
-- |
-- 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: |
-- 1 Apr 96 SAIC Initial release for 2.1 |
-- 29 Jan 1998 EDS Repaired fixed point errors ("**" and |
-- assumptions about 'Small) |
--! |
|
with System; |
with Report; |
procedure CXG2022 is |
Verbose : constant Boolean := False; |
|
procedure Check_Signed is |
type Pairs is delta 2.0 range -2.0 ** (System.Max_Mantissa) .. |
2.0 ** (System.Max_Mantissa) - 1.0; |
type Halves is delta 0.5 range -2.0 ** (System.Max_Mantissa-2) .. |
2.0 ** (System.Max_Mantissa-2) - 1.0; |
P1, P2, P3, P4 : Pairs; |
H1, H2, H3, H4 : Halves; |
|
procedure Dont_Opt is |
-- keep optimizer from knowing the constant value of expressions |
begin |
if Report.Ident_Bool (False) then |
P1 := 2.0; P2 := 4.0; P3 := 6.0; |
H1 := -2.0; H2 := 9.0; H3 := 3.0; |
end if; |
end Dont_Opt; |
|
begin |
H1 := -0.5; |
H2 := Halves'First; |
H3 := 1.0; |
P1 := 12.0; |
P2 := Pairs'First; |
P3 := Pairs'Last; |
Dont_Opt; |
|
P4 := Pairs (P1 * H1); -- 12.0 * -0.5 |
if P4 /= -6.0 then |
Report.Failed ("12.0 * -0.5 = " & Pairs'Image (P4)); |
end if; |
|
H4 := Halves (P1 / H1); -- 12.0 / -0.5 |
if H4 /= -24.0 then |
Report.Failed ("12.0 / -0.5 = " & Halves'Image (H4)); |
end if; |
|
P4 := P3 * H3; -- Pairs'Last * 1.0 |
if P4 /= Pairs'Last then |
Report.Failed ("Pairs'Last * 1.0 = " & Pairs'Image (P4)); |
end if; |
|
P4 := P3 / H3; -- Pairs'Last / 1.0 |
if P4 /= Pairs'Last then |
Report.Failed ("Pairs'Last / 1.0 = " & Pairs'Image (P4)); |
end if; |
|
P4 := P2 * 0.25; -- Pairs'First * 0.25 |
if P4 /= Pairs (-2.0 ** (System.Max_Mantissa - 2)) then |
Report.Failed ("Pairs'First * 0.25 = " & Pairs'Image (P4)); |
end if; |
|
P4 := 100.5 / H1; -- 100.5 / -0.5 |
if P4 = -201.0 then |
null; -- Perfect result |
elsif Pairs'Small = 2.0 and ( P4 = -200.0 or P4 = -202.0 ) then |
null; -- Allowed variation |
else |
Report.Failed ("Pairs'Small =" & Pairs'Image (Pairs'Small) & |
" and 100.5/-0.5 = " & Pairs'Image (P4) ); |
end if; |
|
H4 := H1 * H2; -- -0.5 * Halves'First |
if H4 /= Halves (2.0 ** (System.Max_Mantissa-3)) then |
Report.Failed ("-0.5 * Halves'First =" & Halves'Image (H4) & |
" instead of " & |
Halves'Image( Halves(2.0 ** (System.Max_Mantissa-3)))); |
end if; |
|
exception |
when others => |
Report.Failed ("unexpected exception in Check_Signed"); |
end Check_Signed; |
|
|
|
procedure Check_Unsigned is |
type Pairs is delta 2.0 range 0.0 .. 2.0 ** (System.Max_Mantissa+1) - 1.0; |
type Halves is delta 0.5 range 0.0 .. 2.0 ** (System.Max_Mantissa-1) - 1.0; |
P1, P2, P3, P4 : Pairs; |
H1, H2, H3, H4 : Halves; |
|
procedure Dont_Opt is |
-- keep optimizer from knowing the constant value of expressions |
begin |
if Report.Ident_Bool (False) then |
P1 := 2.0; P2 := 4.0; P3 := 6.0; |
H1 := 2.0; H2 := 9.0; H3 := 3.0; |
end if; |
end Dont_Opt; |
|
begin |
H1 := 10.5; |
H2 := Halves(2.0 ** (System.Max_Mantissa - 6)); |
H3 := 1.0; |
P1 := 12.0; |
P2 := Pairs'Last / 2; |
P3 := Pairs'Last; |
Dont_Opt; |
|
P4 := Pairs (P1 * H1); -- 12.0 * 10.5 |
if P4 /= 126.0 then |
Report.Failed ("12.0 * 10.5 = " & Pairs'Image (P4)); |
end if; |
|
H4 := Halves (P1 / H1); -- 12.0 / 10.5 |
if H4 /= 1.0 and H4 /= 1.5 then |
Report.Failed ("12.0 / 10.5 = " & Halves'Image (H4)); |
end if; |
|
P4 := P3 * H3; -- Pairs'Last * 1.0 |
if P4 /= Pairs'Last then |
Report.Failed ("Pairs'Last * 1.0 = " & Pairs'Image (P4)); |
end if; |
|
P4 := P3 / H3; -- Pairs'Last / 1.0 |
if P4 /= Pairs'Last then |
Report.Failed ("Pairs'Last / 1.0 = " & Pairs'Image (P4)); |
end if; |
|
P4 := P1 * 0.25; -- 12.0 * 0.25 |
if P4 /= 2.0 and P4 /= 4.0 then |
Report.Failed ("12.0 * 0.25 = " & Pairs'Image (P4)); |
end if; |
|
P4 := 100.5 / H1; -- 100.5 / 10.5 = 9.571... |
if P4 /= 8.0 and P4 /= 10.0 then |
Report.Failed ("100.5/10.5 = " & Pairs'Image (P4)); |
end if; |
|
H4 := H2 * 2; -- 2**(max_mantissa-6) * 2 |
if H4 /= Halves(2.0 ** (System.Max_Mantissa-5)) then |
Report.Failed ("2**(System.Max_Mantissa-6) * 2=" & Halves'Image (H4) & |
" instead of " & |
Halves'Image( Halves(2.0 ** (System.Max_Mantissa-5)))); |
end if; |
|
exception |
when others => |
Report.Failed ("unexpected exception in Check_Unsigned"); |
end Check_Unsigned; |
|
|
|
procedure Check_Mixed is |
type Pairs is delta 2.0 range -2.0 ** (System.Max_Mantissa) .. |
2.0 ** (System.Max_Mantissa) - 1.0; |
type Halves is delta 0.5 range 0.0 .. 2.0 ** (System.Max_Mantissa-1) - 1.0; |
P1, P2, P3, P4 : Pairs; |
H1, H2, H3, H4 : Halves; |
|
procedure Dont_Opt is |
-- keep optimizer from knowing the constant value of expressions |
begin |
if Report.Ident_Bool (False) then |
P1 := 2.0; P2 := 4.0; P3 := 6.0; |
H1 := 2.0; H2 := 9.0; H3 := 3.0; |
end if; |
end Dont_Opt; |
|
begin |
H1 := 10.5; |
H2 := Halves(2.0 ** (System.Max_Mantissa - 6)); |
H3 := 1.0; |
P1 := 12.0; |
P2 := -4.0; |
P3 := Pairs'Last; |
Dont_Opt; |
|
P4 := Pairs (P1 * H1); -- 12.0 * 10.5 |
if P4 /= 126.0 then |
Report.Failed ("12.0 * 10.5 = " & Pairs'Image (P4)); |
end if; |
|
H4 := Halves (P1 / H1); -- 12.0 / 10.5 |
if H4 /= 1.0 and H4 /= 1.5 then |
Report.Failed ("12.0 / 10.5 = " & Halves'Image (H4)); |
end if; |
|
P4 := P3 * H3; -- Pairs'Last * 1.0 |
if P4 /= Pairs'Last then |
Report.Failed ("Pairs'Last * 1.0 = " & Pairs'Image (P4)); |
end if; |
|
P4 := P3 / H3; -- Pairs'Last / 1.0 |
if P4 /= Pairs'Last then |
Report.Failed ("Pairs'Last / 1.0 = " & Pairs'Image (P4)); |
end if; |
|
P4 := P1 * 0.25; -- 12.0 * 0.25 |
if P4 = 3.0 then |
null; -- Perfect result |
elsif Pairs'Small = 2.0 and then ( P4 = 2.0 or P4 = 4.0 ) then |
null; -- Allowed deviation |
else |
Report.Failed ("Pairs'Small =" & Pairs'Image (Pairs'Small) & |
"and 12.0 * 0.25 = " & Pairs'Image (P4) ); |
end if; |
|
P4 := 100.5 / H1; -- 100.5 / 10.5 = 9.571... |
if P4 = 9.0 then |
null; -- Perfect result |
elsif Pairs'Small = 2.0 and then ( P4 = 8.0 or P4 = 10.0 ) then |
null; -- Allowed values |
else |
Report.Failed ("Pairs'Small =" & Pairs'Image (Pairs'Small) & |
"and 100.5/10.5 = " & Pairs'Image (P4) ); |
end if; |
|
H4 := H2 * 2; -- 2**(max_mantissa-6) * 2 |
if H4 /= Halves(2.0 ** (System.Max_Mantissa-5)) then |
Report.Failed ("2**(System.Max_Mantissa-6) * 2=" & Halves'Image (H4) & |
" instead of " & |
Halves'Image( Halves(2.0 ** (System.Max_Mantissa-5)))); |
end if; |
|
P4 := Pairs(P1 * 6) / P2; -- 12 * 6 / -4 |
if (P4 /= -18.0) then |
Report.Failed ("12*6/-4 = " & Pairs'Image(P4)); |
end if; |
|
P4 := Halves(P1 * 6.0) / P2; -- 12 * 6 / -4 |
if (P4 /= -18.0) then |
Report.Failed ("Halves(12*6)/-4 = " & Pairs'Image(P4)); |
end if; |
|
exception |
when others => |
Report.Failed ("unexpected exception in Check_Mixed"); |
end Check_Mixed; |
|
|
begin -- main |
Report.Test ("CXG2022", |
"Check the accuracy of multiplication and division" & |
" of binary fixed point numbers"); |
if Verbose then |
Report.Comment ("starting signed test"); |
end if; |
Check_Signed; |
|
if Verbose then |
Report.Comment ("starting unsigned test"); |
end if; |
Check_Unsigned; |
|
if Verbose then |
Report.Comment ("starting mixed sign test"); |
end if; |
Check_Mixed; |
|
Report.Result; |
end CXG2022; |
/cxg2013.a
0,0 → 1,367
-- CXG2013.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 TAN and COT functions return |
-- results that are within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test consists of a generic package that is |
-- instantiated to check both Float and a long float type. |
-- The test for each floating point type is divided into |
-- several parts: |
-- Special value checks where the result is a known constant. |
-- Checks that use an identity for determining the result. |
-- Exception checks. |
-- |
-- 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: |
-- 11 Mar 96 SAIC Initial release for 2.1 |
-- 17 Aug 96 SAIC Commentary fixes. |
-- 03 Feb 97 PWB.CTA Removed checks with explicit Cycle => 2.0*Pi |
-- 02 DEC 97 EDS Change Max_Samples constant to 1001. |
-- 29 JUN 98 EDS Deleted Special_Angle_Test as fatally flawed. |
|
--! |
|
-- |
-- References: |
-- |
-- Software Manual for the Elementary Functions |
-- William J. Cody, Jr. and William Waite |
-- Prentice-Hall, 1980 |
-- |
-- CRC Standard Mathematical Tables |
-- 23rd Edition |
-- |
-- Implementation and Testing of Function Software |
-- W. J. Cody |
-- 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 Ada.Numerics.Generic_Elementary_Functions; |
procedure CXG2013 is |
Verbose : constant Boolean := False; |
Max_Samples : constant := 1001; |
|
-- 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 Elementary_Functions is new |
Ada.Numerics.Generic_Elementary_Functions (Real); |
function Sqrt (X : Real) return Real renames |
Elementary_Functions.Sqrt; |
function Tan (X : Real) return Real renames |
Elementary_Functions.Tan; |
function Cot (X : Real) return Real renames |
Elementary_Functions.Cot; |
function Tan (X, Cycle : Real) return Real renames |
Elementary_Functions.Tan; |
function Cot (X, Cycle : Real) return Real renames |
Elementary_Functions.Cot; |
|
-- flag used to terminate some tests early |
Accuracy_Error_Reported : Boolean := False; |
|
-- factor to be applied in computing MRE |
Maximum_Relative_Error : constant Real := 4.0; |
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real) is |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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 |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & 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 Exact_Result_Test is |
No_Error : constant := 0.0; |
begin |
-- A.5.1(38);6.0 |
Check (Tan (0.0), 0.0, "tan(0)", No_Error); |
|
-- A.5.1(41);6.0 |
Check (Tan (180.0, 360.0), 0.0, "tan(180,360)", No_Error); |
Check (Tan (360.0, 360.0), 0.0, "tan(360,360)", No_Error); |
Check (Tan (720.0, 360.0), 0.0, "tan(720,360)", No_Error); |
|
-- A.5.1(41);6.0 |
Check (Cot ( 90.0, 360.0), 0.0, "cot( 90,360)", No_Error); |
Check (Cot (270.0, 360.0), 0.0, "cot(270,360)", No_Error); |
Check (Cot (810.0, 360.0), 0.0, "cot(810,360)", No_Error); |
|
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in Exact_Result Test"); |
when others => |
Report.Failed ("exception in Exact_Result Test"); |
end Exact_Result_Test; |
|
|
procedure Tan_Test (A, B : Real) is |
-- Use identity Tan(X) = [2*Tan(x/2)]/[1-Tan(x/2) ** 2] |
-- checks over the range -pi/4 .. pi/4 require no argument reduction |
-- checks over the range 7pi/8 .. 9pi/8 require argument reduction |
X, Y : Real; |
Actual1, Actual2 : Real; |
begin |
Accuracy_Error_Reported := False; -- reset |
for I in 1..Max_Samples loop |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
-- argument purification to insure x and x/2 are exact |
-- See Cody page 170. |
Y := Real'Machine (X*0.5); |
X := Real'Machine (Y + Y); |
|
Actual1 := Tan(X); |
Actual2 := (2.0 * Tan (Y)) / (1.0 - Tan (Y) ** 2); |
|
if abs (X - Pi) > ( (B-A)/Real(2*Max_Samples) ) then |
Check (Actual1, Actual2, |
"Tan_Test " & Integer'Image (I) & ": tan(" & |
Real'Image (X) & ") ", |
(1.0 + Sqrt2) * Maximum_Relative_Error); |
-- see Cody pg 165 for error bound info |
end if; |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
|
end loop; |
|
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Tan_Test"); |
when others => |
Report.Failed ("exception in Tan_Test"); |
end Tan_Test; |
|
|
|
procedure Cot_Test is |
-- Use identity Cot(X) = [Cot(X/2)**2 - 1]/[2*Cot(X/2)] |
A : constant := 6.0 * Pi; |
B : constant := 25.0 / 4.0 * Pi; |
X, Y : Real; |
Actual1, Actual2 : Real; |
begin |
Accuracy_Error_Reported := False; -- reset |
for I in 1..Max_Samples loop |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
-- argument purification to insure x and x/2 are exact. |
-- See Cody page 170. |
Y := Real'Machine (X*0.5); |
X := Real'Machine (Y + Y); |
|
Actual1 := Cot(X); |
Actual2 := (Cot (Y) ** 2 - 1.0) / (2.0 * Cot (Y)); |
|
Check (Actual1, Actual2, |
"Cot_Test " & Integer'Image (I) & ": cot(" & |
Real'Image (X) & ") ", |
(1.0 + Sqrt2) * Maximum_Relative_Error); |
-- see Cody pg 165 for error bound info |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
|
end loop; |
|
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Cot_Test"); |
when others => |
Report.Failed ("exception in Cot_Test"); |
end Cot_Test; |
|
|
procedure Exception_Test is |
X1, X2, X3, X4, X5 : Real := 0.0; |
begin |
|
|
begin -- A.5.1(20);6.0 |
X1 := Tan (0.0, 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 -- A.5.1(20);6.0 |
X2 := Cot (1.0, 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; |
|
-- the remaining tests only apply to machines that overflow |
if Real'Machine_Overflows then -- A.5.1(28);6.0 |
|
begin -- A.5.1(29);6.0 |
X3 := Cot (0.0); |
Report.Failed ("exception not raised for cot(0)"); |
exception |
when Constraint_Error => null; -- ok |
when others => |
Report.Failed ("wrong exception raised for cot(0)"); |
end; |
|
begin -- A.5.1(31);6.0 |
X4 := Tan (90.0, 360.0); |
Report.Failed ("exception not raised for tan(90,360)"); |
exception |
when Constraint_Error => null; -- ok |
when others => |
Report.Failed ("wrong exception raised for tan(90,360)"); |
end; |
|
begin -- A.5.1(32);6.0 |
X5 := Cot (180.0, 360.0); |
Report.Failed ("exception not raised for cot(180,360)"); |
exception |
when Constraint_Error => null; -- ok |
when others => |
Report.Failed ("wrong exception raised for cot(180,360)"); |
end; |
end if; |
|
-- optimizer thwarting |
if Report.Ident_Bool (False) then |
Report.Comment (Real'Image (X1+X2+X3+X4+X5)); |
end if; |
end Exception_Test; |
|
|
procedure Do_Test is |
begin |
Exact_Result_Test; |
Tan_Test (-Pi/4.0, Pi/4.0); |
Tan_Test (7.0*Pi/8.0, 9.0*Pi/8.0); |
Cot_Test; |
Exception_Test; |
end Do_Test; |
end Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
package Float_Check is new Generic_Check (Float); |
|
-- check the floating point type with the most digits |
type A_Long_Float is digits System.Max_Digits; |
package A_Long_Float_Check is new Generic_Check (A_Long_Float); |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
|
begin |
Report.Test ("CXG2013", |
"Check the accuracy of the TAN and COT functions"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
|
Report.Result; |
end CXG2013; |
/cxg1005.a
0,0 → 1,393
-- CXG1005.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 subprograms defined in the package |
-- Ada.Numerics.Generic_Complex_Elementary_Functions provide correct |
-- results. |
-- |
-- TEST DESCRIPTION: |
-- This test checks that specific subprograms defined in the generic |
-- package Generic_Complex_Elementary_Functions are available, and that |
-- they provide prescribed results given specific input values. |
-- The generic package Ada.Numerics.Generic_Complex_Types is instantiated |
-- with a real type (new Float). The resulting new package is used as |
-- the generic actual to package Complex_IO. |
-- |
-- SPECIAL REQUIREMENTS: |
-- Implementations for which Float'Signed_Zeros is True must provide |
-- a body for ImpDef.Annex_G.Negative_Zero which returns a negative |
-- zero. |
-- |
-- APPLICABILITY CRITERIA |
-- This test only applies to implementations that support the |
-- numerics annex. |
-- |
-- |
-- |
-- CHANGE HISTORY: |
-- 06 Dec 94 SAIC ACVC 2.0 |
-- 16 Nov 95 SAIC Corrected visibility problems for ACVC 2.0.1. |
-- 21 Feb 96 SAIC Incorporated new structure for package Impdef. |
-- 29 Sep 96 SAIC Incorporated reviewer comments. |
-- |
--! |
|
with Ada.Numerics.Generic_Complex_Types; |
with Ada.Numerics.Generic_Complex_Elementary_Functions; |
with ImpDef.Annex_G; |
with Report; |
|
procedure CXG1005 is |
begin |
|
Report.Test ("CXG1005", "Check that the subprograms defined in " & |
"the package Generic_Complex_Elementary_" & |
"Functions provide correct results"); |
|
Test_Block: |
declare |
|
type Real_Type is new Float; |
|
TC_Signed_Zeros : Boolean := Real_Type'Signed_Zeros; |
|
package Complex_Pack is new |
Ada.Numerics.Generic_Complex_Types(Real_Type); |
|
package CEF is |
new Ada.Numerics.Generic_Complex_Elementary_Functions(Complex_Pack); |
|
use Ada.Numerics, Complex_Pack, CEF; |
|
Complex_Zero : constant Complex := Compose_From_Cartesian( 0.0, 0.0); |
Plus_One : constant Complex := Compose_From_Cartesian( 1.0, 0.0); |
Minus_One : constant Complex := Compose_From_Cartesian(-1.0, 0.0); |
Plus_i : constant Complex := Compose_From_Cartesian(i); |
Minus_i : constant Complex := Compose_From_Cartesian(-i); |
|
Complex_Positive_Real : constant Complex := |
Compose_From_Cartesian(4.0, 2.0); |
Complex_Positive_Imaginary : constant Complex := |
Compose_From_Cartesian(3.0, 5.0); |
Complex_Negative_Real : constant Complex := |
Compose_From_Cartesian(-4.0, 2.0); |
Complex_Negative_Imaginary : constant Complex := |
Compose_From_Cartesian(3.0, -5.0); |
|
|
function A_Zero_Result (Z : Complex) return Boolean is |
begin |
return (Re(Z) = 0.0 and Im(Z) = 0.0); |
end A_Zero_Result; |
|
|
-- In order to evaluate complex elementary functions that are |
-- prescribed to return a "real" result (meaning that the imaginary |
-- component is zero), the Function A_Real_Result is defined. |
|
function A_Real_Result (Z : Complex) return Boolean is |
begin |
return Im(Z) = 0.0; |
end A_Real_Result; |
|
|
-- In order to evaluate complex elementary functions that are |
-- prescribed to return an "imaginary" result (meaning that the real |
-- component of the complex number is zero, and the imaginary |
-- component is non-zero), the Function An_Imaginary_Result is defined. |
|
function An_Imaginary_Result (Z : Complex) return Boolean is |
begin |
return (Re(Z) = 0.0 and Im(Z) /= 0.0); |
end An_Imaginary_Result; |
|
|
begin |
|
-- Check that when the input parameter value is zero, the following |
-- functions yield a zero result. |
|
if not A_Zero_Result( Sqrt(Complex_Zero) ) then |
Report.Failed("Non-zero result from Function Sqrt with zero input"); |
end if; |
|
if not A_Zero_Result( Sin(Complex_Zero) ) then |
Report.Failed("Non-zero result from Function Sin with zero input"); |
end if; |
|
if not A_Zero_Result( Arcsin(Complex_Zero) ) then |
Report.Failed("Non-zero result from Function Arcsin with zero " & |
"input"); |
end if; |
|
if not A_Zero_Result( Tan(Complex_Zero) ) then |
Report.Failed("Non-zero result from Function Tan with zero input"); |
end if; |
|
if not A_Zero_Result( Arctan(Complex_Zero) ) then |
Report.Failed("Non-zero result from Function Arctan with zero " & |
"input"); |
end if; |
|
if not A_Zero_Result( Sinh(Complex_Zero) ) then |
Report.Failed("Non-zero result from Function Sinh with zero input"); |
end if; |
|
if not A_Zero_Result( Arcsinh(Complex_Zero) ) then |
Report.Failed("Non-zero result from Function Arcsinh with zero " & |
"input"); |
end if; |
|
if not A_Zero_Result( Tanh(Complex_Zero) ) then |
Report.Failed("Non-zero result from Function Tanh with zero input"); |
end if; |
|
if not A_Zero_Result( Arctanh(Complex_Zero) ) then |
Report.Failed("Non-zero result from Function Arctanh with zero " & |
"input"); |
end if; |
|
|
-- Check that when the input parameter value is zero, the following |
-- functions yield a result of one. |
|
if Exp(Complex_Zero) /= Plus_One |
then |
Report.Failed("Non-zero result from Function Exp with zero input"); |
end if; |
|
if Cos(Complex_Zero) /= Plus_One |
then |
Report.Failed("Non-zero result from Function Cos with zero input"); |
end if; |
|
if Cosh(Complex_Zero) /= Plus_One |
then |
Report.Failed("Non-zero result from Function Cosh with zero input"); |
end if; |
|
|
-- Check that when the input parameter value is zero, the following |
-- functions yield a real result. |
|
if not A_Real_Result( Arccos(Complex_Zero) ) then |
Report.Failed("Non-real result from Function Arccos with zero input"); |
end if; |
|
if not A_Real_Result( Arccot(Complex_Zero) ) then |
Report.Failed("Non-real result from Function Arccot with zero input"); |
end if; |
|
|
-- Check that when the input parameter value is zero, the following |
-- functions yield an imaginary result. |
|
if not An_Imaginary_Result( Arccoth(Complex_Zero) ) then |
Report.Failed("Non-imaginary result from Function Arccoth with " & |
"zero input"); |
end if; |
|
|
-- Check that when the input parameter value is one, the Sqrt function |
-- yields a result of one. |
|
if Sqrt(Plus_One) /= Plus_One then |
Report.Failed("Incorrect result from Function Sqrt with input " & |
"value of one"); |
end if; |
|
|
-- Check that when the input parameter value is one, the following |
-- functions yield a result of zero. |
|
if not A_Zero_Result( Log(Plus_One) ) then |
Report.Failed("Non-zero result from Function Log with input " & |
"value of one"); |
end if; |
|
if not A_Zero_Result( Arccos(Plus_One) ) then |
Report.Failed("Non-zero result from Function Arccos with input " & |
"value of one"); |
end if; |
|
if not A_Zero_Result( Arccosh(Plus_One) ) then |
Report.Failed("Non-zero result from Function Arccosh with input " & |
"value of one"); |
end if; |
|
|
-- Check that when the input parameter value is one, the Arcsin |
-- function yields a real result. |
|
if not A_Real_Result( Arcsin(Plus_One) ) then |
Report.Failed("Non-real result from Function Arcsin with input " & |
"value of one"); |
end if; |
|
|
-- Check that when the input parameter value is minus one, the Sqrt |
-- function yields a result of "i", when the sign of the imaginary |
-- component of the input parameter is positive (and yields "-i", if |
-- the sign on the imaginary component is negative), and the |
-- Complex_Types.Real'Signed_Zeros attribute is True. |
|
if TC_Signed_Zeros then |
|
declare |
Minus_One_With_Pos_Zero_Im_Component : Complex := |
Compose_From_Cartesian(-1.0, +0.0); |
Minus_One_With_Neg_Zero_Im_Component : Complex := |
Compose_From_Cartesian |
(-1.0, Real_Type(ImpDef.Annex_G.Negative_Zero)); |
begin |
|
if Sqrt(Minus_One_With_Pos_Zero_Im_Component) /= Plus_i then |
Report.Failed("Incorrect result from Function Sqrt, when " & |
"input value is minus one with a positive " & |
"imaginary component, Signed_Zeros being True"); |
end if; |
|
if Sqrt(Minus_One_With_Neg_Zero_Im_Component) /= Minus_i then |
Report.Failed("Incorrect result from Function Sqrt, when " & |
"input value is minus one with a negative " & |
"imaginary component, Signed_Zeros being True"); |
end if; |
end; |
|
else -- Signed_Zeros is False. |
|
-- Check that when the input parameter value is minus one, the Sqrt |
-- function yields a result of "i", when the |
-- Complex_Types.Real'Signed_Zeros attribute is False. |
|
if Sqrt(Minus_One) /= Plus_i then |
Report.Failed("Incorrect result from Function Sqrt, when " & |
"input value is minus one, Signed_Zeros being " & |
"False"); |
end if; |
|
end if; |
|
|
-- Check that when the input parameter value is minus one, the Log |
-- function yields an imaginary result. |
|
if not An_Imaginary_Result( Log(Minus_One) ) then |
Report.Failed("Non-imaginary result from Function Log with a " & |
"minus one input value"); |
end if; |
|
-- Check that when the input parameter is minus one, the following |
-- functions yield a real result. |
|
if not A_Real_Result( Arcsin(Minus_One) ) then |
Report.Failed("Non-real result from Function Arcsin with a " & |
"minus one input value"); |
end if; |
|
if not A_Real_Result( Arccos(Minus_One) ) then |
Report.Failed("Non-real result from Function Arccos with a " & |
"minus one input value"); |
end if; |
|
|
-- Check that when the input parameter has a value of +i or -i, the |
-- Log function yields an imaginary result. |
|
if not An_Imaginary_Result( Log(Plus_i) ) then |
Report.Failed("Non-imaginary result from Function Log with an " & |
"input value of ""+i"""); |
end if; |
|
if not An_Imaginary_Result( Log(Minus_i) ) then |
Report.Failed("Non-imaginary result from Function Log with an " & |
"input value of ""-i"""); |
end if; |
|
|
-- Check that exponentiation by a zero exponent yields the value one. |
|
if "**"(Left => Compose_From_Cartesian(5.0, 3.0), |
Right => Complex_Zero) /= Plus_One or |
Complex_Negative_Real**0.0 /= Plus_One or |
15.0**Complex_Zero /= Plus_One |
then |
Report.Failed("Incorrect result from exponentiation with a zero " & |
"exponent"); |
end if; |
|
|
-- Check that exponentiation by a unit exponent yields the value of |
-- the left operand (as a complex value). |
-- Note: a "unit exponent" is considered the complex number (1.0, 0.0) |
|
if "**"(Complex_Negative_Real, Plus_One) /= |
Complex_Negative_Real or |
Complex_Negative_Imaginary**Plus_One /= |
Complex_Negative_Imaginary or |
4.0**Plus_One /= |
Compose_From_Cartesian(4.0, 0.0) |
then |
Report.Failed("Incorrect result from exponentiation with a unit " & |
"exponent"); |
end if; |
|
|
-- Check that exponentiation of the value one yields the value one. |
|
if "**"(Plus_One, Complex_Negative_Imaginary) /= Plus_One or |
Plus_One**9.0 /= Plus_One or |
1.0**Complex_Negative_Real /= Plus_One |
then |
Report.Failed("Incorrect result from exponentiation of the value " & |
"One"); |
end if; |
|
|
-- Check that exponentiation of the value zero yields the value zero. |
begin |
if not A_Zero_Result("**"(Complex_Zero, |
Complex_Positive_Imaginary)) or |
not A_Zero_Result(Complex_Zero**4.0) or |
not A_Zero_Result(0.0**Complex_Positive_Real) |
then |
Report.Failed("Incorrect result from exponentiation of the " & |
"value zero"); |
end if; |
exception |
when others => |
Report.Failed("Exception raised during the exponentiation of " & |
"the complex value zero"); |
end; |
|
|
exception |
when others => Report.Failed ("Exception raised in Test_Block"); |
end Test_Block; |
|
Report.Result; |
|
end CXG1005; |
/cxg2004.a
0,0 → 1,499
-- CXG2004.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 sin and cos functions return |
-- results that are within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test consists of a generic package that is |
-- instantiated to check both float and a long float type. |
-- The test for each floating point type is divided into |
-- the following parts: |
-- Special value checks where the result is a known constant. |
-- Checks using an identity relationship. |
-- |
-- 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: |
-- 13 FEB 96 SAIC Initial release for 2.1 |
-- 22 APR 96 SAIC Changed to generic implementation. |
-- 18 AUG 96 SAIC Improvements to commentary. |
-- 23 OCT 96 SAIC Exact results are not required unless the |
-- cycle is specified. |
-- 28 FEB 97 PWB.CTA Removed checks where cycle 2.0*Pi is specified |
-- 02 JUN 98 EDS Revised calculations to ensure that X is exactly |
-- three times Y per advice of numerics experts. |
-- |
-- 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 |
--! |
|
-- |
-- References: |
-- |
-- Software Manual for the Elementary Functions |
-- William J. Cody, Jr. and William Waite |
-- Prentice-Hall, 1980 |
-- |
-- CRC Standard Mathematical Tables |
-- 23rd Edition |
-- |
-- Implementation and Testing of Function Software |
-- W. J. Cody |
-- Problems and Methodologies in Mathematical Software Production |
-- editors P. C. Messina and A. Murli |
-- Lecture Notes in Computer Science Volume 142 |
-- Springer Verlag, 1982 |
-- |
-- The sin and cos checks are translated directly from |
-- the netlib FORTRAN code that was written by W. Cody. |
-- |
|
with System; |
with Report; |
with Ada.Numerics.Generic_Elementary_Functions; |
with Ada.Numerics.Elementary_Functions; |
procedure CXG2004 is |
Verbose : constant Boolean := False; |
Number_Samples : constant := 1000; |
|
-- 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 Elementary_Functions is new |
Ada.Numerics.Generic_Elementary_Functions (Real); |
|
function Sin (X : Real) return Real renames |
Elementary_Functions.Sin; |
function Cos (X : Real) return Real renames |
Elementary_Functions.Cos; |
function Sin (X, Cycle : Real) return Real renames |
Elementary_Functions.Sin; |
function Cos (X, Cycle : Real) return Real renames |
Elementary_Functions.Cos; |
|
Accuracy_Error_Reported : Boolean := False; |
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real) is |
Rel_Error, |
Abs_Error, |
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; |
|
|
-- in addition to the relative error checks we apply the |
-- criteria of G.2.4(16) |
if abs (Actual) > 1.0 then |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & " result > 1.0"); |
elsif abs (Actual - Expected) > Max_Error then |
Accuracy_Error_Reported := True; |
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 Sin_Check (A, B : Real; |
Arg_Range : String) is |
-- test a selection of |
-- arguments selected from the range A to B. |
-- |
-- This test uses the identity |
-- sin(x) = sin(x/3)*(3 - 4 * sin(x/3)**2) |
-- |
-- Note that in this test we must take into account the |
-- error in the calculation of the expected result so |
-- the maximum relative error is larger than the |
-- accuracy required by the ARM. |
|
X, Y, ZZ : Real; |
Actual, Expected : Real; |
MRE : Real; |
Ran : Real; |
begin |
Accuracy_Error_Reported := False; -- reset |
for I in 1 .. Number_Samples loop |
-- Evenly distributed selection of arguments |
Ran := Real (I) / Real (Number_Samples); |
|
-- make sure x and x/3 are both exactly representable |
-- on the machine. See "Implementation and Testing of |
-- Function Software" page 44. |
X := (B - A) * Ran + A; |
Y := Real'Leading_Part |
( X/3.0, |
Real'Machine_Mantissa - Real'Exponent (3.0) ); |
X := Y * 3.0; |
|
Actual := Sin (X); |
|
ZZ := Sin(Y); |
Expected := ZZ * (3.0 - 4.0 * ZZ * ZZ); |
|
-- note that since the expected value is computed, we |
-- must take the error in that computation into account. |
-- See Cody pp 139-141. |
MRE := 4.0; |
|
Check (Actual, Expected, |
"sin test of range" & Arg_Range & |
Integer'Image (I), |
MRE); |
exit when Accuracy_Error_Reported; |
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in sin check"); |
when others => |
Report.Failed ("exception in sin check"); |
end Sin_Check; |
|
|
|
procedure Cos_Check (A, B : Real; |
Arg_Range : String) is |
-- test a selection of |
-- arguments selected from the range A to B. |
-- |
-- This test uses the identity |
-- cos(x) = cos(x/3)*(4 * cos(x/3)**2 - 3) |
-- |
-- Note that in this test we must take into account the |
-- error in the calculation of the expected result so |
-- the maximum relative error is larger than the |
-- accuracy required by the ARM. |
|
X, Y, ZZ : Real; |
Actual, Expected : Real; |
MRE : Real; |
Ran : Real; |
begin |
Accuracy_Error_Reported := False; -- reset |
for I in 1 .. Number_Samples loop |
-- Evenly distributed selection of arguments |
Ran := Real (I) / Real (Number_Samples); |
|
-- make sure x and x/3 are both exactly representable |
-- on the machine. See "Implementation and Testing of |
-- Function Software" page 44. |
X := (B - A) * Ran + A; |
Y := Real'Leading_Part |
( X/3.0, |
Real'Machine_Mantissa - Real'Exponent (3.0) ); |
X := Y * 3.0; |
|
Actual := Cos (X); |
|
ZZ := Cos(Y); |
Expected := ZZ * (4.0 * ZZ * ZZ - 3.0); |
|
-- note that since the expected value is computed, we |
-- must take the error in that computation into account. |
-- See Cody pp 141-143. |
MRE := 6.0; |
|
Check (Actual, Expected, |
"cos test of range" & Arg_Range & |
Integer'Image (I), |
MRE); |
exit when Accuracy_Error_Reported; |
end loop; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in cos check"); |
when others => |
Report.Failed ("exception in cos check"); |
end Cos_Check; |
|
|
procedure Special_Angle_Checks is |
type Data_Point is |
record |
Degrees, |
Radians, |
Sine, |
Cosine : Real; |
Sin_Result_Error, |
Cos_Result_Error : Boolean; |
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 any loss of precision. However, |
-- there are two sources of error that must be accounted for |
-- in the following tests. |
-- First, when a cycle is not specified there can be a roundoff |
-- error in the value of Pi used. This error does not apply |
-- when a cycle of 2.0 * Pi is explicitly provided. |
-- Second, the expected results that involve sqrt values also |
-- have a potential roundoff error. |
-- The amount of error due to error in the argument is computed |
-- as follows: |
-- sin(x+err) = sin(x)*cos(err) + cos(x)*sin(err) |
-- ~= sin(x) + err * cos(x) |
-- similarly for cos the error due to error in the argument is |
-- computed as follows: |
-- cos(x+err) = cos(x)*cos(err) - sin(x)*sin(err) |
-- ~= cos(x) - err * sin(x) |
-- In both cases the term "err" is bounded by 0.5 * argument. |
|
Test_Data : constant Test_Data_Type := ( |
-- degrees radians sine cosine sin_er cos_er test # |
( 0.0, 0.0, 0.0, 1.0, False, False ), -- 1 |
( 30.0, Pi/6.0, 0.5, Sqrt3/2.0, False, True ), -- 2 |
( 60.0, Pi/3.0, Sqrt3/2.0, 0.5, True, False ), -- 3 |
( 90.0, Pi/2.0, 1.0, 0.0, False, False ), -- 4 |
(120.0, 2.0*Pi/3.0, Sqrt3/2.0, -0.5, True, False ), -- 5 |
(150.0, 5.0*Pi/6.0, 0.5, -Sqrt3/2.0, False, True ), -- 6 |
(180.0, Pi, 0.0, -1.0, False, False ), -- 7 |
(210.0, 7.0*Pi/6.0, -0.5, -Sqrt3/2.0, False, True ), -- 8 |
(240.0, 8.0*Pi/6.0, -Sqrt3/2.0, -0.5, True, False ), -- 9 |
(270.0, 9.0*Pi/6.0, -1.0, 0.0, False, False ), -- 10 |
(300.0, 10.0*Pi/6.0, -Sqrt3/2.0, 0.5, True, False ), -- 11 |
(330.0, 11.0*Pi/6.0, -0.5, Sqrt3/2.0, False, True ), -- 12 |
(360.0, 2.0*Pi, 0.0, 1.0, False, False ), -- 13 |
( 45.0, Pi/4.0, Sqrt2/2.0, Sqrt2/2.0, True, True ), -- 14 |
(135.0, 3.0*Pi/4.0, Sqrt2/2.0, -Sqrt2/2.0, True, True ), -- 15 |
(225.0, 5.0*Pi/4.0, -Sqrt2/2.0, -Sqrt2/2.0, True, True ), -- 16 |
(315.0, 7.0*Pi/4.0, -Sqrt2/2.0, Sqrt2/2.0, True, True ), -- 17 |
(405.0, 9.0*Pi/4.0, Sqrt2/2.0, Sqrt2/2.0, True, True ) ); -- 18 |
|
|
Y : Real; |
Sin_Arg_Err, |
Cos_Arg_Err, |
Sin_Result_Err, |
Cos_Result_Err : Real; |
begin |
for I in Test_Data'Range loop |
-- compute error components |
Sin_Arg_Err := abs Test_Data (I).Cosine * |
abs Test_Data (I).Radians / 2.0; |
Cos_Arg_Err := abs Test_Data (I).Sine * |
abs Test_Data (I).Radians / 2.0; |
|
if Test_Data (I).Sin_Result_Error then |
Sin_Result_Err := 0.5; |
else |
Sin_Result_Err := 0.0; |
end if; |
|
if Test_Data (I).Cos_Result_Error then |
Cos_Result_Err := 1.0; |
else |
Cos_Result_Err := 0.0; |
end if; |
|
|
|
Y := Sin (Test_Data (I).Radians); |
Check (Y, Test_Data (I).Sine, |
"test" & Integer'Image (I) & " sin(r)", |
2.0 + Sin_Arg_Err + Sin_Result_Err); |
Y := Cos (Test_Data (I).Radians); |
Check (Y, Test_Data (I).Cosine, |
"test" & Integer'Image (I) & " cos(r)", |
2.0 + Cos_Arg_Err + Cos_Result_Err); |
Y := Sin (Test_Data (I).Degrees, 360.0); |
Check (Y, Test_Data (I).Sine, |
"test" & Integer'Image (I) & " sin(d,360)", |
2.0 + Sin_Result_Err); |
Y := Cos (Test_Data (I).Degrees, 360.0); |
Check (Y, Test_Data (I).Cosine, |
"test" & Integer'Image (I) & " cos(d,360)", |
2.0 + Cos_Result_Err); |
--pwb-math Y := Sin (Test_Data (I).Radians, 2.0*Pi); |
--pwb-math Check (Y, Test_Data (I).Sine, |
--pwb-math "test" & Integer'Image (I) & " sin(r,2pi)", |
--pwb-math 2.0 + Sin_Result_Err); |
--pwb-math Y := Cos (Test_Data (I).Radians, 2.0*Pi); |
--pwb-math Check (Y, Test_Data (I).Cosine, |
--pwb-math "test" & Integer'Image (I) & " cos(r,2pi)", |
--pwb-math 2.0 + Cos_Result_Err); |
end loop; |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in special angle test"); |
when others => |
Report.Failed ("exception in special angle test"); |
end Special_Angle_Checks; |
|
|
-- check the rule of A.5.1(41);6.0 which requires that the |
-- result be exact if the mathematical result is 0.0, 1.0, |
-- or -1.0 |
procedure Exact_Result_Checks is |
type Data_Point is |
record |
Degrees, |
Sine, |
Cosine : Real; |
end record; |
|
type Test_Data_Type is array (Positive range <>) of Data_Point; |
Test_Data : constant Test_Data_Type := ( |
-- degrees sine cosine test # |
( 0.0, 0.0, 1.0 ), -- 1 |
( 90.0, 1.0, 0.0 ), -- 2 |
(180.0, 0.0, -1.0 ), -- 3 |
(270.0, -1.0, 0.0 ), -- 4 |
(360.0, 0.0, 1.0 ), -- 5 |
( 90.0 + 360.0, 1.0, 0.0 ), -- 6 |
(180.0 + 360.0, 0.0, -1.0 ), -- 7 |
(270.0 + 360.0,-1.0, 0.0 ), -- 8 |
(360.0 + 360.0, 0.0, 1.0 ) ); -- 9 |
|
Y : Real; |
begin |
for I in Test_Data'Range loop |
Y := Sin (Test_Data(I).Degrees, 360.0); |
if Y /= Test_Data(I).Sine then |
Report.Failed ("exact result for sin(" & |
Real'Image (Test_Data(I).Degrees) & |
", 360.0) is not" & |
Real'Image (Test_Data(I).Sine) & |
" Difference is " & |
Real'Image (Y - Test_Data(I).Sine) ); |
end if; |
|
Y := Cos (Test_Data(I).Degrees, 360.0); |
if Y /= Test_Data(I).Cosine then |
Report.Failed ("exact result for cos(" & |
Real'Image (Test_Data(I).Degrees) & |
", 360.0) is not" & |
Real'Image (Test_Data(I).Cosine) & |
" Difference is " & |
Real'Image (Y - Test_Data(I).Cosine) ); |
end if; |
end loop; |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in exact result check"); |
when others => |
Report.Failed ("exception in exact result check"); |
end Exact_Result_Checks; |
|
|
procedure Do_Test is |
begin |
Special_Angle_Checks; |
Sin_Check (0.0, Pi/2.0, "0..pi/2"); |
Sin_Check (6.0*Pi, 6.5*Pi, "6pi..6.5pi"); |
Cos_Check (7.0*Pi, 7.5*Pi, "7pi..7.5pi"); |
Exact_Result_Checks; |
end Do_Test; |
end Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
package Float_Check is new Generic_Check (Float); |
|
-- check the floating point type with the most digits |
type A_Long_Float is digits System.Max_Digits; |
package A_Long_Float_Check is new Generic_Check (A_Long_Float); |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
|
begin |
Report.Test ("CXG2004", |
"Check the accuracy of the sin and cos functions"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
Report.Result; |
end CXG2004; |
/cxg2005.a
0,0 → 1,204
-- CXG2005.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 floating point addition and multiplication |
-- have the required accuracy. |
-- |
-- TEST DESCRIPTION: |
-- The check for the required precision is essentially a |
-- check that a guard digit is used for the operations. |
-- This test uses a generic package to check the addition |
-- and multiplication results. The |
-- generic package is instantiated with the standard FLOAT |
-- type and a floating point type for the maximum number |
-- of digits of precision. |
-- |
-- APPLICABILITY CRITERIA: |
-- This test applies only to implementations supporting the |
-- Numerics Annex. |
-- |
-- |
-- CHANGE HISTORY: |
-- 14 FEB 96 SAIC Initial Release for 2.1 |
-- 16 SEP 99 RLB Repaired to avoid printing thousands of (almost) |
-- identical failure messages. |
--! |
|
-- References: |
-- |
-- Basic Concepts for Computational Software |
-- W. J. Cody |
-- Problems and Methodologies in Mathematical Software Production |
-- editors P. C. Messina and A. Murli |
-- Lecture Notes in Computer Science Vol 142 |
-- Springer Verlag, 1982 |
-- |
-- Software Manual for the Elementary Functions |
-- William J. Cody and William Waite |
-- Prentice-Hall, 1980 |
-- |
|
with System; |
with Report; |
procedure CXG2005 is |
Verbose : constant Boolean := False; |
|
generic |
type Real is digits <>; |
package Guard_Digit_Check is |
procedure Do_Test; |
end Guard_Digit_Check; |
|
package body Guard_Digit_Check is |
-- made global so that the compiler will be more likely |
-- to keep the values in memory instead of in higher |
-- precision registers. |
X, Y, Z : Real; |
OneX : Real; |
Eps, BN : Real; |
|
-- special constants - not declared as constants so that |
-- the "stored" precision will be used instead of a "register" |
-- precision. |
Zero : Real := 0.0; |
One : Real := 1.0; |
Two : Real := 2.0; |
|
Failure_Count : Natural := 0; |
|
procedure Thwart_Optimization is |
-- the purpose of this procedure is to reference the |
-- global variables used by the test so |
-- that the compiler is not likely to keep them in |
-- a higher precision register for their entire lifetime. |
begin |
if Report.Ident_Bool (False) then |
-- never executed |
X := X + 5.0; |
Y := Y + 6.0; |
Z := Z + 1.0; |
Eps := Eps + 2.0; |
BN := BN + 2.0; |
OneX := X + Y; |
One := 12.34; Two := 56.78; Zero := 90.12; |
end if; |
end Thwart_Optimization; |
|
|
procedure Addition_Test is |
begin |
for K in 1..10 loop |
Eps := Real (K) * Real'Model_Epsilon; |
for N in 1.. Real'Machine_EMax - 1 loop |
BN := Real(Real'Machine_Radix) ** N; |
X := (One + Eps) * BN; |
Y := (One - Eps) * BN; |
Z := X - Y; -- true value for Z is 2*Eps*BN |
|
if Z /= Eps*BN + Eps*BN then |
Report.Failed ("addition check failed. K=" & |
Integer'Image (K) & |
" N=" & Integer'Image (N) & |
" difference=" & Real'Image (Z - 2.0*Eps*BN) & |
" Eps*BN=" & Real'Image (Eps*BN) ); |
Failure_Count := Failure_Count + 1; |
exit when Failure_Count > K*4; -- Avoid displaying dozens of messages. |
end if; |
end loop; |
end loop; |
exception |
when others => |
Thwart_Optimization; |
Report.Failed ("unexpected exception in addition test"); |
end Addition_Test; |
|
|
procedure Multiplication_Test is |
begin |
X := Real (Real'Machine_Radix) ** (Real'Machine_EMax - 1); |
OneX := One * X; |
Thwart_Optimization; |
if OneX /= X then |
Report.Failed ("multiplication for large values"); |
end if; |
|
X := Real (Real'Machine_Radix) ** (Real'Model_EMin + 1); |
OneX := One * X; |
Thwart_Optimization; |
if OneX /= X then |
Report.Failed ("multiplication for small values"); |
end if; |
|
-- selection of "random" values between 1/radix and radix |
Y := One / Real (Real'Machine_Radix); |
Z := Real(Real'Machine_Radix) - One/Real(Real'Machine_Radix); |
for I in 0..100 loop |
X := Y + Real (I) / 100.0 * Z; |
OneX := One * X; |
Thwart_Optimization; |
if OneX /= X then |
Report.Failed ("multiplication for case" & Integer'Image (I)); |
exit when Failure_Count > 40+8; -- Avoid displaying dozens of messages. |
end if; |
end loop; |
exception |
when others => |
Thwart_Optimization; |
Report.Failed ("unexpected exception in multiplication test"); |
end Multiplication_Test; |
|
|
procedure Do_Test is |
begin |
Addition_Test; |
Multiplication_Test; |
end Do_Test; |
end Guard_Digit_Check; |
|
package Chk_Float is new Guard_Digit_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 Guard_Digit_Check (A_Long_Float); |
begin |
Report.Test ("CXG2005", |
"Check the accuracy of floating point" & |
" addition and multiplication"); |
|
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 CXG2005; |
/cxg2014.a
0,0 → 1,399
-- CXG2014.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 SINH and COSH functions return |
-- results that are within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test consists of a generic package that is |
-- instantiated to check both Float and a long float type. |
-- The test for each floating point type is divided into |
-- several parts: |
-- Special value checks where the result is a known constant. |
-- Checks that use an identity for determining the result. |
-- Exception checks. |
-- |
-- 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 Mar 96 SAIC Initial release for 2.1 |
-- 03 Jun 98 EDS In line 80, change 1000 to 1024, making it a model |
-- number. Add Taylor Series terms in line 281. |
-- 15 Feb 99 RLB Repaired Subtraction_Error_Test to avoid precision |
-- problems. |
--! |
|
-- |
-- References: |
-- |
-- Software Manual for the Elementary Functions |
-- William J. Cody, Jr. and William Waite |
-- Prentice-Hall, 1980 |
-- |
-- CRC Standard Mathematical Tables |
-- 23rd Edition |
-- |
-- Implementation and Testing of Function Software |
-- W. J. Cody |
-- 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 Ada.Numerics.Generic_Elementary_Functions; |
procedure CXG2014 is |
Verbose : constant Boolean := False; |
Max_Samples : constant := 1024; |
|
E : constant := Ada.Numerics.E; |
Cosh1 : constant := (E + 1.0 / E) / 2.0; -- cosh(1.0) |
|
generic |
type Real is digits <>; |
package Generic_Check is |
procedure Do_Test; |
end Generic_Check; |
|
package body Generic_Check is |
package Elementary_Functions is new |
Ada.Numerics.Generic_Elementary_Functions (Real); |
function Sinh (X : Real) return Real renames |
Elementary_Functions.Sinh; |
function Cosh (X : Real) return Real renames |
Elementary_Functions.Cosh; |
function Log (X : Real) return Real renames |
Elementary_Functions.Log; |
|
-- flag used to terminate some tests early |
Accuracy_Error_Reported : Boolean := False; |
|
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real) is |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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_Small instead |
-- of Model_Epsilon and Expected. |
Rel_Error := MRE * abs Expected * Real'Model_Epsilon; |
Abs_Error := MRE * Real'Model_Small; |
if Rel_Error > Abs_Error then |
Max_Error := Rel_Error; |
else |
Max_Error := Abs_Error; |
end if; |
|
if abs (Actual - Expected) > Max_Error then |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & 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_Value_Test is |
-- In the following tests the expected result is accurate |
-- to the machine precision so the minimum guaranteed error |
-- bound can be used. |
Minimum_Error : constant := 8.0; |
begin |
Check (Sinh (1.0), |
(E - 1.0 / E) / 2.0, |
"sinh(1)", |
Minimum_Error); |
Check (Cosh (1.0), |
Cosh1, |
"cosh(1)", |
Minimum_Error); |
Check (Sinh (2.0), |
(E * E - (1.0 / (E * E))) / 2.0, |
"sinh(2)", |
Minimum_Error); |
Check (Cosh (2.0), |
(E * E + (1.0 / (E * E))) / 2.0, |
"cosh(2)", |
Minimum_Error); |
Check (Sinh (-1.0), |
(1.0 / E - E) / 2.0, |
"sinh(-1)", |
Minimum_Error); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in special value test"); |
when others => |
Report.Failed ("exception in special value test"); |
end Special_Value_Test; |
|
|
|
procedure Exact_Result_Test is |
No_Error : constant := 0.0; |
begin |
-- A.5.1(38);6.0 |
Check (Sinh (0.0), 0.0, "sinh(0)", No_Error); |
Check (Cosh (0.0), 1.0, "cosh(0)", No_Error); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in Exact_Result Test"); |
when others => |
Report.Failed ("exception in Exact_Result Test"); |
end Exact_Result_Test; |
|
|
procedure Identity_1_Test is |
-- For the Sinh test use the identity |
-- 2 * Sinh(x) * Cosh(1) = Sinh(x+1) + Sinh (x-1) |
-- which is transformed to |
-- Sinh(x) = ((Sinh(x+1) + Sinh(x-1)) * C |
-- where C = 1/(2*Cosh(1)) |
-- |
-- For the Cosh test use the identity |
-- 2 * Cosh(x) * Cosh(1) = Cosh(x+1) + Cosh(x-1) |
-- which is transformed to |
-- Cosh(x) = C * (Cosh(x+1) + Cosh(x-1)) |
-- where C is the same as above |
-- |
-- see Cody pg 230-231 for details on the error analysis. |
-- The net result is a relative error bound of 16 * Model_Epsilon. |
|
A : constant := 3.0; |
-- large upper bound but not so large as to cause Cosh(B) |
-- to overflow |
B : constant Real := Log(Real'Safe_Last) - 2.0; |
X_Minus_1, X, X_Plus_1 : Real; |
Actual1, Actual2 : Real; |
C : constant := 1.0 / (2.0 * Cosh1); |
begin |
Accuracy_Error_Reported := False; -- reset |
for I in 1..Max_Samples loop |
-- make sure there is no error in x-1, x, and x+1 |
X_Plus_1 := (B - A) * Real (I) / Real (Max_Samples) + A; |
X_Plus_1 := Real'Machine (X_Plus_1); |
X := Real'Machine (X_Plus_1 - 1.0); |
X_Minus_1 := Real'Machine (X - 1.0); |
|
-- Sinh(x) = ((Sinh(x+1) + Sinh(x-1)) * C |
Actual1 := Sinh(X); |
Actual2 := C * (Sinh(X_Plus_1) + Sinh(X_Minus_1)); |
|
Check (Actual1, Actual2, |
"Identity_1_Test " & Integer'Image (I) & ": sinh(" & |
Real'Image (X) & ") ", |
16.0); |
|
-- Cosh(x) = C * (Cosh(x+1) + Cosh(x-1)) |
Actual1 := Cosh (X); |
Actual2 := C * (Cosh(X_Plus_1) + Cosh (X_Minus_1)); |
Check (Actual1, Actual2, |
"Identity_1_Test " & Integer'Image (I) & ": cosh(" & |
Real'Image (X) & ") ", |
16.0); |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
|
end loop; |
|
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Identity_1_Test" & |
" for X=" & Real'Image (X)); |
when others => |
Report.Failed ("exception in Identity_1_Test" & |
" for X=" & Real'Image (X)); |
end Identity_1_Test; |
|
|
|
procedure Subtraction_Error_Test is |
-- This test detects the error resulting from subtraction if |
-- the obvious algorithm was used for computing sinh. That is, |
-- it it is computed as (e**x - e**-x)/2. |
-- We check the result by using a Taylor series expansion that |
-- will produce a result accurate to the machine precision for |
-- the range under test. |
-- |
-- The maximum relative error bound for this test is |
-- 8 for the sinh operation and 7 for the Taylor series |
-- for a total of 15 * Model_Epsilon |
A : constant := 0.0; |
B : constant := 0.5; |
X : Real; |
X_Squared : Real; |
Actual, Expected : Real; |
begin |
if Real'digits > 15 then |
return; -- The approximation below is not accurate beyond |
-- 15 digits. Adding more terms makes the error |
-- larger, so it makes the test worse for more normal |
-- values. Thus, we skip this subtest for larger than |
-- 15 digits. |
end if; |
Accuracy_Error_Reported := False; -- reset |
for I in 1..Max_Samples loop |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
X_Squared := X * X; |
|
Actual := Sinh(X); |
|
-- The Taylor series regrouped a bit |
Expected := |
X * (1.0 + (X_Squared / 6.0) * |
(1.0 + (X_Squared/20.0) * |
(1.0 + (X_Squared/42.0) * |
(1.0 + (X_Squared/72.0) * |
(1.0 + (X_Squared/110.0) * |
(1.0 + (X_Squared/156.0) |
)))))); |
|
Check (Actual, Expected, |
"Subtraction_Error_Test " & Integer'Image (I) & ": sinh(" & |
Real'Image (X) & ") ", |
15.0); |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
|
end loop; |
|
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Subtraction_Error_Test"); |
when others => |
Report.Failed ("exception in Subtraction_Error_Test"); |
end Subtraction_Error_Test; |
|
|
procedure Exception_Test is |
X1, X2 : Real := 0.0; |
begin |
-- this part of the test is only applicable if 'Machine_Overflows |
-- is true. |
if Real'Machine_Overflows then |
|
begin |
X1 := Sinh (Real'Safe_Last / 2.0); |
Report.Failed ("no exception for sinh overflow"); |
exception |
when Constraint_Error => null; |
when others => |
Report.Failed ("wrong exception sinh overflow"); |
end; |
|
begin |
X2 := Cosh (Real'Safe_Last / 2.0); |
Report.Failed ("no exception for cosh overflow"); |
exception |
when Constraint_Error => null; |
when others => |
Report.Failed ("wrong exception cosh overflow"); |
end; |
|
end if; |
|
-- optimizer thwarting |
if Report.Ident_Bool (False) then |
Report.Comment (Real'Image (X1 + X2)); |
end if; |
end Exception_Test; |
|
|
procedure Do_Test is |
begin |
Special_Value_Test; |
Exact_Result_Test; |
Identity_1_Test; |
Subtraction_Error_Test; |
Exception_Test; |
end Do_Test; |
end Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
package Float_Check is new Generic_Check (Float); |
|
-- check the floating point type with the most digits |
type A_Long_Float is digits System.Max_Digits; |
package A_Long_Float_Check is new Generic_Check (A_Long_Float); |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
|
begin |
Report.Test ("CXG2014", |
"Check the accuracy of the SINH and COSH functions"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
|
Report.Result; |
end CXG2014; |
/cxg2023.a
0,0 → 1,351
-- CXG2023.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 multiplication and division of decimal fixed point |
-- numbers produce exact results. |
-- |
-- TEST DESCRIPTION: |
-- Check that multiplication and division of decimal fixed point |
-- numbers produce exact results. |
-- |
-- 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. |
-- This test applies only to implementations supporting |
-- decimal fixed point types of at least 9 digits. |
-- |
-- |
-- CHANGE HISTORY: |
-- 3 Apr 96 SAIC Initial release for 2.1 |
-- |
--! |
|
with System; |
with Report; |
procedure CXG2023 is |
Verbose : constant Boolean := False; |
|
procedure Check_1 is |
Num_Digits : constant := 6; |
type Pennies is delta 0.01 digits Num_Digits; |
type Franklins is delta 100.0 digits Num_Digits; |
type Dollars is delta 1.0 digits Num_Digits; |
|
P1 : Pennies; |
F1 : Franklins; |
D1 : Dollars; |
|
-- optimization thwarting functions |
|
function P (X : Pennies) return Pennies is |
begin |
if Report.Ident_Bool (True) then |
return X; |
else |
return 3.21; -- never executed |
end if; |
end P; |
|
|
function F (X : Franklins) return Franklins is |
begin |
if Report.Ident_Bool (True) then |
return X; |
else |
return 32100.0; -- never executed |
end if; |
end F; |
|
|
function D (X : Dollars) return Dollars is |
begin |
if Report.Ident_Bool (True) then |
return X; |
else |
return 321.0; -- never executed |
end if; |
end D; |
|
|
begin |
-- multiplication where one operand is universal real |
|
P1 := P(0.05) * 200.0; |
if P1 /= 10.00 then |
Report.Failed ("1 - expected 10.00 got " & Pennies'Image (P1)); |
end if; |
|
D1 := P(0.05) * 100.0; |
if D1 /= 5.00 then |
Report.Failed ("2 - expected 5.00 got " & Dollars'Image (D1)); |
end if; |
|
F1 := P(0.05) * 50_000.0; |
if F1 /= 2500.00 then |
Report.Failed ("3 - expected 2500.0 got " & Franklins'Image (F1)); |
end if; |
|
-- multiplication where both operands are decimal fixed |
|
P1 := P(0.05) * D(-200.0); |
if P1 /= -10.00 then |
Report.Failed ("4 - expected -10.00 got " & Pennies'Image (P1)); |
end if; |
|
D1 := P(0.05) * P(-100.0); |
if D1 /= -5.00 then |
Report.Failed ("5 - expected -5.00 got " & Dollars'Image (D1)); |
end if; |
|
F1 := P(-0.05) * F(50_000.0); |
if F1 /= -2500.00 then |
Report.Failed ("6 - expected -2500.0 got " & Franklins'Image (F1)); |
end if; |
|
-- division where one operand is universal real |
|
P1 := P(0.05) / 0.001; |
if P1 /= 50.00 then |
Report.Failed ("7 - expected 50.00 got " & Pennies'Image (P1)); |
end if; |
|
D1 := D(1000.0) / 3.0; |
if D1 /= 333.00 then |
Report.Failed ("8 - expected 333.00 got " & Dollars'Image (D1)); |
end if; |
|
F1 := P(1234.56) / 0.0001; |
if F1 /= 12345600.00 then |
Report.Failed ("9 - expected 12345600.0 got " & Franklins'Image (F1)); |
end if; |
|
|
-- division where both operands are decimal fixed |
|
P1 := P(0.05) / D(1.0); |
if P1 /= 0.05 then |
Report.Failed ("10 - expected 0.05 got " & Pennies'Image (P1)); |
end if; |
|
-- check for truncation toward 0 |
D1 := P(-101.00) / P(2.0); |
if D1 /= -50.00 then |
Report.Failed ("11 - expected -50.00 got " & Dollars'Image (D1)); |
end if; |
|
P1 := P(-102.03) / P(-0.5); |
if P1 /= 204.06 then |
Report.Failed ("12 - expected 204.06 got " & Pennies'Image (P1)); |
end if; |
|
F1 := P(876.54) / P(0.03); |
if F1 /= 29200.00 then |
Report.Failed ("13 - expected 29200.0 got " & Franklins'Image (F1)); |
end if; |
|
exception |
when others => |
Report.Failed ("unexpected exception in Check_1"); |
end Check_1; |
|
generic |
type Pennies is delta<> digits<>; |
type Dollars is delta<> digits<>; |
type Franklins is delta<> digits<>; |
procedure Generic_Check; |
procedure Generic_Check is |
|
-- the following code is copied directly from the |
-- above procedure Check_1 |
|
P1 : Pennies; |
F1 : Franklins; |
D1 : Dollars; |
|
-- optimization thwarting functions |
|
function P (X : Pennies) return Pennies is |
begin |
if Report.Ident_Bool (True) then |
return X; |
else |
return 3.21; -- never executed |
end if; |
end P; |
|
|
function F (X : Franklins) return Franklins is |
begin |
if Report.Ident_Bool (True) then |
return X; |
else |
return 32100.0; -- never executed |
end if; |
end F; |
|
|
function D (X : Dollars) return Dollars is |
begin |
if Report.Ident_Bool (True) then |
return X; |
else |
return 321.0; -- never executed |
end if; |
end D; |
|
|
begin |
-- multiplication where one operand is universal real |
|
P1 := P(0.05) * 200.0; |
if P1 /= 10.00 then |
Report.Failed ("1 - expected 10.00 got " & Pennies'Image (P1)); |
end if; |
|
D1 := P(0.05) * 100.0; |
if D1 /= 5.00 then |
Report.Failed ("2 - expected 5.00 got " & Dollars'Image (D1)); |
end if; |
|
F1 := P(0.05) * 50_000.0; |
if F1 /= 2500.00 then |
Report.Failed ("3 - expected 2500.0 got " & Franklins'Image (F1)); |
end if; |
|
-- multiplication where both operands are decimal fixed |
|
P1 := P(0.05) * D(-200.0); |
if P1 /= -10.00 then |
Report.Failed ("4 - expected -10.00 got " & Pennies'Image (P1)); |
end if; |
|
D1 := P(0.05) * P(-100.0); |
if D1 /= -5.00 then |
Report.Failed ("5 - expected -5.00 got " & Dollars'Image (D1)); |
end if; |
|
F1 := P(-0.05) * F(50_000.0); |
if F1 /= -2500.00 then |
Report.Failed ("6 - expected -2500.0 got " & Franklins'Image (F1)); |
end if; |
|
-- division where one operand is universal real |
|
P1 := P(0.05) / 0.001; |
if P1 /= 50.00 then |
Report.Failed ("7 - expected 50.00 got " & Pennies'Image (P1)); |
end if; |
|
D1 := D(1000.0) / 3.0; |
if D1 /= 333.00 then |
Report.Failed ("8 - expected 333.00 got " & Dollars'Image (D1)); |
end if; |
|
F1 := P(1234.56) / 0.0001; |
if F1 /= 12345600.00 then |
Report.Failed ("9 - expected 12345600.0 got " & Franklins'Image (F1)); |
end if; |
|
|
-- division where both operands are decimal fixed |
|
P1 := P(0.05) / D(1.0); |
if P1 /= 0.05 then |
Report.Failed ("10 - expected 0.05 got " & Pennies'Image (P1)); |
end if; |
|
-- check for truncation toward 0 |
D1 := P(-101.00) / P(2.0); |
if D1 /= -50.00 then |
Report.Failed ("11 - expected -50.00 got " & Dollars'Image (D1)); |
end if; |
|
P1 := P(-102.03) / P(-0.5); |
if P1 /= 204.06 then |
Report.Failed ("12 - expected 204.06 got " & Pennies'Image (P1)); |
end if; |
|
F1 := P(876.54) / P(0.03); |
if F1 /= 29200.00 then |
Report.Failed ("13 - expected 29200.0 got " & Franklins'Image (F1)); |
end if; |
|
end Generic_Check; |
|
|
procedure Check_G6 is |
Num_Digits : constant := 6; |
type Pennies is delta 0.01 digits Num_Digits; |
type Franklins is delta 100.0 digits Num_Digits; |
type Dollars is delta 1.0 digits Num_Digits; |
|
procedure G is new Generic_Check (Pennies, Dollars, Franklins); |
begin |
G; |
end Check_G6; |
|
|
procedure Check_G9 is |
Num_Digits : constant := 9; |
type Pennies is delta 0.01 digits Num_Digits; |
type Franklins is delta 100.0 digits Num_Digits; |
type Dollars is delta 1.0 digits Num_Digits; |
|
procedure G is new Generic_Check (Pennies, Dollars, Franklins); |
begin |
G; |
end Check_G9; |
|
|
begin -- main |
Report.Test ("CXG2023", |
"Check the accuracy of multiplication and division" & |
" of decimal fixed point numbers"); |
|
if Verbose then |
Report.Comment ("starting Check_1"); |
end if; |
Check_1; |
|
if Verbose then |
Report.Comment ("starting Check_G6"); |
end if; |
Check_G6; |
|
if Verbose then |
Report.Comment ("starting Check_G9"); |
end if; |
Check_G9; |
|
Report.Result; |
end CXG2023; |
/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; |
/cxg2015.a
0,0 → 1,686
-- CXG2015.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 ARCSIN and ARCCOS functions return |
-- results that are within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test consists of a generic package that is |
-- instantiated to check both Float and a long float type. |
-- The test for each floating point type is divided into |
-- several parts: |
-- Special value checks where the result is a known constant. |
-- Checks in a specific range where a Taylor series can be |
-- used to compute an accurate result for comparison. |
-- Exception checks. |
-- The Taylor series tests are a direct translation of the |
-- FORTRAN code found in the reference. |
-- |
-- 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: |
-- 18 Mar 96 SAIC Initial release for 2.1 |
-- 24 Apr 96 SAIC Fixed error bounds. |
-- 17 Aug 96 SAIC Added reference information and improved |
-- checking for machines with more than 23 |
-- digits of precision. |
-- 03 Feb 97 PWB.CTA Removed checks with explicit Cycle => 2.0*Pi |
-- 22 Dec 99 RLB Added model range checking to "exact" results, |
-- in order to avoid too strictly requiring a specific |
-- result, and too weakly checking results. |
-- |
-- 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 |
--! |
|
-- |
-- References: |
-- |
-- Software Manual for the Elementary Functions |
-- William J. Cody, Jr. and William Waite |
-- Prentice-Hall, 1980 |
-- |
-- CRC Standard Mathematical Tables |
-- 23rd Edition |
-- |
-- Implementation and Testing of Function Software |
-- W. J. Cody |
-- Problems and Methodologies in Mathematical Software Production |
-- editors P. C. Messina and A. Murli |
-- Lecture Notes in Computer Science Volume 142 |
-- Springer Verlag, 1982 |
-- |
-- CELEFUNT: A Portable Test Package for Complex Elementary Functions |
-- ACM Collected Algorithms number 714 |
|
with System; |
with Report; |
with Ada.Numerics.Generic_Elementary_Functions; |
procedure CXG2015 is |
Verbose : constant Boolean := False; |
Max_Samples : constant := 1000; |
|
|
-- 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; |
|
-- relative error bound from G.2.4(7);6.0 |
Minimum_Error : constant := 4.0; |
|
generic |
type Real is digits <>; |
Half_PI_Low : in Real; -- The machine number closest to, but not greater |
-- than PI/2.0. |
Half_PI_High : in Real;-- The machine number closest to, but not less |
-- than PI/2.0. |
PI_Low : in Real; -- The machine number closest to, but not greater |
-- than PI. |
PI_High : in Real; -- The machine number closest to, but not less |
-- than PI. |
package Generic_Check is |
procedure Do_Test; |
end Generic_Check; |
|
package body Generic_Check is |
package Elementary_Functions is new |
Ada.Numerics.Generic_Elementary_Functions (Real); |
|
function Arcsin (X : Real) return Real renames |
Elementary_Functions.Arcsin; |
function Arcsin (X, Cycle : Real) return Real renames |
Elementary_Functions.Arcsin; |
function Arccos (X : Real) return Real renames |
Elementary_Functions.ArcCos; |
function Arccos (X, Cycle : Real) return Real renames |
Elementary_Functions.ArcCos; |
|
-- needed for support |
function Log (X, Base : Real) return Real renames |
Elementary_Functions.Log; |
|
-- flag used to terminate some tests early |
Accuracy_Error_Reported : Boolean := False; |
|
-- The following value is a lower bound on the accuracy |
-- required. It is normally 0.0 so that the lower bound |
-- is computed from Model_Epsilon. However, for tests |
-- where the expected result is only known to a certain |
-- amount of precision this bound takes on a non-zero |
-- value to account for that level of precision. |
Error_Low_Bound : Real := 0.0; |
|
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real) is |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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; |
|
-- take into account the low bound on the error |
if Max_Error < Error_Low_Bound then |
Max_Error := Error_Low_Bound; |
end if; |
|
if abs (Actual - Expected) > Max_Error then |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & 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_Value_Test is |
-- In the following tests the expected result is accurate |
-- to the machine precision so the minimum guaranteed error |
-- bound can be used. |
|
type Data_Point is |
record |
Degrees, |
Radians, |
Argument, |
Error_Bound : Real; |
end record; |
|
type Test_Data_Type is array (Positive range <>) of Data_Point; |
|
-- the values in the following tables only involve static |
-- expressions so no loss of precision occurs. However, |
-- rounding can be an issue with expressions involving Pi |
-- and square roots. The error bound specified in the |
-- table takes the sqrt error into account but not the |
-- error due to Pi. The Pi error is added in in the |
-- radians test below. |
|
Arcsin_Test_Data : constant Test_Data_Type := ( |
-- degrees radians sine error_bound test # |
--( 0.0, 0.0, 0.0, 0.0 ), -- 1 - In Exact_Result_Test. |
( 30.0, Pi/6.0, 0.5, 4.0 ), -- 2 |
( 60.0, Pi/3.0, Sqrt3/2.0, 5.0 ), -- 3 |
--( 90.0, Pi/2.0, 1.0, 4.0 ), -- 4 - In Exact_Result_Test. |
--(-90.0, -Pi/2.0, -1.0, 4.0 ), -- 5 - In Exact_Result_Test. |
(-60.0, -Pi/3.0, -Sqrt3/2.0, 5.0 ), -- 6 |
(-30.0, -Pi/6.0, -0.5, 4.0 ), -- 7 |
( 45.0, Pi/4.0, Sqrt2/2.0, 5.0 ), -- 8 |
(-45.0, -Pi/4.0, -Sqrt2/2.0, 5.0 ) ); -- 9 |
|
Arccos_Test_Data : constant Test_Data_Type := ( |
-- degrees radians cosine error_bound test # |
--( 0.0, 0.0, 1.0, 0.0 ), -- 1 - In Exact_Result_Test. |
( 30.0, Pi/6.0, Sqrt3/2.0, 5.0 ), -- 2 |
( 60.0, Pi/3.0, 0.5, 4.0 ), -- 3 |
--( 90.0, Pi/2.0, 0.0, 4.0 ), -- 4 - In Exact_Result_Test. |
(120.0, 2.0*Pi/3.0, -0.5, 4.0 ), -- 5 |
(150.0, 5.0*Pi/6.0, -Sqrt3/2.0, 5.0 ), -- 6 |
--(180.0, Pi, -1.0, 4.0 ), -- 7 - In Exact_Result_Test. |
( 45.0, Pi/4.0, Sqrt2/2.0, 5.0 ), -- 8 |
(135.0, 3.0*Pi/4.0, -Sqrt2/2.0, 5.0 ) ); -- 9 |
|
Cycle_Error, |
Radian_Error : Real; |
begin |
for I in Arcsin_Test_Data'Range loop |
|
-- note exact result requirements A.5.1(38);6.0 and |
-- G.2.4(12);6.0 |
if Arcsin_Test_Data (I).Error_Bound = 0.0 then |
Cycle_Error := 0.0; |
Radian_Error := 0.0; |
else |
Cycle_Error := Arcsin_Test_Data (I).Error_Bound; |
-- allow for rounding error in the specification of Pi |
Radian_Error := Cycle_Error + 1.0; |
end if; |
|
Check (Arcsin (Arcsin_Test_Data (I).Argument), |
Arcsin_Test_Data (I).Radians, |
"test" & Integer'Image (I) & |
" arcsin(" & |
Real'Image (Arcsin_Test_Data (I).Argument) & |
")", |
Radian_Error); |
--pwb-math Check (Arcsin (Arcsin_Test_Data (I).Argument, 2.0 * Pi), |
--pwb-math Arcsin_Test_Data (I).Radians, |
--pwb-math "test" & Integer'Image (I) & |
--pwb-math " arcsin(" & |
--pwb-math Real'Image (Arcsin_Test_Data (I).Argument) & |
--pwb-math ", 2pi)", |
--pwb-math Cycle_Error); |
Check (Arcsin (Arcsin_Test_Data (I).Argument, 360.0), |
Arcsin_Test_Data (I).Degrees, |
"test" & Integer'Image (I) & |
" arcsin(" & |
Real'Image (Arcsin_Test_Data (I).Argument) & |
", 360)", |
Cycle_Error); |
end loop; |
|
|
for I in Arccos_Test_Data'Range loop |
|
-- note exact result requirements A.5.1(39);6.0 and |
-- G.2.4(12);6.0 |
if Arccos_Test_Data (I).Error_Bound = 0.0 then |
Cycle_Error := 0.0; |
Radian_Error := 0.0; |
else |
Cycle_Error := Arccos_Test_Data (I).Error_Bound; |
-- allow for rounding error in the specification of Pi |
Radian_Error := Cycle_Error + 1.0; |
end if; |
|
Check (Arccos (Arccos_Test_Data (I).Argument), |
Arccos_Test_Data (I).Radians, |
"test" & Integer'Image (I) & |
" arccos(" & |
Real'Image (Arccos_Test_Data (I).Argument) & |
")", |
Radian_Error); |
--pwb-math Check (Arccos (Arccos_Test_Data (I).Argument, 2.0 * Pi), |
--pwb-math Arccos_Test_Data (I).Radians, |
--pwb-math "test" & Integer'Image (I) & |
--pwb-math " arccos(" & |
--pwb-math Real'Image (Arccos_Test_Data (I).Argument) & |
--pwb-math ", 2pi)", |
--pwb-math Cycle_Error); |
Check (Arccos (Arccos_Test_Data (I).Argument, 360.0), |
Arccos_Test_Data (I).Degrees, |
"test" & Integer'Image (I) & |
" arccos(" & |
Real'Image (Arccos_Test_Data (I).Argument) & |
", 360)", |
Cycle_Error); |
end loop; |
|
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in special value test"); |
when others => |
Report.Failed ("exception in special value test"); |
end Special_Value_Test; |
|
|
procedure Check_Exact (Actual, Expected_Low, Expected_High : Real; |
Test_Name : String) is |
-- If the expected result is not a model number, then Expected_Low is |
-- the first machine number less than the (exact) expected |
-- result, and Expected_High is the first machine number greater than |
-- the (exact) expected result. If the expected result is a model |
-- number, Expected_Low = Expected_High = the result. |
Model_Expected_Low : Real := Expected_Low; |
Model_Expected_High : Real := Expected_High; |
begin |
-- Calculate the first model number nearest to, but below (or equal) |
-- to the expected result: |
while Real'Model (Model_Expected_Low) /= Model_Expected_Low loop |
-- Try the next machine number lower: |
Model_Expected_Low := Real'Adjacent(Model_Expected_Low, 0.0); |
end loop; |
-- Calculate the first model number nearest to, but above (or equal) |
-- to the expected result: |
while Real'Model (Model_Expected_High) /= Model_Expected_High loop |
-- Try the next machine number higher: |
Model_Expected_High := Real'Adjacent(Model_Expected_High, 100.0); |
end loop; |
|
if Actual < Model_Expected_Low or Actual > Model_Expected_High then |
Accuracy_Error_Reported := True; |
if Actual < Model_Expected_Low then |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected low: " & Real'Image (Model_Expected_Low) & |
" expected high: " & Real'Image (Model_Expected_High) & |
" difference: " & Real'Image (Actual - Expected_Low)); |
else |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected low: " & Real'Image (Model_Expected_Low) & |
" expected high: " & Real'Image (Model_Expected_High) & |
" difference: " & Real'Image (Expected_High - Actual)); |
end if; |
elsif Verbose then |
Report.Comment (Test_Name & " passed"); |
end if; |
end Check_Exact; |
|
|
procedure Exact_Result_Test is |
begin |
-- A.5.1(38) |
Check_Exact (Arcsin (0.0), 0.0, 0.0, "arcsin(0)"); |
Check_Exact (Arcsin (0.0, 45.0), 0.0, 0.0, "arcsin(0,45)"); |
|
-- A.5.1(39) |
Check_Exact (Arccos (1.0), 0.0, 0.0, "arccos(1)"); |
Check_Exact (Arccos (1.0, 75.0), 0.0, 0.0, "arccos(1,75)"); |
|
-- G.2.4(11-13) |
Check_Exact (Arcsin (1.0), Half_PI_Low, Half_PI_High, "arcsin(1)"); |
Check_Exact (Arcsin (1.0, 360.0), 90.0, 90.0, "arcsin(1,360)"); |
|
Check_Exact (Arcsin (-1.0), -Half_PI_High, -Half_PI_Low, "arcsin(-1)"); |
Check_Exact (Arcsin (-1.0, 360.0), -90.0, -90.0, "arcsin(-1,360)"); |
|
Check_Exact (Arccos (0.0), Half_PI_Low, Half_PI_High, "arccos(0)"); |
Check_Exact (Arccos (0.0, 360.0), 90.0, 90.0, "arccos(0,360)"); |
|
Check_Exact (Arccos (-1.0), PI_Low, PI_High, "arccos(-1)"); |
Check_Exact (Arccos (-1.0, 360.0), 180.0, 180.0, "arccos(-1,360)"); |
|
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in Exact_Result Test"); |
when others => |
Report.Failed ("Exception in Exact_Result Test"); |
end Exact_Result_Test; |
|
|
procedure Arcsin_Taylor_Series_Test is |
-- the following range is chosen so that the Taylor series |
-- used will produce a result accurate to machine precision. |
-- |
-- The following formula is used for the Taylor series: |
-- TS(x) = x { 1 + (xsq/2) [ (1/3) + (3/4)xsq { (1/5) + |
-- (5/6)xsq [ (1/7) + (7/8)xsq/9 ] } ] } |
-- where xsq = x * x |
-- |
A : constant := -0.125; |
B : constant := 0.125; |
X : Real; |
Y, Y_Sq : Real; |
Actual, Sum, Xm : Real; |
-- terms in Taylor series |
K : constant Integer := Integer ( |
Log ( |
Real (Real'Machine_Radix) ** Real'Machine_Mantissa, |
10.0)) + 1; |
begin |
Accuracy_Error_Reported := False; -- reset |
for I in 1..Max_Samples loop |
-- make sure there is no error in x-1, x, and x+1 |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
|
Y := X; |
Y_Sq := Y * Y; |
Sum := 0.0; |
Xm := Real (K + K + 1); |
for M in 1 .. K loop |
Sum := Y_Sq * (Sum + 1.0/Xm); |
Xm := Xm - 2.0; |
Sum := Sum * (Xm /(Xm + 1.0)); |
end loop; |
Sum := Sum * Y; |
Actual := Y + Sum; |
Sum := (Y - Actual) + Sum; |
if not Real'Machine_Rounds then |
Actual := Actual + (Sum + Sum); |
end if; |
|
Check (Actual, Arcsin (X), |
"Taylor Series test" & Integer'Image (I) & ": arcsin(" & |
Real'Image (X) & ") ", |
Minimum_Error); |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
|
end loop; |
|
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Arcsin_Taylor_Series_Test" & |
" for X=" & Real'Image (X)); |
when others => |
Report.Failed ("exception in Arcsin_Taylor_Series_Test" & |
" for X=" & Real'Image (X)); |
end Arcsin_Taylor_Series_Test; |
|
|
|
procedure Arccos_Taylor_Series_Test is |
-- the following range is chosen so that the Taylor series |
-- used will produce a result accurate to machine precision. |
-- |
-- The following formula is used for the Taylor series: |
-- TS(x) = x { 1 + (xsq/2) [ (1/3) + (3/4)xsq { (1/5) + |
-- (5/6)xsq [ (1/7) + (7/8)xsq/9 ] } ] } |
-- arccos(x) = pi/2 - TS(x) |
A : constant := -0.125; |
B : constant := 0.125; |
C1, C2 : Real; |
X : Real; |
Y, Y_Sq : Real; |
Actual, Sum, Xm, S : Real; |
-- terms in Taylor series |
K : constant Integer := Integer ( |
Log ( |
Real (Real'Machine_Radix) ** Real'Machine_Mantissa, |
10.0)) + 1; |
begin |
if Real'Digits > 23 then |
-- constants in this section only accurate to 23 digits |
Error_Low_Bound := 0.00000_00000_00000_00000_001; |
Report.Comment ("arctan accuracy checked to 23 digits"); |
end if; |
|
-- C1 + C2 equals Pi/2 accurate to 23 digits |
if Real'Machine_Radix = 10 then |
C1 := 1.57; |
C2 := 7.9632679489661923132E-4; |
else |
C1 := 201.0 / 128.0; |
C2 := 4.8382679489661923132E-4; |
end if; |
|
Accuracy_Error_Reported := False; -- reset |
for I in 1..Max_Samples loop |
-- make sure there is no error in x-1, x, and x+1 |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
|
Y := X; |
Y_Sq := Y * Y; |
Sum := 0.0; |
Xm := Real (K + K + 1); |
for M in 1 .. K loop |
Sum := Y_Sq * (Sum + 1.0/Xm); |
Xm := Xm - 2.0; |
Sum := Sum * (Xm /(Xm + 1.0)); |
end loop; |
Sum := Sum * Y; |
|
-- at this point we have arcsin(x). |
-- We compute arccos(x) = pi/2 - arcsin(x). |
-- The following code segment is translated directly from |
-- the CELEFUNT FORTRAN implementation |
|
S := C1 + C2; |
Sum := ((C1 - S) + C2) - Sum; |
Actual := S + Sum; |
Sum := ((S - Actual) + Sum) - Y; |
S := Actual; |
Actual := S + Sum; |
Sum := (S - Actual) + Sum; |
|
if not Real'Machine_Rounds then |
Actual := Actual + (Sum + Sum); |
end if; |
|
Check (Actual, Arccos (X), |
"Taylor Series test" & Integer'Image (I) & ": arccos(" & |
Real'Image (X) & ") ", |
Minimum_Error); |
|
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
exit when Accuracy_Error_Reported; |
end loop; |
Error_Low_Bound := 0.0; -- reset |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Arccos_Taylor_Series_Test" & |
" for X=" & Real'Image (X)); |
when others => |
Report.Failed ("exception in Arccos_Taylor_Series_Test" & |
" for X=" & Real'Image (X)); |
end Arccos_Taylor_Series_Test; |
|
|
|
procedure Identity_Test is |
-- test the identity arcsin(-x) = -arcsin(x) |
-- range chosen to be most of the valid range of the argument. |
A : constant := -0.999; |
B : constant := 0.999; |
X : Real; |
begin |
Accuracy_Error_Reported := False; -- reset |
for I in 1..Max_Samples loop |
-- make sure there is no error in x-1, x, and x+1 |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
|
Check (Arcsin(-X), -Arcsin (X), |
"Identity test" & Integer'Image (I) & ": arcsin(" & |
Real'Image (X) & ") ", |
8.0); -- 2 arcsin evaluations => twice the error bound |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
end loop; |
end Identity_Test; |
|
|
procedure Exception_Test is |
X1, X2 : Real := 0.0; |
begin |
begin |
X1 := Arcsin (1.1); |
Report.Failed ("no exception for Arcsin (1.1)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error instead of " & |
"Argument_Error for Arcsin (1.1)"); |
when Ada.Numerics.Argument_Error => |
null; -- expected result |
when others => |
Report.Failed ("wrong exception for Arcsin(1.1)"); |
end; |
|
begin |
X2 := Arccos (-1.1); |
Report.Failed ("no exception for Arccos (-1.1)"); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error instead of " & |
"Argument_Error for Arccos (-1.1)"); |
when Ada.Numerics.Argument_Error => |
null; -- expected result |
when others => |
Report.Failed ("wrong exception for Arccos(-1.1)"); |
end; |
|
|
-- optimizer thwarting |
if Report.Ident_Bool (False) then |
Report.Comment (Real'Image (X1 + X2)); |
end if; |
end Exception_Test; |
|
|
procedure Do_Test is |
begin |
Special_Value_Test; |
Exact_Result_Test; |
Arcsin_Taylor_Series_Test; |
Arccos_Taylor_Series_Test; |
Identity_Test; |
Exception_Test; |
end Do_Test; |
end Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
-- These expressions must be truly static, which is why we have to do them |
-- outside of the generic, and we use the named numbers. Note that we know |
-- that PI is not a machine number (it is irrational), and it should be |
-- represented to more digits than supported by the target machine. |
Float_Half_PI_Low : constant := Float'Adjacent(PI/2.0, 0.0); |
Float_Half_PI_High : constant := Float'Adjacent(PI/2.0, 10.0); |
Float_PI_Low : constant := Float'Adjacent(PI, 0.0); |
Float_PI_High : constant := Float'Adjacent(PI, 10.0); |
package Float_Check is new Generic_Check (Float, |
Half_PI_Low => Float_Half_PI_Low, |
Half_PI_High => Float_Half_PI_High, |
PI_Low => Float_PI_Low, |
PI_High => Float_PI_High); |
|
-- check the floating point type with the most digits |
type A_Long_Float is digits System.Max_Digits; |
A_Long_Float_Half_PI_Low : constant := A_Long_Float'Adjacent(PI/2.0, 0.0); |
A_Long_Float_Half_PI_High : constant := A_Long_Float'Adjacent(PI/2.0, 10.0); |
A_Long_Float_PI_Low : constant := A_Long_Float'Adjacent(PI, 0.0); |
A_Long_Float_PI_High : constant := A_Long_Float'Adjacent(PI, 10.0); |
package A_Long_Float_Check is new Generic_Check (A_Long_Float, |
Half_PI_Low => A_Long_Float_Half_PI_Low, |
Half_PI_High => A_Long_Float_Half_PI_High, |
PI_Low => A_Long_Float_PI_Low, |
PI_High => A_Long_Float_PI_High); |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
|
begin |
Report.Test ("CXG2015", |
"Check the accuracy of the ARCSIN and ARCCOS functions"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
|
Report.Result; |
end CXG2015; |
/cxg2024.a
0,0 → 1,191
-- CXG2024.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 multiplication and division of decimal |
-- and binary fixed point numbers that result in a |
-- decimal fixed point type produce acceptable results. |
-- |
-- TEST DESCRIPTION: |
-- Multiplication and division of mixed binary and decimal |
-- values are performed. Identity functions are used so |
-- that the operands of the expressions will not be seen |
-- as static by the compiler. |
-- |
-- 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. |
-- This test applies only to implementations supporting |
-- decimal fixed point types of at least 9 digits. |
-- |
-- |
-- CHANGE HISTORY: |
-- 4 Apr 96 SAIC Initial release for 2.1 |
-- 17 Aug 96 SAIC Removed checks for close results |
-- |
--! |
|
with System; |
with Report; |
procedure CXG2024 is |
|
procedure Do_Check is |
Num_Digits : constant := 9; |
type Pennies is delta 0.01 digits Num_Digits; |
type Dollars is delta 1.0 digits Num_Digits; |
|
type Signed_Sixteenths is delta 0.0625 |
range -2.0 ** (System.Max_Mantissa-5) .. |
2.0 ** (System.Max_Mantissa-5) - 1.0; |
type Unsigned_Sixteenths is delta 0.0625 |
range 0.0 .. 2.0 ** (System.Max_Mantissa-4) - 1.0; |
|
P1 : Pennies; |
D1 : Dollars; |
|
-- optimization thwarting functions |
|
function P (X : Pennies) return Pennies is |
begin |
if Report.Ident_Bool (True) then |
return X; |
else |
return 3.21; -- never executed |
end if; |
end P; |
|
|
function D (X : Dollars) return Dollars is |
begin |
if Report.Ident_Bool (True) then |
return X; |
else |
return 321.0; -- never executed |
end if; |
end D; |
|
|
function US (X : Unsigned_Sixteenths) return Unsigned_Sixteenths is |
begin |
if Report.Ident_Bool (True) then |
return X; |
else |
return 321.0; -- never executed |
end if; |
end US; |
|
|
function SS (X : Signed_Sixteenths) return Signed_Sixteenths is |
begin |
if Report.Ident_Bool (True) then |
return X; |
else |
return 321.0; -- never executed |
end if; |
end SS; |
|
|
begin |
|
P1 := P(0.05) * SS(-200.0); |
if P1 /= -10.00 then |
Report.Failed ("1 - expected -10.00 got " & Pennies'Image (P1)); |
end if; |
|
D1 := P(0.05) * SS(-100.0); |
if D1 /= -5.00 then |
Report.Failed ("2 - expected -5.00 got " & Dollars'Image (D1)); |
end if; |
|
P1 := P(0.05) * US(200.0); |
if P1 /= 10.00 then |
Report.Failed ("3 - expected 10.00 got " & Pennies'Image (P1)); |
end if; |
|
D1 := P(-0.05) * US(100.0); |
if D1 /= -5.00 then |
Report.Failed ("4 - expected -5.00 got " & Dollars'Image (D1)); |
end if; |
|
|
|
P1 := P(0.05) / US(1.0); |
if P1 /= 0.05 then |
Report.Failed ("6 - expected 0.05 got " & Pennies'Image (P1)); |
end if; |
|
|
-- check rounding |
|
D1 := Dollars'Round (Pennies (P(-101.00) / US(2.0))); |
if D1 /= -51.00 then |
Report.Failed ("11 - expected -51.00 got " & Dollars'Image (D1)); |
end if; |
|
D1 := Dollars'Round (Pennies (P(101.00) / US(2.0))); |
if D1 /= 51.00 then |
Report.Failed ("12 - expected 51.00 got " & Dollars'Image (D1)); |
end if; |
|
D1 := Dollars'Round (Pennies (SS(-101.00) / P(2.0))); |
if D1 /= -51.00 then |
Report.Failed ("13 - expected -51.00 got " & Dollars'Image (D1)); |
end if; |
|
D1 := Dollars'Round (Pennies (US(101.00) / P(2.0))); |
if D1 /= 51.00 then |
Report.Failed ("14 - expected 51.00 got " & Dollars'Image (D1)); |
end if; |
|
|
|
P1 := P(-102.03) / SS(-0.5); |
if P1 /= 204.06 then |
Report.Failed ("15 - expected 204.06 got " & Pennies'Image (P1)); |
end if; |
|
|
exception |
when others => |
Report.Failed ("unexpected exception in Do_Check"); |
end Do_Check; |
|
|
begin -- main |
Report.Test ("CXG2024", |
"Check the accuracy of multiplication and division" & |
" of mixed decimal and binary fixed point numbers"); |
|
Do_Check; |
|
Report.Result; |
end CXG2024; |
/cxg2007.a
0,0 → 1,291
-- CXG2007.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 Compose_From_Polar 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 Compose_From_Polar function. |
-- |
-- 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: |
-- 23 FEB 96 SAIC Initial release for 2.1 |
-- 23 APR 96 SAIC Fixed error checking |
-- 03 MAR 97 PWB.CTA Deleted checks with 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 |
--! |
|
with System; |
with Report; |
with Ada.Numerics; |
with Ada.Numerics.Generic_Complex_Types; |
procedure CXG2007 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; |
|
Maximum_Relative_Error : constant Real := 3.0; |
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real; |
Arg_Error : Real) is |
-- Arg_Error is additional absolute error that is allowed beyond |
-- the MRE to account for error in the result that can be |
-- attributed to error in the arguments. |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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_Small 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; |
Max_Error := Max_Error + Arg_Error; |
|
if abs (Actual - Expected) > Max_Error then |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & 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 Check (Actual, Expected : Complex; |
Test_Name : String; |
MRE : Real; |
Arg_Error : Real) is |
-- Arg_Error is additional absolute error that is allowed beyond |
-- the MRE to account for error in the result that can be |
-- attributed to error in the arguments. |
begin |
Check (Actual.Re, Expected.Re, |
Test_Name & " real part", |
MRE, Arg_Error); |
Check (Actual.Im, Expected.Im, |
Test_Name & " imaginary part", |
MRE, Arg_Error); |
end Check; |
|
|
procedure Special_Cases is |
type Data_Point is |
record |
Re, |
Im, |
Modulus, |
Radians, |
Degrees, |
Arg_Error : Real; |
end record; |
|
-- shorthand names for various constants |
P4 : constant := Pi/4.0; |
P6 : constant := Pi/6.0; |
|
MER2 : constant Real := Real'Model_Epsilon * Sqrt2; |
|
type Test_Data_Type is array (Positive range <>) of Data_Point; |
|
-- the values in the following table only involve static |
-- expressions so no loss of precision occurs. |
Test_Data : constant Test_Data_Type := ( |
--Re Im Modulus Radians Degrees Arg_Err |
( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ), -- 1 |
( 0.0, 0.0, 0.0, Pi, 180.0, 0.0 ), -- 2 |
|
( 1.0, 0.0, 1.0, 0.0, 0.0, 0.0 ), -- 3 |
(-1.0, 0.0, -1.0, 0.0, 0.0, 0.0 ), -- 4 |
|
( 1.0, 1.0, Sqrt2, P4, 45.0, MER2), -- 5 |
(-1.0, 1.0, -Sqrt2, -P4, -45.0, MER2), -- 6 |
( 1.0, -1.0, Sqrt2, -P4, -45.0, MER2), -- 7 |
(-1.0, -1.0, -Sqrt2, P4, 45.0, MER2), -- 8 |
(-1.0, -1.0, Sqrt2, -3.0*P4,-135.0, MER2), -- 9 |
(-1.0, 1.0, Sqrt2, 3.0*P4, 135.0, MER2), -- 10 |
( 1.0, -1.0, -Sqrt2, 3.0*P4, 135.0, MER2), -- 11 |
|
(-1.0, 0.0, 1.0, Pi, 180.0, 0.0 ), -- 12 |
( 1.0, 0.0, -1.0, Pi, 180.0, 0.0 ) ); -- 13 |
|
|
Z : Complex; |
Exp : Complex; |
begin |
for I in Test_Data'Range loop |
begin |
Exp := (Test_Data (I).Re, Test_Data (I).Im); |
|
Z := Compose_From_Polar (Test_Data (I).Modulus, |
Test_Data (I).Radians); |
Check (Z, Exp, |
"test" & Integer'Image (I) & " compose_from_polar(m,r)", |
Maximum_Relative_Error, Test_Data (I).Arg_Error); |
|
--pwb-math Z := Compose_From_Polar (Test_Data (I).Modulus, |
--pwb-math Test_Data (I).Radians, |
--pwb-math 2.0*Pi); |
--pwb-math Check (Z, Exp, |
--pwb-math "test" & Integer'Image (I) & " compose_from_polar(m,r,2pi)", |
--pwb-math Maximum_Relative_Error, Test_Data (I).Arg_Error); |
|
Z := Compose_From_Polar (Test_Data (I).Modulus, |
Test_Data (I).Degrees, |
360.0); |
Check (Z, Exp, |
"test" & Integer'Image (I) & " compose_from_polar(m,d,360)", |
Maximum_Relative_Error, Test_Data (I).Arg_Error); |
|
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; |
end Special_Cases; |
|
|
procedure Exception_Cases is |
-- check that Argument_Error is raised if Cycle is <= 0 |
Z : Complex; |
W : Complex; |
begin |
begin |
Z := Compose_From_Polar (3.0, 0.0, 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 |
W := Compose_From_Polar (6.0, 1.0, Cycle => -10.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 (1) = 2 then |
-- not executed - used to make it appear that we use the |
-- results of the above computation |
Z := Z * W; |
Report.Failed(Real'Image (Z.Re + Z.Im)); |
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 ("CXG2007", |
"Check the accuracy of the Compose_From_Polar" & |
" 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 CXG2007; |
/cxg2016.a
0,0 → 1,482
-- CXG2016.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 ARCTAN function returns a |
-- result that is within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test consists of a generic package that is |
-- instantiated to check both Float and a long float type. |
-- The test for each floating point type is divided into |
-- several parts: |
-- Special value checks where the result is a known constant. |
-- Exception checks. |
-- |
-- 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: |
-- 19 Mar 96 SAIC Initial release for 2.1 |
-- 30 APR 96 SAIC Fixed optimization issue |
-- 17 AUG 96 SAIC Incorporated Reviewer's suggestions. |
-- 12 OCT 96 SAIC Incorporated Reviewer's suggestions. |
-- 02 DEC 97 EDS Remove procedure Identity_1_Test and calls to |
-- procedure. |
-- 29 JUN 98 EDS Replace -0.0 with call to ImpDef.Annex_G.Negative_Zero |
-- 28 APR 99 RLB Replaced comma accidentally deleted in above change. |
-- 15 DEC 99 RLB Added model range checking to "exact" results, |
-- in order to avoid too strictly requiring a specific |
-- result. |
--! |
|
-- |
-- References: |
-- |
-- Software Manual for the Elementary Functions |
-- William J. Cody, Jr. and William Waite |
-- Prentice-Hall, 1980 |
-- |
-- CRC Standard Mathematical Tables |
-- 23rd Edition |
-- |
-- Implementation and Testing of Function Software |
-- W. J. Cody |
-- 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 Ada.Numerics.Generic_Elementary_Functions; |
with Impdef.Annex_G; |
procedure CXG2016 is |
Verbose : constant Boolean := False; |
Max_Samples : constant := 1000; |
|
-- 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 <>; |
Half_PI_Low : in Real; -- The machine number closest to, but not greater |
-- than PI/2.0. |
Half_PI_High : in Real;-- The machine number closest to, but not less |
-- than PI/2.0. |
PI_Low : in Real; -- The machine number closest to, but not greater |
-- than PI. |
PI_High : in Real; -- The machine number closest to, but not less |
-- than PI. |
package Generic_Check is |
procedure Do_Test; |
end Generic_Check; |
|
package body Generic_Check is |
package Elementary_Functions is new |
Ada.Numerics.Generic_Elementary_Functions (Real); |
|
function Arctan (Y : Real; |
X : Real := 1.0) return Real renames |
Elementary_Functions.Arctan; |
function Arctan (Y : Real; |
X : Real := 1.0; |
Cycle : Real) return Real renames |
Elementary_Functions.Arctan; |
|
-- flag used to terminate some tests early |
Accuracy_Error_Reported : Boolean := False; |
|
-- The following value is a lower bound on the accuracy |
-- required. It is normally 0.0 so that the lower bound |
-- is computed from Model_Epsilon. However, for tests |
-- where the expected result is only known to a certain |
-- amount of precision this bound takes on a non-zero |
-- value to account for that level of precision. |
Error_Low_Bound : Real := 0.0; |
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real) is |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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; |
|
-- take into account the low bound on the error |
if Max_Error < Error_Low_Bound then |
Max_Error := Error_Low_Bound; |
end if; |
|
if abs (Actual - Expected) > Max_Error then |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & 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_Value_Test is |
-- If eta is very small, arctan(x + eta) ~= arctan(x) + eta/(1+x*x). |
-- |
-- For tests 4 and 5, there is an error of 4.0ME for arctan + an |
-- additional error of 1.0ME because pi is not exact for a total of 5.0ME. |
-- |
-- In test 3 there is the error for pi plus an additional error |
-- of (1.0ME)/4 since sqrt3 is not exact, for a total of 5.25ME. |
-- |
-- In test 2 there is the error for pi plus an additional error |
-- of (3/4)(1.0ME) since sqrt3 is not exact, for a total of 5.75ME. |
|
|
type Data_Point is |
record |
Degrees, |
Radians, |
Tangent, |
Allowed_Error : Real; |
end record; |
|
type Test_Data_Type is array (Positive range <>) of Data_Point; |
|
-- the values in the following table only involve static |
-- expressions so no additional loss of precision occurs. |
Test_Data : constant Test_Data_Type := ( |
-- degrees radians tangent error test # |
( 0.0, 0.0, 0.0, 4.0 ), -- 1 |
( 30.0, Pi/6.0, Sqrt3/3.0, 5.75), -- 2 |
( 60.0, Pi/3.0, Sqrt3, 5.25), -- 3 |
( 45.0, Pi/4.0, 1.0, 5.0 ), -- 4 |
(-45.0, -Pi/4.0, -1.0, 5.0 ) ); -- 5 |
|
begin |
for I in Test_Data'Range loop |
Check (Arctan (Test_Data (I).Tangent), |
Test_Data (I).Radians, |
"special value test" & Integer'Image (I) & |
" arctan(" & |
Real'Image (Test_Data (I).Tangent) & |
")", |
Test_Data (I).Allowed_Error); |
Check (Arctan (Test_Data (I).Tangent, Cycle => 360.0), |
Test_Data (I).Degrees, |
"special value test" & Integer'Image (I) & |
" arctan(" & |
Real'Image (Test_Data (I).Tangent) & |
", cycle=>360)", |
Test_Data (I).Allowed_Error); |
end loop; |
|
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in special value test"); |
when others => |
Report.Failed ("exception in special value test"); |
end Special_Value_Test; |
|
|
|
procedure Check_Exact (Actual, Expected_Low, Expected_High : Real; |
Test_Name : String) is |
-- If the expected result is not a model number, then Expected_Low is |
-- the first machine number less than the (exact) expected |
-- result, and Expected_High is the first machine number greater than |
-- the (exact) expected result. If the expected result is a model |
-- number, Expected_Low = Expected_High = the result. |
Model_Expected_Low : Real := Expected_Low; |
Model_Expected_High : Real := Expected_High; |
begin |
-- Calculate the first model number nearest to, but below (or equal) |
-- to the expected result: |
while Real'Model (Model_Expected_Low) /= Model_Expected_Low loop |
-- Try the next machine number lower: |
Model_Expected_Low := Real'Adjacent(Model_Expected_Low, 0.0); |
end loop; |
-- Calculate the first model number nearest to, but above (or equal) |
-- to the expected result: |
while Real'Model (Model_Expected_High) /= Model_Expected_High loop |
-- Try the next machine number higher: |
Model_Expected_High := Real'Adjacent(Model_Expected_High, 100.0); |
end loop; |
|
if Actual < Model_Expected_Low or Actual > Model_Expected_High then |
Accuracy_Error_Reported := True; |
if Actual < Model_Expected_Low then |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected low: " & Real'Image (Model_Expected_Low) & |
" expected high: " & Real'Image (Model_Expected_High) & |
" difference: " & Real'Image (Actual - Expected_Low)); |
else |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected low: " & Real'Image (Model_Expected_Low) & |
" expected high: " & Real'Image (Model_Expected_High) & |
" difference: " & Real'Image (Expected_High - Actual)); |
end if; |
elsif Verbose then |
Report.Comment (Test_Name & " passed"); |
end if; |
end Check_Exact; |
|
|
procedure Exact_Result_Test is |
begin |
-- A.5.1(40);6.0 |
Check_Exact (Arctan (0.0, 1.0), 0.0, 0.0, "arctan(0,1)"); |
Check_Exact (Arctan (0.0, 1.0, 27.0), 0.0, 0.0, "arctan(0,1,27)"); |
|
-- G.2.4(11-13);6.0 |
|
Check_Exact (Arctan (1.0, 0.0), Half_PI_Low, Half_PI_High, |
"arctan(1,0)"); |
Check_Exact (Arctan (1.0, 0.0, 360.0), 90.0, 90.0, "arctan(1,0,360)"); |
|
Check_Exact (Arctan (-1.0, 0.0), -Half_PI_High, -Half_PI_Low, |
"arctan(-1,0)"); |
Check_Exact (Arctan (-1.0, 0.0, 360.0), -90.0, -90.0, |
"arctan(-1,0,360)"); |
|
if Real'Signed_Zeros then |
Check_Exact (Arctan (0.0, -1.0), PI_Low, PI_High, "arctan(+0,-1)"); |
Check_Exact (Arctan (0.0, -1.0, 360.0), 180.0, 180.0, |
"arctan(+0,-1,360)"); |
Check_Exact (Arctan ( Real ( ImpDef.Annex_G.Negative_Zero ), -1.0), |
-PI_High, -PI_Low, "arctan(-0,-1)"); |
Check_Exact (Arctan ( Real ( ImpDef.Annex_G.Negative_Zero ), -1.0, |
360.0), -180.0, -180.0, "arctan(-0,-1,360)"); |
else |
Check_Exact (Arctan (0.0, -1.0), PI_Low, PI_High, "arctan(0,-1)"); |
Check_Exact (Arctan (0.0, -1.0, 360.0), 180.0, 180.0, |
"arctan(0,-1,360)"); |
end if; |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in Exact_Result Test"); |
when others => |
Report.Failed ("Exception in Exact_Result Test"); |
end Exact_Result_Test; |
|
|
procedure Taylor_Series_Test is |
-- This test checks the Arctan by using a taylor series expansion that |
-- will produce a result accurate to 19 decimal digits for |
-- the range under test. |
-- |
-- The maximum relative error bound for this test is |
-- 4 for the arctan operation and 2 for the Taylor series |
-- for a total of 6 * Model_Epsilon |
|
A : constant := -1.0/16.0; |
B : constant := 1.0/16.0; |
X : Real; |
Actual, Expected : Real; |
Sum, Em, X_Squared : Real; |
begin |
if Real'Digits > 19 then |
-- Taylor series calculation produces result accurate to 19 |
-- digits. If type being tested has more digits then set |
-- the error low bound to account for this. |
-- The error low bound is conservatively set to 6*10**-19 |
Error_Low_Bound := 0.00000_00000_00000_0006; |
Report.Comment ("arctan accuracy checked to 19 digits"); |
end if; |
|
Accuracy_Error_Reported := False; -- reset |
for I in 0..Max_Samples loop |
X := (B - A) * Real (I) / Real (Max_Samples) + A; |
X_Squared := X * X; |
Em := 17.0; |
Sum := X_Squared / Em; |
|
for II in 1 .. 7 loop |
Em := Em - 2.0; |
Sum := (1.0 / Em - Sum) * X_Squared; |
end loop; |
Sum := -X * Sum; |
Expected := X + Sum; |
Sum := (X - Expected) + Sum; |
if not Real'Machine_Rounds then |
Expected := Expected + (Sum + Sum); |
end if; |
|
Actual := Arctan (X); |
|
Check (Actual, Expected, |
"Taylor_Series_Test " & Integer'Image (I) & ": arctan(" & |
Real'Image (X) & ") ", |
6.0); |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
|
end loop; |
Error_Low_Bound := 0.0; -- reset |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Taylor_Series_Test"); |
when others => |
Report.Failed ("exception in Taylor_Series_Test"); |
end Taylor_Series_Test; |
|
|
procedure Exception_Test is |
X1, X2, X3 : Real := 0.0; |
begin |
|
begin -- A.5.1(20);6.0 |
X1 := Arctan(0.0, 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 -- A.5.1(20);6.0 |
X2 := Arctan (0.0, Cycle => -1.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 -- A.5.1(25);6.0 |
X3 := Arctan (0.0, 0.0); |
Report.Failed ("no exception for arctan(0,0)"); |
exception |
when Ada.Numerics.Argument_Error => null; |
when others => |
Report.Failed ("wrong exception for arctan(0,0)"); |
end; |
|
-- optimizer thwarting |
if Report.Ident_Bool (False) then |
Report.Comment (Real'Image (X1 + X2 + X3)); |
end if; |
end Exception_Test; |
|
|
procedure Do_Test is |
begin |
Special_Value_Test; |
Exact_Result_Test; |
Taylor_Series_Test; |
Exception_Test; |
end Do_Test; |
end Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
-- These expressions must be truly static, which is why we have to do them |
-- outside of the generic, and we use the named numbers. Note that we know |
-- that PI is not a machine number (it is irrational), and it should be |
-- represented to more digits than supported by the target machine. |
Float_Half_PI_Low : constant := Float'Adjacent(PI/2.0, 0.0); |
Float_Half_PI_High : constant := Float'Adjacent(PI/2.0, 10.0); |
Float_PI_Low : constant := Float'Adjacent(PI, 0.0); |
Float_PI_High : constant := Float'Adjacent(PI, 10.0); |
package Float_Check is new Generic_Check (Float, |
Half_PI_Low => Float_Half_PI_Low, |
Half_PI_High => Float_Half_PI_High, |
PI_Low => Float_PI_Low, |
PI_High => Float_PI_High); |
|
-- check the Floating point type with the most digits |
type A_Long_Float is digits System.Max_Digits; |
A_Long_Float_Half_PI_Low : constant := A_Long_Float'Adjacent(PI/2.0, 0.0); |
A_Long_Float_Half_PI_High : constant := A_Long_Float'Adjacent(PI/2.0, 10.0); |
A_Long_Float_PI_Low : constant := A_Long_Float'Adjacent(PI, 0.0); |
A_Long_Float_PI_High : constant := A_Long_Float'Adjacent(PI, 10.0); |
package A_Long_Float_Check is new Generic_Check (A_Long_Float, |
Half_PI_Low => A_Long_Float_Half_PI_Low, |
Half_PI_High => A_Long_Float_Half_PI_High, |
PI_Low => A_Long_Float_PI_Low, |
PI_High => A_Long_Float_PI_High); |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
|
begin |
Report.Test ("CXG2016", |
"Check the accuracy of the ARCTAN function"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
|
Report.Result; |
end CXG2016; |
/cxg2008.a
0,0 → 1,948
-- CXG2008.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 multiplication and division |
-- operations return results that are within the allowed |
-- error bound. |
-- Check that all the required pure Numerics packages are pure. |
-- |
-- TEST DESCRIPTION: |
-- This test contains three test packages that are almost |
-- identical. The first two packages differ only in the |
-- floating point type that is being tested. The first |
-- and third package differ only in whether the generic |
-- complex types package or the pre-instantiated |
-- package is used. |
-- The test package is not generic so that the arguments |
-- and expected results for some of the test values |
-- can be expressed as universal real instead of being |
-- computed at runtime. |
-- |
-- 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: |
-- 24 FEB 96 SAIC Initial release for 2.1 |
-- 03 JUN 98 EDS Correct the test program's incorrect assumption |
-- that Constraint_Error must be raised by complex |
-- division by zero, which is contrary to the |
-- allowance given by the Ada 95 standard G.1.1(40). |
-- 13 MAR 01 RLB Replaced commented out Pure check on non-generic |
-- packages, as required by Defect Report |
-- 8652/0020 and as reflected in Technical |
-- Corrigendum 1. |
--! |
|
------------------------------------------------------------------------------ |
-- Check that the required pure packages are pure by withing them from a |
-- pure package. The non-generic versions of those packages are required to |
-- be pure by Defect Report 8652/0020, Technical Corrigendum 1 [A.5.1(9/1) and |
-- G.1.1(25/1)]. |
with Ada.Numerics.Generic_Elementary_Functions; |
with Ada.Numerics.Elementary_Functions; |
with Ada.Numerics.Generic_Complex_Types; |
with Ada.Numerics.Complex_Types; |
with Ada.Numerics.Generic_Complex_Elementary_Functions; |
with Ada.Numerics.Complex_Elementary_Functions; |
package CXG2008_0 is |
pragma Pure; |
-- 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; |
end CXG2008_0; |
|
------------------------------------------------------------------------------ |
|
with System; |
with Report; |
with Ada.Numerics.Generic_Complex_Types; |
with Ada.Numerics.Complex_Types; |
with CXG2008_0; use CXG2008_0; |
procedure CXG2008 is |
Verbose : constant Boolean := False; |
|
package Float_Check is |
subtype Real is Float; |
procedure Do_Test; |
end Float_Check; |
|
package body Float_Check is |
package Complex_Types is new |
Ada.Numerics.Generic_Complex_Types (Real); |
use Complex_Types; |
|
-- keep track if an accuracy failure has occurred so the test |
-- can be short-circuited to avoid thousands of error messages. |
Failure_Detected : Boolean := False; |
|
Mult_MBE : constant Real := 5.0; |
Divide_MBE : constant Real := 13.0; |
|
|
procedure Check (Actual, Expected : Complex; |
Test_Name : String; |
MBE : 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 := MBE * abs Expected.Re * Real'Model_Epsilon; |
Abs_Error := MBE * Real'Model_Epsilon; |
if Rel_Error > Abs_Error then |
Max_Error := Rel_Error; |
else |
Max_Error := Abs_Error; |
end if; |
|
if abs (Actual.Re - Expected.Re) > Max_Error then |
Failure_Detected := True; |
Report.Failed (Test_Name & |
" actual.re: " & Real'Image (Actual.Re) & |
" expected.re: " & Real'Image (Expected.Re) & |
" difference.re " & |
Real'Image (Actual.Re - Expected.Re) & |
" mre:" & Real'Image (Max_Error) ); |
elsif Verbose then |
if Actual = Expected then |
Report.Comment (Test_Name & " exact result for real part"); |
else |
Report.Comment (Test_Name & " passed for real part"); |
end if; |
end if; |
|
Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon; |
if Rel_Error > Abs_Error then |
Max_Error := Rel_Error; |
else |
Max_Error := Abs_Error; |
end if; |
if abs (Actual.Im - Expected.Im) > Max_Error then |
Failure_Detected := True; |
Report.Failed (Test_Name & |
" actual.im: " & Real'Image (Actual.Im) & |
" expected.im: " & Real'Image (Expected.Im) & |
" difference.im " & |
Real'Image (Actual.Im - Expected.Im) & |
" mre:" & Real'Image (Max_Error) ); |
elsif Verbose then |
if Actual = Expected then |
Report.Comment (Test_Name & " exact result for imaginary part"); |
else |
Report.Comment (Test_Name & " passed for imaginary part"); |
end if; |
end if; |
end Check; |
|
|
procedure Special_Values is |
begin |
|
--- test 1 --- |
declare |
T : constant := (Real'Machine_EMax - 1) / 2; |
Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T); |
Expected : Complex := (0.0, 0.0); |
X : Complex := (0.0, 0.0); |
Y : Complex := (Big, Big); |
Z : Complex; |
begin |
Z := X * Y; |
Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)", |
Mult_MBE); |
Z := Y * X; |
Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)", |
Mult_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 1"); |
when others => |
Report.Failed ("exception in test 1"); |
end; |
|
--- test 2 --- |
declare |
T : constant := Real'Model_EMin + 1; |
Tiny : constant := (1.0 * Real'Machine_Radix) ** T; |
U : Complex := (Tiny, Tiny); |
X : Complex := (0.0, 0.0); |
Expected : Complex := (0.0, 0.0); |
Z : Complex; |
begin |
Z := U * X; |
Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)", |
Mult_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 2"); |
when others => |
Report.Failed ("exception in test 2"); |
end; |
|
--- test 3 --- |
declare |
T : constant := (Real'Machine_EMax - 1) / 2; |
Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T); |
B : Complex := (Big, Big); |
X : Complex := (0.0, 0.0); |
Z : Complex; |
begin |
if Real'Machine_Overflows then |
Z := B / X; |
Report.Failed ("test 3 - Constraint_Error not raised"); |
Check (Z, Z, "not executed - optimizer thwarting", 0.0); |
end if; |
exception |
when Constraint_Error => null; -- expected |
when others => |
Report.Failed ("exception in test 3"); |
end; |
|
--- test 4 --- |
declare |
T : constant := Real'Model_EMin + 1; |
Tiny : constant := (1.0 * Real'Machine_Radix) ** T; |
U : Complex := (Tiny, Tiny); |
X : Complex := (0.0, 0.0); |
Z : Complex; |
begin |
if Real'Machine_Overflows then |
Z := U / X; |
Report.Failed ("test 4 - Constraint_Error not raised"); |
Check (Z, Z, "not executed - optimizer thwarting", 0.0); |
end if; |
exception |
when Constraint_Error => null; -- expected |
when others => |
Report.Failed ("exception in test 4"); |
end; |
|
|
--- test 5 --- |
declare |
X : Complex := (Sqrt2, Sqrt2); |
Z : Complex; |
Expected : constant Complex := (0.0, 4.0); |
begin |
Z := X * X; |
Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)", |
Mult_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 5"); |
when others => |
Report.Failed ("exception in test 5"); |
end; |
|
--- test 6 --- |
declare |
X : Complex := Sqrt3 - Sqrt3 * i; |
Z : Complex; |
Expected : constant Complex := (0.0, -6.0); |
begin |
Z := X * X; |
Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)", |
Mult_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 6"); |
when others => |
Report.Failed ("exception in test 6"); |
end; |
|
--- test 7 --- |
declare |
X : Complex := Sqrt2 + Sqrt2 * i; |
Y : Complex := Sqrt2 - Sqrt2 * i; |
Z : Complex; |
Expected : constant Complex := 0.0 + i; |
begin |
Z := X / Y; |
Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)", |
Divide_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 7"); |
when others => |
Report.Failed ("exception in test 7"); |
end; |
end Special_Values; |
|
|
procedure Do_Mult_Div (X, Y : Complex) is |
Z : Complex; |
Args : constant String := |
"X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " & |
"Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ; |
begin |
Z := (X * X) / X; |
Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE); |
Z := (X * Y) / X; |
Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE); |
Z := (X * Y) / Y; |
Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args); |
when others => |
Report.Failed ("exception in Do_Mult_Div for " & Args); |
end Do_Mult_Div; |
|
-- select complex values X and Y where the real and imaginary |
-- parts are selected from the ranges (1/radix..1) and |
-- (1..radix). This translates into quite a few combinations. |
procedure Mult_Div_Check is |
Samples : constant := 17; |
Radix : constant Real := Real(Real'Machine_Radix); |
Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix); |
Low_Sample : Real; -- (1/radix .. 1) |
High_Sample : Real; -- (1 .. radix) |
Sample : array (1..2) of Real; |
X, Y : Complex; |
begin |
for I in 1 .. Samples loop |
Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) + |
Inv_Radix; |
Sample (1) := Low_Sample; |
for J in 1 .. Samples loop |
High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) + |
Radix; |
Sample (2) := High_Sample; |
for K in 1 .. 2 loop |
for L in 1 .. 2 loop |
X := Complex'(Sample (K), Sample (L)); |
Y := Complex'(Sample (L), Sample (K)); |
Do_Mult_Div (X, Y); |
if Failure_Detected then |
return; -- minimize flood of error messages |
end if; |
end loop; |
end loop; |
end loop; -- J |
end loop; -- I |
end Mult_Div_Check; |
|
|
procedure Do_Test is |
begin |
Special_Values; |
Mult_Div_Check; |
end Do_Test; |
end Float_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
-- check the floating point type with the most digits |
|
package A_Long_Float_Check is |
type A_Long_Float is digits System.Max_Digits; |
subtype Real is A_Long_Float; |
procedure Do_Test; |
end A_Long_Float_Check; |
|
package body A_Long_Float_Check is |
|
package Complex_Types is new |
Ada.Numerics.Generic_Complex_Types (Real); |
use Complex_Types; |
|
-- keep track if an accuracy failure has occurred so the test |
-- can be short-circuited to avoid thousands of error messages. |
Failure_Detected : Boolean := False; |
|
Mult_MBE : constant Real := 5.0; |
Divide_MBE : constant Real := 13.0; |
|
|
procedure Check (Actual, Expected : Complex; |
Test_Name : String; |
MBE : 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 := MBE * abs Expected.Re * Real'Model_Epsilon; |
Abs_Error := MBE * Real'Model_Epsilon; |
if Rel_Error > Abs_Error then |
Max_Error := Rel_Error; |
else |
Max_Error := Abs_Error; |
end if; |
|
if abs (Actual.Re - Expected.Re) > Max_Error then |
Failure_Detected := True; |
Report.Failed (Test_Name & |
" actual.re: " & Real'Image (Actual.Re) & |
" expected.re: " & Real'Image (Expected.Re) & |
" difference.re " & |
Real'Image (Actual.Re - Expected.Re) & |
" mre:" & Real'Image (Max_Error) ); |
elsif Verbose then |
if Actual = Expected then |
Report.Comment (Test_Name & " exact result for real part"); |
else |
Report.Comment (Test_Name & " passed for real part"); |
end if; |
end if; |
|
Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon; |
if Rel_Error > Abs_Error then |
Max_Error := Rel_Error; |
else |
Max_Error := Abs_Error; |
end if; |
if abs (Actual.Im - Expected.Im) > Max_Error then |
Failure_Detected := True; |
Report.Failed (Test_Name & |
" actual.im: " & Real'Image (Actual.Im) & |
" expected.im: " & Real'Image (Expected.Im) & |
" difference.im " & |
Real'Image (Actual.Im - Expected.Im) & |
" mre:" & Real'Image (Max_Error) ); |
elsif Verbose then |
if Actual = Expected then |
Report.Comment (Test_Name & " exact result for imaginary part"); |
else |
Report.Comment (Test_Name & " passed for imaginary part"); |
end if; |
end if; |
end Check; |
|
|
procedure Special_Values is |
begin |
|
--- test 1 --- |
declare |
T : constant := (Real'Machine_EMax - 1) / 2; |
Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T); |
Expected : Complex := (0.0, 0.0); |
X : Complex := (0.0, 0.0); |
Y : Complex := (Big, Big); |
Z : Complex; |
begin |
Z := X * Y; |
Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)", |
Mult_MBE); |
Z := Y * X; |
Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)", |
Mult_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 1"); |
when others => |
Report.Failed ("exception in test 1"); |
end; |
|
--- test 2 --- |
declare |
T : constant := Real'Model_EMin + 1; |
Tiny : constant := (1.0 * Real'Machine_Radix) ** T; |
U : Complex := (Tiny, Tiny); |
X : Complex := (0.0, 0.0); |
Expected : Complex := (0.0, 0.0); |
Z : Complex; |
begin |
Z := U * X; |
Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)", |
Mult_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 2"); |
when others => |
Report.Failed ("exception in test 2"); |
end; |
|
--- test 3 --- |
declare |
T : constant := (Real'Machine_EMax - 1) / 2; |
Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T); |
B : Complex := (Big, Big); |
X : Complex := (0.0, 0.0); |
Z : Complex; |
begin |
if Real'Machine_Overflows then |
Z := B / X; |
Report.Failed ("test 3 - Constraint_Error not raised"); |
Check (Z, Z, "not executed - optimizer thwarting", 0.0); |
end if; |
exception |
when Constraint_Error => null; -- expected |
when others => |
Report.Failed ("exception in test 3"); |
end; |
|
--- test 4 --- |
declare |
T : constant := Real'Model_EMin + 1; |
Tiny : constant := (1.0 * Real'Machine_Radix) ** T; |
U : Complex := (Tiny, Tiny); |
X : Complex := (0.0, 0.0); |
Z : Complex; |
begin |
if Real'Machine_Overflows then |
Z := U / X; |
Report.Failed ("test 4 - Constraint_Error not raised"); |
Check (Z, Z, "not executed - optimizer thwarting", 0.0); |
end if; |
exception |
when Constraint_Error => null; -- expected |
when others => |
Report.Failed ("exception in test 4"); |
end; |
|
|
--- test 5 --- |
declare |
X : Complex := (Sqrt2, Sqrt2); |
Z : Complex; |
Expected : constant Complex := (0.0, 4.0); |
begin |
Z := X * X; |
Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)", |
Mult_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 5"); |
when others => |
Report.Failed ("exception in test 5"); |
end; |
|
--- test 6 --- |
declare |
X : Complex := Sqrt3 - Sqrt3 * i; |
Z : Complex; |
Expected : constant Complex := (0.0, -6.0); |
begin |
Z := X * X; |
Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)", |
Mult_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 6"); |
when others => |
Report.Failed ("exception in test 6"); |
end; |
|
--- test 7 --- |
declare |
X : Complex := Sqrt2 + Sqrt2 * i; |
Y : Complex := Sqrt2 - Sqrt2 * i; |
Z : Complex; |
Expected : constant Complex := 0.0 + i; |
begin |
Z := X / Y; |
Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)", |
Divide_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 7"); |
when others => |
Report.Failed ("exception in test 7"); |
end; |
end Special_Values; |
|
|
procedure Do_Mult_Div (X, Y : Complex) is |
Z : Complex; |
Args : constant String := |
"X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " & |
"Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ; |
begin |
Z := (X * X) / X; |
Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE); |
Z := (X * Y) / X; |
Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE); |
Z := (X * Y) / Y; |
Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args); |
when others => |
Report.Failed ("exception in Do_Mult_Div for " & Args); |
end Do_Mult_Div; |
|
-- select complex values X and Y where the real and imaginary |
-- parts are selected from the ranges (1/radix..1) and |
-- (1..radix). This translates into quite a few combinations. |
procedure Mult_Div_Check is |
Samples : constant := 17; |
Radix : constant Real := Real(Real'Machine_Radix); |
Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix); |
Low_Sample : Real; -- (1/radix .. 1) |
High_Sample : Real; -- (1 .. radix) |
Sample : array (1..2) of Real; |
X, Y : Complex; |
begin |
for I in 1 .. Samples loop |
Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) + |
Inv_Radix; |
Sample (1) := Low_Sample; |
for J in 1 .. Samples loop |
High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) + |
Radix; |
Sample (2) := High_Sample; |
for K in 1 .. 2 loop |
for L in 1 .. 2 loop |
X := Complex'(Sample (K), Sample (L)); |
Y := Complex'(Sample (L), Sample (K)); |
Do_Mult_Div (X, Y); |
if Failure_Detected then |
return; -- minimize flood of error messages |
end if; |
end loop; |
end loop; |
end loop; -- J |
end loop; -- I |
end Mult_Div_Check; |
|
|
procedure Do_Test is |
begin |
Special_Values; |
Mult_Div_Check; |
end Do_Test; |
end A_Long_Float_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
package Non_Generic_Check is |
subtype Real is Float; |
procedure Do_Test; |
end Non_Generic_Check; |
|
package body Non_Generic_Check is |
|
use Ada.Numerics.Complex_Types; |
|
-- keep track if an accuracy failure has occurred so the test |
-- can be short-circuited to avoid thousands of error messages. |
Failure_Detected : Boolean := False; |
|
Mult_MBE : constant Real := 5.0; |
Divide_MBE : constant Real := 13.0; |
|
|
procedure Check (Actual, Expected : Complex; |
Test_Name : String; |
MBE : 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 := MBE * abs Expected.Re * Real'Model_Epsilon; |
Abs_Error := MBE * Real'Model_Epsilon; |
if Rel_Error > Abs_Error then |
Max_Error := Rel_Error; |
else |
Max_Error := Abs_Error; |
end if; |
|
if abs (Actual.Re - Expected.Re) > Max_Error then |
Failure_Detected := True; |
Report.Failed (Test_Name & |
" actual.re: " & Real'Image (Actual.Re) & |
" expected.re: " & Real'Image (Expected.Re) & |
" difference.re " & |
Real'Image (Actual.Re - Expected.Re) & |
" mre:" & Real'Image (Max_Error) ); |
elsif Verbose then |
if Actual = Expected then |
Report.Comment (Test_Name & " exact result for real part"); |
else |
Report.Comment (Test_Name & " passed for real part"); |
end if; |
end if; |
|
Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon; |
if Rel_Error > Abs_Error then |
Max_Error := Rel_Error; |
else |
Max_Error := Abs_Error; |
end if; |
if abs (Actual.Im - Expected.Im) > Max_Error then |
Failure_Detected := True; |
Report.Failed (Test_Name & |
" actual.im: " & Real'Image (Actual.Im) & |
" expected.im: " & Real'Image (Expected.Im) & |
" difference.im " & |
Real'Image (Actual.Im - Expected.Im) & |
" mre:" & Real'Image (Max_Error) ); |
elsif Verbose then |
if Actual = Expected then |
Report.Comment (Test_Name & " exact result for imaginary part"); |
else |
Report.Comment (Test_Name & " passed for imaginary part"); |
end if; |
end if; |
end Check; |
|
|
procedure Special_Values is |
begin |
|
--- test 1 --- |
declare |
T : constant := (Real'Machine_EMax - 1) / 2; |
Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T); |
Expected : Complex := (0.0, 0.0); |
X : Complex := (0.0, 0.0); |
Y : Complex := (Big, Big); |
Z : Complex; |
begin |
Z := X * Y; |
Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)", |
Mult_MBE); |
Z := Y * X; |
Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)", |
Mult_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 1"); |
when others => |
Report.Failed ("exception in test 1"); |
end; |
|
--- test 2 --- |
declare |
T : constant := Real'Model_EMin + 1; |
Tiny : constant := (1.0 * Real'Machine_Radix) ** T; |
U : Complex := (Tiny, Tiny); |
X : Complex := (0.0, 0.0); |
Expected : Complex := (0.0, 0.0); |
Z : Complex; |
begin |
Z := U * X; |
Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)", |
Mult_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 2"); |
when others => |
Report.Failed ("exception in test 2"); |
end; |
|
--- test 3 --- |
declare |
T : constant := (Real'Machine_EMax - 1) / 2; |
Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T); |
B : Complex := (Big, Big); |
X : Complex := (0.0, 0.0); |
Z : Complex; |
begin |
if Real'Machine_Overflows then |
Z := B / X; |
Report.Failed ("test 3 - Constraint_Error not raised"); |
Check (Z, Z, "not executed - optimizer thwarting", 0.0); |
end if; |
exception |
when Constraint_Error => null; -- expected |
when others => |
Report.Failed ("exception in test 3"); |
end; |
|
--- test 4 --- |
declare |
T : constant := Real'Model_EMin + 1; |
Tiny : constant := (1.0 * Real'Machine_Radix) ** T; |
U : Complex := (Tiny, Tiny); |
X : Complex := (0.0, 0.0); |
Z : Complex; |
begin |
if Real'Machine_Overflows then |
Z := U / X; |
Report.Failed ("test 4 - Constraint_Error not raised"); |
Check (Z, Z, "not executed - optimizer thwarting", 0.0); |
end if; |
exception |
when Constraint_Error => null; -- expected |
when others => |
Report.Failed ("exception in test 4"); |
end; |
|
|
--- test 5 --- |
declare |
X : Complex := (Sqrt2, Sqrt2); |
Z : Complex; |
Expected : constant Complex := (0.0, 4.0); |
begin |
Z := X * X; |
Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)", |
Mult_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 5"); |
when others => |
Report.Failed ("exception in test 5"); |
end; |
|
--- test 6 --- |
declare |
X : Complex := Sqrt3 - Sqrt3 * i; |
Z : Complex; |
Expected : constant Complex := (0.0, -6.0); |
begin |
Z := X * X; |
Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)", |
Mult_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 6"); |
when others => |
Report.Failed ("exception in test 6"); |
end; |
|
--- test 7 --- |
declare |
X : Complex := Sqrt2 + Sqrt2 * i; |
Y : Complex := Sqrt2 - Sqrt2 * i; |
Z : Complex; |
Expected : constant Complex := 0.0 + i; |
begin |
Z := X / Y; |
Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)", |
Divide_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in test 7"); |
when others => |
Report.Failed ("exception in test 7"); |
end; |
end Special_Values; |
|
|
procedure Do_Mult_Div (X, Y : Complex) is |
Z : Complex; |
Args : constant String := |
"X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " & |
"Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ; |
begin |
Z := (X * X) / X; |
Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE); |
Z := (X * Y) / X; |
Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE); |
Z := (X * Y) / Y; |
Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args); |
when others => |
Report.Failed ("exception in Do_Mult_Div for " & Args); |
end Do_Mult_Div; |
|
-- select complex values X and Y where the real and imaginary |
-- parts are selected from the ranges (1/radix..1) and |
-- (1..radix). This translates into quite a few combinations. |
procedure Mult_Div_Check is |
Samples : constant := 17; |
Radix : constant Real := Real(Real'Machine_Radix); |
Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix); |
Low_Sample : Real; -- (1/radix .. 1) |
High_Sample : Real; -- (1 .. radix) |
Sample : array (1..2) of Real; |
X, Y : Complex; |
begin |
for I in 1 .. Samples loop |
Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) + |
Inv_Radix; |
Sample (1) := Low_Sample; |
for J in 1 .. Samples loop |
High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) + |
Radix; |
Sample (2) := High_Sample; |
for K in 1 .. 2 loop |
for L in 1 .. 2 loop |
X := Complex'(Sample (K), Sample (L)); |
Y := Complex'(Sample (L), Sample (K)); |
Do_Mult_Div (X, Y); |
if Failure_Detected then |
return; -- minimize flood of error messages |
end if; |
end loop; |
end loop; |
end loop; -- J |
end loop; -- I |
end Mult_Div_Check; |
|
|
procedure Do_Test is |
begin |
Special_Values; |
Mult_Div_Check; |
end Do_Test; |
end Non_Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
begin |
Report.Test ("CXG2008", |
"Check the accuracy of the complex multiplication and" & |
" division operators"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking non-generic package"); |
end if; |
|
Non_Generic_Check.Do_Test; |
|
Report.Result; |
end CXG2008; |
/cxg2017.a
0,0 → 1,296
-- CXG2017.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 TANH function returns |
-- a result that is within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test consists of a generic package that is |
-- instantiated to check both Float and a long float type. |
-- The test for each floating point type is divided into |
-- several parts: |
-- Special value checks where the result is a known constant. |
-- Checks that use an identity for determining the result. |
-- |
-- 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: |
-- 20 Mar 96 SAIC Initial release for 2.1 |
-- 17 Aug 96 SAIC Incorporated reviewer comments. |
-- 03 Jun 98 EDS Add parens to remove the potential for overflow. |
-- Remove the invocation of Identity_Test that checks |
-- Tanh values that are too close to zero for the |
-- test's error bounds. |
--! |
|
-- |
-- References: |
-- |
-- Software Manual for the Elementary Functions |
-- William J. Cody, Jr. and William Waite |
-- Prentice-Hall, 1980 |
-- |
-- CRC Standard Mathematical Tables |
-- 23rd Edition |
-- |
-- Implementation and Testing of Function Software |
-- W. J. Cody |
-- 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 Ada.Numerics.Generic_Elementary_Functions; |
procedure CXG2017 is |
Verbose : constant Boolean := False; |
Max_Samples : constant := 1000; |
|
E : constant := Ada.Numerics.E; |
|
generic |
type Real is digits <>; |
package Generic_Check is |
procedure Do_Test; |
end Generic_Check; |
|
package body Generic_Check is |
package Elementary_Functions is new |
Ada.Numerics.Generic_Elementary_Functions (Real); |
|
function Tanh (X : Real) return Real renames |
Elementary_Functions.Tanh; |
|
function Log (X : Real) return Real renames |
Elementary_Functions.Log; |
|
-- flag used to terminate some tests early |
Accuracy_Error_Reported : Boolean := False; |
|
|
-- The following value is a lower bound on the accuracy |
-- required. It is normally 0.0 so that the lower bound |
-- is computed from Model_Epsilon. However, for tests |
-- where the expected result is only known to a certain |
-- amount of precision this bound takes on a non-zero |
-- value to account for that level of precision. |
Error_Low_Bound : Real := 0.0; |
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real) is |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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_Small instead |
-- of Model_Epsilon and Expected. |
Rel_Error := MRE * abs Expected * Real'Model_Epsilon; |
Abs_Error := MRE * Real'Model_Small; |
if Rel_Error > Abs_Error then |
Max_Error := Rel_Error; |
else |
Max_Error := Abs_Error; |
end if; |
-- take into account the low bound on the error |
if Max_Error < Error_Low_Bound then |
Max_Error := Error_Low_Bound; |
end if; |
|
if abs (Actual - Expected) > Max_Error then |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & 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_Value_Test is |
-- In the following tests the expected result is accurate |
-- to the machine precision so the minimum guaranteed error |
-- bound can be used. |
Minimum_Error : constant := 8.0; |
E2 : constant := E * E; |
begin |
Check (Tanh (1.0), |
(E - 1.0 / E) / (E + 1.0 / E), |
"tanh(1)", |
Minimum_Error); |
Check (Tanh (2.0), |
(E2 - 1.0 / E2) / (E2 + 1.0 / E2), |
"tanh(2)", |
Minimum_Error); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in special value test"); |
when others => |
Report.Failed ("exception in special value test"); |
end Special_Value_Test; |
|
|
|
procedure Exact_Result_Test is |
No_Error : constant := 0.0; |
begin |
-- A.5.1(38);6.0 |
Check (Tanh (0.0), 0.0, "tanh(0)", No_Error); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in Exact_Result Test"); |
when others => |
Report.Failed ("exception in Exact_Result Test"); |
end Exact_Result_Test; |
|
|
procedure Identity_Test (A, B : Real) is |
-- For this test we use the identity |
-- TANH(u+v) = [TANH(u) + TANH(v)] / [1 + TANH(u)*TANH(v)] |
-- which is transformed to |
-- TANH(x) = [TANH(y)+C] / [1 + TANH(y) * C] |
-- where C = TANH(1/8) and y = x - 1/8 |
-- |
-- see Cody pg 248-249 for details on the error analysis. |
-- The net result is a relative error bound of 16 * Model_Epsilon. |
-- |
-- The second part of this test checks the identity |
-- TANH(-x) = -TANH(X) |
|
X, Y : Real; |
Actual1, Actual2 : Real; |
C : constant := 1.2435300177159620805e-1; |
begin |
if Real'Digits > 20 then |
-- constant C is accurate to 20 digits. Set the low bound |
-- on the error to 16*10**-20 |
Error_Low_Bound := 0.00000_00000_00000_00016; |
Report.Comment ("tanh accuracy checked to 20 digits"); |
end if; |
|
Accuracy_Error_Reported := False; -- reset |
for I in 1..Max_Samples loop |
X := (B - A) * (Real (I) / Real (Max_Samples)) + A; |
Actual1 := Tanh(X); |
|
-- TANH(x) = [TANH(y)+C] / [1 + TANH(y) * C] |
Y := X - (1.0 / 8.0); |
Actual2 := (Tanh (Y) + C) / (1.0 + Tanh(Y) * C); |
|
Check (Actual1, Actual2, |
"Identity_1_Test " & Integer'Image (I) & ": tanh(" & |
Real'Image (X) & ") ", |
16.0); |
|
-- TANH(-x) = -TANH(X) |
Actual2 := Tanh(-X); |
Check (-Actual1, Actual2, |
"Identity_2_Test " & Integer'Image (I) & ": tanh(" & |
Real'Image (X) & ") ", |
16.0); |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
|
end loop; |
Error_Low_Bound := 0.0; -- reset |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Identity_Test" & |
" for X=" & Real'Image (X)); |
when others => |
Report.Failed ("exception in Identity_Test" & |
" for X=" & Real'Image (X)); |
end Identity_Test; |
|
|
|
procedure Do_Test is |
begin |
Special_Value_Test; |
Exact_Result_Test; |
-- cover a large range |
Identity_Test (1.0, Real'Safe_Last); |
end Do_Test; |
end Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
package Float_Check is new Generic_Check (Float); |
|
-- check the floating point type with the most digits |
type A_Long_Float is digits System.Max_Digits; |
package A_Long_Float_Check is new Generic_Check (A_Long_Float); |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
|
begin |
Report.Test ("CXG2017", |
"Check the accuracy of the TANH function"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
|
Report.Result; |
end CXG2017; |
/cxg2009.a
0,0 → 1,421
-- CXG2009.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 real sqrt and complex modulus functions |
-- return results that are within the allowed |
-- error bound. |
-- |
-- TEST DESCRIPTION: |
-- This test checks the accuracy of the sqrt and modulus functions |
-- by computing the norm of various vectors where the result |
-- is known in advance. |
-- This test uses real and complex math together as would an |
-- actual application. Considerable use of generics is also |
-- employed. |
-- |
-- 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: |
-- 26 FEB 96 SAIC Initial release for 2.1 |
-- 22 AUG 96 SAIC Revised Check procedure |
-- |
--! |
|
------------------------------------------------------------------------------ |
|
with System; |
with Report; |
with Ada.Numerics.Generic_Complex_Types; |
with Ada.Numerics.Generic_Elementary_Functions; |
procedure CXG2009 is |
Verbose : constant Boolean := False; |
|
--===================================================================== |
|
generic |
type Real is digits <>; |
package Generic_Real_Norm_Check is |
procedure Do_Test; |
end Generic_Real_Norm_Check; |
|
----------------------------------------------------------------------- |
|
package body Generic_Real_Norm_Check is |
type Vector is array (Integer range <>) of Real; |
|
package GEF is new Ada.Numerics.Generic_Elementary_Functions (Real); |
function Sqrt (X : Real) return Real renames GEF.Sqrt; |
|
function One_Norm (V : Vector) return Real is |
-- sum of absolute values of the elements of the vector |
Result : Real := 0.0; |
begin |
for I in V'Range loop |
Result := Result + abs V(I); |
end loop; |
return Result; |
end One_Norm; |
|
function Inf_Norm (V : Vector) return Real is |
-- greatest absolute vector element |
Result : Real := 0.0; |
begin |
for I in V'Range loop |
if abs V(I) > Result then |
Result := abs V(I); |
end if; |
end loop; |
return Result; |
end Inf_Norm; |
|
function Two_Norm (V : Vector) return Real is |
-- if greatest absolute vector element is 0 then return 0 |
-- else return greatest * sqrt (sum((element / greatest) ** 2))) |
-- where greatest is Inf_Norm of the vector |
Inf_N : Real; |
Sum_Squares : Real; |
Term : Real; |
begin |
Inf_N := Inf_Norm (V); |
if Inf_N = 0.0 then |
return 0.0; |
end if; |
Sum_Squares := 0.0; |
for I in V'Range loop |
Term := V (I) / Inf_N; |
Sum_Squares := Sum_Squares + Term * Term; |
end loop; |
return Inf_N * Sqrt (Sum_Squares); |
end Two_Norm; |
|
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real; |
Vector_Length : Integer) 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 & |
" VectLength:" & |
Integer'Image (Vector_Length) & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & |
Real'Image (Actual - Expected) & |
" mre:" & Real'Image (Max_Error) ); |
elsif Verbose then |
Report.Comment (Test_Name & " vector length" & |
Integer'Image (Vector_Length)); |
end if; |
end Check; |
|
|
procedure Do_Test is |
begin |
for Vector_Length in 1 .. 10 loop |
declare |
V : Vector (1..Vector_Length) := (1..Vector_Length => 0.0); |
V1 : Vector (1..Vector_Length) := (1..Vector_Length => 1.0); |
begin |
Check (One_Norm (V), 0.0, "one_norm (z)", 0.0, Vector_Length); |
Check (Inf_Norm (V), 0.0, "inf_norm (z)", 0.0, Vector_Length); |
|
for J in 1..Vector_Length loop |
V := (1..Vector_Length => 0.0); |
V (J) := 1.0; |
Check (One_Norm (V), 1.0, "one_norm (010)", |
0.0, Vector_Length); |
Check (Inf_Norm (V), 1.0, "inf_norm (010)", |
0.0, Vector_Length); |
Check (Two_Norm (V), 1.0, "two_norm (010)", |
0.0, Vector_Length); |
end loop; |
|
Check (One_Norm (V1), Real (Vector_Length), "one_norm (1)", |
0.0, Vector_Length); |
Check (Inf_Norm (V1), 1.0, "inf_norm (1)", |
0.0, Vector_Length); |
|
-- error in computing Two_Norm and expected result |
-- are as follows (ME is Model_Epsilon * Expected_Value): |
-- 2ME from expected Sqrt |
-- 2ME from Sqrt in Two_Norm times the error in the |
-- vector calculation. |
-- The vector calculation contains the following error |
-- based upon the length N of the vector: |
-- N*1ME from squaring terms in Two_Norm |
-- N*1ME from the division of each term in Two_Norm |
-- (N-1)*1ME from the sum of the terms |
-- This gives (2 + 2 * (N + N + (N-1)) ) * ME |
-- which simplifies to (2 + 2N + 2N + 2N - 2) * ME |
-- or 6*N*ME |
Check (Two_Norm (V1), Sqrt (Real(Vector_Length)), |
"two_norm (1)", |
(Real (6 * Vector_Length)), |
Vector_Length); |
exception |
when others => Report.Failed ("exception for vector length" & |
Integer'Image (Vector_Length) ); |
end; |
end loop; |
end Do_Test; |
end Generic_Real_Norm_Check; |
|
--===================================================================== |
|
generic |
type Real is digits <>; |
package Generic_Complex_Norm_Check is |
procedure Do_Test; |
end Generic_Complex_Norm_Check; |
|
----------------------------------------------------------------------- |
|
package body Generic_Complex_Norm_Check is |
package Complex_Types is new Ada.Numerics.Generic_Complex_Types (Real); |
use Complex_Types; |
type Vector is array (Integer range <>) of Complex; |
|
package GEF is new Ada.Numerics.Generic_Elementary_Functions (Real); |
function Sqrt (X : Real) return Real renames GEF.Sqrt; |
|
function One_Norm (V : Vector) return Real is |
Result : Real := 0.0; |
begin |
for I in V'Range loop |
Result := Result + abs V(I); |
end loop; |
return Result; |
end One_Norm; |
|
function Inf_Norm (V : Vector) return Real is |
Result : Real := 0.0; |
begin |
for I in V'Range loop |
if abs V(I) > Result then |
Result := abs V(I); |
end if; |
end loop; |
return Result; |
end Inf_Norm; |
|
function Two_Norm (V : Vector) return Real is |
Inf_N : Real; |
Sum_Squares : Real; |
Term : Real; |
begin |
Inf_N := Inf_Norm (V); |
if Inf_N = 0.0 then |
return 0.0; |
end if; |
Sum_Squares := 0.0; |
for I in V'Range loop |
Term := abs (V (I) / Inf_N ); |
Sum_Squares := Sum_Squares + Term * Term; |
end loop; |
return Inf_N * Sqrt (Sum_Squares); |
end Two_Norm; |
|
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real; |
Vector_Length : Integer) 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 & |
" VectLength:" & |
Integer'Image (Vector_Length) & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & |
Real'Image (Actual - Expected) & |
" mre:" & Real'Image (Max_Error) ); |
elsif Verbose then |
Report.Comment (Test_Name & " vector length" & |
Integer'Image (Vector_Length)); |
end if; |
end Check; |
|
|
procedure Do_Test is |
begin |
for Vector_Length in 1 .. 10 loop |
declare |
V : Vector (1..Vector_Length) := |
(1..Vector_Length => (0.0, 0.0)); |
X, Y : Vector (1..Vector_Length); |
begin |
Check (One_Norm (V), 0.0, "one_norm (z)", 0.0, Vector_Length); |
Check (Inf_Norm (V), 0.0, "inf_norm (z)", 0.0, Vector_Length); |
|
for J in 1..Vector_Length loop |
X := (1..Vector_Length => (0.0, 0.0) ); |
Y := X; -- X and Y are now both zeroed |
X (J).Re := 1.0; |
Y (J).Im := 1.0; |
Check (One_Norm (X), 1.0, "one_norm (0x0)", |
0.0, Vector_Length); |
Check (Inf_Norm (X), 1.0, "inf_norm (0x0)", |
0.0, Vector_Length); |
Check (Two_Norm (X), 1.0, "two_norm (0x0)", |
0.0, Vector_Length); |
Check (One_Norm (Y), 1.0, "one_norm (0y0)", |
0.0, Vector_Length); |
Check (Inf_Norm (Y), 1.0, "inf_norm (0y0)", |
0.0, Vector_Length); |
Check (Two_Norm (Y), 1.0, "two_norm (0y0)", |
0.0, Vector_Length); |
end loop; |
|
V := (1..Vector_Length => (3.0, 4.0)); |
|
-- error in One_Norm is 3*N*ME for abs computation + |
-- (N-1)*ME for the additions |
-- which gives (4N-1) * ME |
Check (One_Norm (V), 5.0 * Real (Vector_Length), |
"one_norm ((3,4))", |
Real (4*Vector_Length - 1), |
Vector_Length); |
|
-- error in Inf_Norm is from abs of single element (3ME) |
Check (Inf_Norm (V), 5.0, |
"inf_norm ((3,4))", |
3.0, |
Vector_Length); |
|
-- error in following comes from: |
-- 2ME in sqrt of expected result |
-- 3ME in Inf_Norm calculation |
-- 2ME in sqrt of vector calculation |
-- vector calculation has following error |
-- 3N*ME for abs |
-- N*ME for squaring |
-- N*ME for division |
-- (N-1)ME for sum |
-- this results in [2 + 3 + 2(6N-1) ] * ME |
-- or (12N + 3)ME |
Check (Two_Norm (V), 5.0 * Sqrt (Real(Vector_Length)), |
"two_norm ((3,4))", |
(12.0 * Real (Vector_Length) + 3.0), |
Vector_Length); |
exception |
when others => Report.Failed ("exception for complex " & |
"vector length" & |
Integer'Image (Vector_Length) ); |
end; |
end loop; |
end Do_Test; |
end Generic_Complex_Norm_Check; |
|
--===================================================================== |
|
generic |
type Real is digits <>; |
package Generic_Norm_Check is |
procedure Do_Test; |
end Generic_Norm_Check; |
|
----------------------------------------------------------------------- |
|
package body Generic_Norm_Check is |
package RNC is new Generic_Real_Norm_Check (Real); |
package CNC is new Generic_Complex_Norm_Check (Real); |
procedure Do_Test is |
begin |
RNC.Do_Test; |
CNC.Do_Test; |
end Do_Test; |
end Generic_Norm_Check; |
|
--===================================================================== |
|
package Float_Check is new Generic_Norm_Check (Float); |
|
type A_Long_Float is digits System.Max_Digits; |
package A_Long_Float_Check is new Generic_Norm_Check (A_Long_Float); |
|
----------------------------------------------------------------------- |
|
begin |
Report.Test ("CXG2009", |
"Check the accuracy of the real sqrt and complex " & |
" modulus functions"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
Report.Result; |
end CXG2009; |
/cxg2018.a
0,0 → 1,355
-- CXG2018.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 EXP function returns |
-- a result that is within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test consists of a generic package that is |
-- instantiated to check complex numbers based upon |
-- both Float and a long float type. |
-- The test for each floating point type is divided into |
-- several parts: |
-- Special value checks where the result is a known constant. |
-- Checks that use an identity for determining the result. |
-- |
-- 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: |
-- 21 Mar 96 SAIC Initial release for 2.1 |
-- 17 Aug 96 SAIC Incorporated reviewer comments. |
-- 27 Aug 99 RLB Repair on the error result of checks. |
-- 02 Apr 03 RLB Added code to discard excess precision in the |
-- construction of the test value for the |
-- Identity_Test. |
-- |
--! |
|
-- |
-- References: |
-- |
-- W. J. Cody |
-- CELEFUNT: A Portable Test Package for Complex Elementary Functions |
-- Algorithm 714, Collected Algorithms from ACM. |
-- Published in Transactions On Mathematical Software, |
-- Vol. 19, No. 1, March, 1993, pp. 1-21. |
-- |
-- CRC Standard Mathematical Tables |
-- 23rd Edition |
-- |
|
with System; |
with Report; |
with Ada.Numerics.Generic_Complex_Types; |
with Ada.Numerics.Generic_Complex_Elementary_Functions; |
procedure CXG2018 is |
Verbose : constant Boolean := False; |
-- Note that Max_Samples is the number of samples taken in |
-- both the real and imaginary directions. Thus, for Max_Samples |
-- of 100 the number of values checked is 10000. |
Max_Samples : constant := 100; |
|
E : constant := Ada.Numerics.E; |
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_Type is new |
Ada.Numerics.Generic_Complex_Types (Real); |
use Complex_Type; |
|
package CEF is new |
Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type); |
|
function Exp (X : Complex) return Complex renames CEF.Exp; |
function Exp (X : Imaginary) return Complex renames CEF.Exp; |
|
-- flag used to terminate some tests early |
Accuracy_Error_Reported : Boolean := False; |
|
|
-- The following value is a lower bound on the accuracy |
-- required. It is normally 0.0 so that the lower bound |
-- is computed from Model_Epsilon. However, for tests |
-- where the expected result is only known to a certain |
-- amount of precision this bound takes on a non-zero |
-- value to account for that level of precision. |
Error_Low_Bound : Real := 0.0; |
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real) is |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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_Small instead |
-- of Model_Epsilon and Expected. |
Rel_Error := MRE * abs Expected * Real'Model_Epsilon; |
Abs_Error := MRE * Real'Model_Small; |
if Rel_Error > Abs_Error then |
Max_Error := Rel_Error; |
else |
Max_Error := Abs_Error; |
end if; |
|
-- take into account the low bound on the error |
if Max_Error < Error_Low_Bound then |
Max_Error := Error_Low_Bound; |
end if; |
|
if abs (Actual - Expected) > Max_Error then |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & 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 Check (Actual, Expected : Complex; |
Test_Name : String; |
MRE : Real) is |
begin |
Check (Actual.Re, Expected.Re, Test_Name & " real part", MRE); |
Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", MRE); |
end Check; |
|
|
procedure Special_Value_Test is |
-- In the following tests the expected result is accurate |
-- to the machine precision so the minimum guaranteed error |
-- bound can be used. |
-- |
-- The error bounds given assumed z is exact. When using |
-- pi there is an extra error of 1.0ME. |
-- The pi inside the exp call requires that the complex |
-- component have an extra error allowance of 1.0*angle*ME. |
-- Thus for pi/2,the Minimum_Error_I is |
-- (2.0 + 1.0(pi/2))ME <= 3.6ME. |
-- For pi, it is (2.0 + 1.0*pi)ME <= 5.2ME, |
-- and for 2pi, it is (2.0 + 1.0(2pi))ME <= 8.3ME. |
|
-- The addition of 1 or i to a result is so that neither of |
-- the components of an expected result is 0. This is so |
-- that a reasonable relative error is allowed. |
Minimum_Error_C : constant := 7.0; -- for exp(Complex) |
Minimum_Error_I : constant := 2.0; -- for exp(Imaginary) |
begin |
Check (Exp (1.0 + 0.0*i) + i, |
E + i, |
"exp(1+0i)", |
Minimum_Error_C); |
Check (Exp ((Pi / 2.0) * i) + 1.0, |
1.0 + 1.0*i, |
"exp(pi/2*i)", |
3.6); |
Check (Exp (Pi * i) + i, |
-1.0 + 1.0*i, |
"exp(pi*i)", |
5.2); |
Check (Exp (Pi * 2.0 * i) + i, |
1.0 + i, |
"exp(2pi*i)", |
8.3); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in special value test"); |
when others => |
Report.Failed ("exception in special value test"); |
end Special_Value_Test; |
|
|
|
procedure Exact_Result_Test is |
No_Error : constant := 0.0; |
begin |
-- G.1.2(36);6.0 |
Check (Exp(0.0 + 0.0*i), 1.0 + 0.0 * i, "exp(0+0i)", No_Error); |
Check (Exp( 0.0*i), 1.0 + 0.0 * i, "exp(0i)", No_Error); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in Exact_Result Test"); |
when others => |
Report.Failed ("exception in Exact_Result Test"); |
end Exact_Result_Test; |
|
|
procedure Identity_Test (A, B : Real) is |
-- For this test we use the identity |
-- Exp(Z) = Exp(Z-W) * Exp (W) |
-- where W = (1+i)/16 |
-- |
-- The second part of this test checks the identity |
-- Exp(Z) * Exp(-Z) = 1 |
-- |
|
X, Y : Complex; |
Actual1, Actual2 : Complex; |
W : constant Complex := (0.0625, 0.0625); |
-- the following constant was taken from the CELEFUNC EXP test. |
-- This is the value EXP(W) - 1 |
C : constant Complex := (6.2416044877018563681e-2, |
6.6487597751003112768e-2); |
begin |
if Real'Digits > 20 then |
-- constant ExpW is accurate to 20 digits. |
-- The low bound is 19 * 10**-20 |
Error_Low_Bound := 0.00000_00000_00019; |
Report.Comment ("complex exp accuracy checked to 20 digits"); |
end if; |
|
Accuracy_Error_Reported := False; -- reset |
for II in 1..Max_Samples loop |
X.Re := Real'Machine ((B - A) * Real (II) / Real (Max_Samples) |
+ A); |
for J in 1..Max_Samples loop |
X.Im := Real'Machine ((B - A) * Real (J) / Real (Max_Samples) |
+ A); |
|
Actual1 := Exp(X); |
|
-- Exp(X) = Exp(X-W) * Exp (W) |
-- = Exp(X-W) * (1 - (1-Exp(W)) |
-- = Exp(X-W) * (1 + (Exp(W) - 1)) |
-- = Exp(X-W) * (1 + C) |
Y := X - W; |
Actual2 := Exp(Y); |
Actual2 := Actual2 + Actual2 * C; |
|
Check (Actual1, Actual2, |
"Identity_1_Test " & Integer'Image (II) & |
Integer'Image (J) & ": Exp((" & |
Real'Image (X.Re) & ", " & |
Real'Image (X.Im) & ")) ", |
20.0); -- 2 exp and 1 multiply and 1 add = 2*7+1*5+1 |
-- Note: The above is not strictly correct, as multiply |
-- has a box error, rather than a relative error. |
-- Supposedly, the interval is chosen to avoid the need |
-- to worry about this. |
|
-- Exp(X) * Exp(-X) + i = 1 + i |
-- The addition of i is to allow a reasonable relative |
-- error in the imaginary part |
Actual2 := (Actual1 * Exp(-X)) + i; |
Check (Actual2, (1.0, 1.0), |
"Identity_2_Test " & Integer'Image (II) & |
Integer'Image (J) & ": Exp((" & |
Real'Image (X.Re) & ", " & |
Real'Image (X.Im) & ")) ", |
20.0); -- 2 exp and 1 multiply and one add = 2*7+1*5+1 |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
end loop; |
end loop; |
Error_Low_Bound := 0.0; |
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Identity_Test" & |
" for X=(" & Real'Image (X.Re) & |
", " & Real'Image (X.Im) & ")"); |
when others => |
Report.Failed ("exception in Identity_Test" & |
" for X=(" & Real'Image (X.Re) & |
", " & Real'Image (X.Im) & ")"); |
end Identity_Test; |
|
|
|
procedure Do_Test is |
begin |
Special_Value_Test; |
Exact_Result_Test; |
-- test regions where we can avoid cancellation error problems |
-- See Cody page 10. |
Identity_Test (0.0625, 1.0); |
Identity_Test (15.0, 17.0); |
Identity_Test (1.625, 3.0); |
end Do_Test; |
end Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
package Float_Check is new Generic_Check (Float); |
|
-- check the floating point type with the most digits |
type A_Long_Float is digits System.Max_Digits; |
package A_Long_Float_Check is new Generic_Check (A_Long_Float); |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
|
begin |
Report.Test ("CXG2018", |
"Check the accuracy of the complex EXP function"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
|
Report.Result; |
end CXG2018; |
/cxg2019.a
0,0 → 1,338
-- CXG2019.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 LOG function returns |
-- a result that is within the error bound allowed. |
-- |
-- TEST DESCRIPTION: |
-- This test consists of a generic package that is |
-- instantiated to check complex numbers based upon |
-- both Float and a long float type. |
-- The test for each floating point type is divided into |
-- several parts: |
-- Special value checks where the result is a known constant. |
-- Checks that use an identity for determining the result. |
-- Exception conditions. |
-- |
-- 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: |
-- 22 Mar 96 SAIC Initial release for 2.1 |
-- |
--! |
|
-- |
-- References: |
-- |
-- W. J. Cody |
-- CELEFUNT: A Portable Test Package for Complex Elementary Functions |
-- Algorithm 714, Collected Algorithms from ACM. |
-- Published in Transactions On Mathematical Software, |
-- Vol. 19, No. 1, March, 1993, pp. 1-21. |
-- |
-- CRC Standard Mathematical Tables |
-- 23rd Edition |
-- |
|
with System; |
with Report; |
with Ada.Numerics.Generic_Complex_Types; |
with Ada.Numerics.Generic_Complex_Elementary_Functions; |
procedure CXG2019 is |
Verbose : constant Boolean := False; |
-- Note that Max_Samples is the number of samples taken in |
-- both the real and imaginary directions. Thus, for Max_Samples |
-- of 100 the number of values checked is 10000. |
Max_Samples : constant := 100; |
|
E : constant := Ada.Numerics.E; |
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_Type is new |
Ada.Numerics.Generic_Complex_Types (Real); |
use Complex_Type; |
|
package CEF is new |
Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type); |
|
function Log (X : Complex) return Complex renames CEF.Log; |
|
-- flag used to terminate some tests early |
Accuracy_Error_Reported : Boolean := False; |
|
|
procedure Check (Actual, Expected : Real; |
Test_Name : String; |
MRE : Real) is |
Max_Error : Real; |
Rel_Error : Real; |
Abs_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_Small 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 |
Accuracy_Error_Reported := True; |
Report.Failed (Test_Name & |
" actual: " & Real'Image (Actual) & |
" expected: " & Real'Image (Expected) & |
" difference: " & Real'Image (Actual - Expected) & |
" max err:" & 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 Check (Actual, Expected : Complex; |
Test_Name : String; |
MRE : Real) is |
begin |
Check (Actual.Re, Expected.Re, Test_Name & " real part", MRE); |
Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", MRE); |
end Check; |
|
|
procedure Special_Value_Test is |
-- In the following tests the expected result is accurate |
-- to the machine precision so the minimum guaranteed error |
-- bound can be used if the argument is exact. |
-- |
-- When using pi there is an extra error of 1.0ME. |
-- Although the real component has an error bound of 13.0, |
-- the complex component must take into account this error |
-- in the value for Pi. |
-- |
-- One or i is added to the actual and expected results in |
-- order to prevent the expected result from having a |
-- real or imaginary part of 0. This is to allow a reasonable |
-- relative error for that component. |
Minimum_Error : constant := 13.0; |
begin |
Check (1.0 + Log (0.0 + i), |
1.0 + Pi / 2.0 * i, |
"1+log(0+i)", |
Minimum_Error + 1.0); |
Check (1.0 + Log ((-1.0, 0.0)), |
1.0 + (Pi * i), |
"log(-1+0i)+1 ", |
Minimum_Error + 1.0); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in special value test"); |
when others => |
Report.Failed ("exception in special value test"); |
end Special_Value_Test; |
|
|
|
procedure Exact_Result_Test is |
No_Error : constant := 0.0; |
begin |
-- G.1.2(37);6.0 |
Check (Log(1.0 + 0.0*i), 0.0 + 0.0 * i, "log(1+0i)", No_Error); |
exception |
when Constraint_Error => |
Report.Failed ("Constraint_Error raised in Exact_Result Test"); |
when others => |
Report.Failed ("exception in Exact_Result Test"); |
end Exact_Result_Test; |
|
|
procedure Identity_Test (RA, RB, IA, IB : Real) is |
-- Tests an identity over a range of values specified |
-- by the 4 parameters. RA and RB denote the range for the |
-- real part while IA and IB denote the range for the |
-- imaginary part. |
-- |
-- For this test we use the identity |
-- Log(Z*Z) = 2 * Log(Z) |
-- |
|
Scale : Real := Real (Real'Machine_Radix) ** (Real'Mantissa / 2 + 4); |
W, X, Y, Z : Real; |
CX, CY : Complex; |
Actual1, Actual2 : Complex; |
begin |
Accuracy_Error_Reported := False; -- reset |
for II in 1..Max_Samples loop |
X := (RB - RA) * Real (II) / Real (Max_Samples) + RA; |
for J in 1..Max_Samples loop |
Y := (IB - IA) * Real (J) / Real (Max_Samples) + IA; |
|
-- purify the arguments to minimize roundoff error. |
-- We construct the values so that the products X*X, |
-- Y*Y, and X*Y are all exact machine numbers. |
-- See Cody page 7 and CELEFUNT code. |
Z := X * Scale; |
W := Z + X; |
X := W - Z; |
Z := Y * Scale; |
W := Z + Y; |
Y := W - Z; |
CX := Compose_From_Cartesian(X,Y); |
Z := X*X - Y*Y; |
W := X*Y; |
CY := Compose_From_Cartesian(Z,W+W); |
|
-- The arguments are now ready so on with the |
-- identity computation. |
Actual1 := Log(CX); |
|
Actual2 := Log(CY) * 0.5; |
|
Check (Actual1, Actual2, |
"Identity_1_Test " & Integer'Image (II) & |
Integer'Image (J) & ": Log((" & |
Real'Image (CX.Re) & ", " & |
Real'Image (CX.Im) & ")) ", |
26.0); -- 2 logs = 2*13. no error from this multiply |
|
if Accuracy_Error_Reported then |
-- only report the first error in this test in order to keep |
-- lots of failures from producing a huge error log |
return; |
end if; |
end loop; |
end loop; |
|
exception |
when Constraint_Error => |
Report.Failed |
("Constraint_Error raised in Identity_Test" & |
" for X=(" & Real'Image (X) & |
", " & Real'Image (X) & ")"); |
when others => |
Report.Failed ("exception in Identity_Test" & |
" for X=(" & Real'Image (X) & |
", " & Real'Image (X) & ")"); |
end Identity_Test; |
|
|
procedure Exception_Test is |
-- Check that log((0,0)) causes constraint_error. |
-- G.1.2(29); |
|
X : Complex := (0.0, 0.0); |
begin |
if not Real'Machine_Overflows then |
-- not applicable: G.1.2(28);6.0 |
return; |
end if; |
|
begin |
X := Log ((0.0, 0.0)); |
Report.Failed ("exception not raised for log(0,0)"); |
exception |
when Constraint_Error => null; -- ok |
when others => |
Report.Failed ("wrong exception raised for log(0,0)"); |
end; |
|
-- optimizer thwarting |
if Report.Ident_Bool(False) then |
Report.Comment (Real'Image (X.Re + X.Im)); |
end if; |
end Exception_Test; |
|
|
procedure Do_Test is |
begin |
Special_Value_Test; |
Exact_Result_Test; |
-- test regions that do not include the unit circle so that |
-- the real part of LOG(Z) does not vanish |
-- See Cody page 9. |
Identity_Test ( 2.0, 10.0, 0.0, 10.0); |
Identity_Test (1000.0, 2000.0, -4000.0, -1000.0); |
Identity_Test (Real'Model_Epsilon, 0.25, |
-0.25, -Real'Model_Epsilon); |
Exception_Test; |
end Do_Test; |
end Generic_Check; |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
package Float_Check is new Generic_Check (Float); |
|
-- check the floating point type with the most digits |
type A_Long_Float is digits System.Max_Digits; |
package A_Long_Float_Check is new Generic_Check (A_Long_Float); |
|
----------------------------------------------------------------------- |
----------------------------------------------------------------------- |
|
|
begin |
Report.Test ("CXG2019", |
"Check the accuracy of the complex LOG function"); |
|
if Verbose then |
Report.Comment ("checking Standard.Float"); |
end if; |
|
Float_Check.Do_Test; |
|
if Verbose then |
Report.Comment ("checking a digits" & |
Integer'Image (System.Max_Digits) & |
" floating point type"); |
end if; |
|
A_Long_Float_Check.Do_Test; |
|
|
Report.Result; |
end CXG2019; |