diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxg/cxg2001.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cxg/cxg2001.a | 322 |
1 files changed, 0 insertions, 322 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2001.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2001.a deleted file mode 100644 index 0d7afa46091..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2001.a +++ /dev/null @@ -1,322 +0,0 @@ --- 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; |