1-- CXG2005.A
2--
3--                             Grant of Unlimited Rights
4--
5--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7--     unlimited rights in the software and documentation contained herein.
8--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
9--     this public release, the Government intends to confer upon all
10--     recipients unlimited rights  equal to those held by the Government.
11--     These rights include rights to use, duplicate, release or disclose the
12--     released technical data and computer software in whole or in part, in
13--     any manner and for any purpose whatsoever, and to have or permit others
14--     to do so.
15--
16--                                    DISCLAIMER
17--
18--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23--     PARTICULAR PURPOSE OF SAID MATERIAL.
24--*
25--
26-- OBJECTIVE:
27--      Check that floating point addition and multiplication
28--      have the required accuracy.
29--
30-- TEST DESCRIPTION:
31--      The check for the required precision is essentially a
32--      check that a guard digit is used for the operations.
33--      This test uses a generic package to check the addition
34--      and multiplication results.  The
35--      generic package is instantiated with the standard FLOAT
36--      type and a floating point type for the maximum number
37--      of digits of precision.
38--
39-- APPLICABILITY CRITERIA:
40--      This test applies only to implementations supporting the
41--      Numerics Annex.
42--
43--
44-- CHANGE HISTORY:
45--      14 FEB 96   SAIC    Initial Release for 2.1
46--      16 SEP 99   RLB     Repaired to avoid printing thousands of (almost)
47--                          identical failure messages.
48--!
49
50-- References:
51--
52--    Basic Concepts for Computational Software
53--    W. J. Cody
54--    Problems and Methodologies in Mathematical Software Production
55--    editors P. C. Messina and A. Murli
56--    Lecture Notes in Computer Science   Vol 142
57--    Springer Verlag,  1982
58--
59--    Software Manual for the Elementary Functions
60--    William J. Cody and William Waite
61--    Prentice-Hall, 1980
62--
63
64with System;
65with Report;
66procedure CXG2005 is
67   Verbose : constant Boolean := False;
68
69   generic
70      type Real is digits <>;
71   package Guard_Digit_Check is
72      procedure Do_Test;
73   end Guard_Digit_Check;
74
75   package body Guard_Digit_Check is
76      -- made global so that the compiler will be more likely
77      -- to keep the values in memory instead of in higher
78      -- precision registers.
79      X, Y, Z : Real;
80      OneX : Real;
81      Eps, BN : Real;
82
83      -- special constants - not declared as constants so that
84      -- the "stored" precision will be used instead of a "register"
85      -- precision.
86      Zero : Real := 0.0;
87      One  : Real := 1.0;
88      Two  : Real := 2.0;
89
90      Failure_Count : Natural := 0;
91
92      procedure Thwart_Optimization is
93      -- the purpose of this procedure is to reference the
94      -- global variables used by the test so
95      -- that the compiler is not likely to keep them in
96      -- a higher precision register for their entire lifetime.
97      begin
98	 if Report.Ident_Bool (False) then
99	    -- never executed
100	    X := X + 5.0;
101	    Y := Y + 6.0;
102	    Z := Z + 1.0;
103	    Eps := Eps + 2.0;
104	    BN := BN + 2.0;
105            OneX := X + Y;
106            One := 12.34;   Two := 56.78;  Zero := 90.12;
107	 end if;
108      end Thwart_Optimization;
109
110
111      procedure Addition_Test is
112      begin
113         for K in 1..10 loop
114	    Eps := Real (K) * Real'Model_Epsilon;
115	    for N in 1.. Real'Machine_EMax - 1 loop
116	       BN := Real(Real'Machine_Radix) ** N;
117	       X := (One + Eps) * BN;
118	       Y := (One - Eps) * BN;
119	       Z := X - Y; -- true value for Z is 2*Eps*BN
120
121	       if Z /= Eps*BN + Eps*BN then
122		  Report.Failed ("addition check failed.  K=" &
123		     Integer'Image (K) &
124		     "  N=" & Integer'Image (N) &
125		     "  difference=" & Real'Image (Z - 2.0*Eps*BN) &
126		     "  Eps*BN=" & Real'Image (Eps*BN) );
127                  Failure_Count := Failure_Count + 1;
128                  exit when Failure_Count > K*4; -- Avoid displaying dozens of messages.
129	       end if;
130	    end loop;
131	 end loop;
132      exception
133	 when others =>
134	    Thwart_Optimization;
135            Report.Failed ("unexpected exception in addition test");
136      end Addition_Test;
137
138
139      procedure Multiplication_Test is
140      begin
141	  X := Real (Real'Machine_Radix) ** (Real'Machine_EMax - 1);
142	  OneX := One * X;
143	  Thwart_Optimization;
144	  if OneX /= X then
145	     Report.Failed ("multiplication for large values");
146	  end if;
147
148	  X := Real (Real'Machine_Radix) ** (Real'Model_EMin + 1);
149	  OneX := One * X;
150	  Thwart_Optimization;
151	  if OneX /= X then
152	     Report.Failed ("multiplication for small values");
153	  end if;
154
155	  -- selection of "random" values between 1/radix and radix
156          Y := One / Real (Real'Machine_Radix);
157          Z := Real(Real'Machine_Radix) - One/Real(Real'Machine_Radix);
158	  for I in 0..100 loop
159	     X := Y + Real (I) / 100.0 * Z;
160	     OneX := One * X;
161	     Thwart_Optimization;
162	     if OneX /= X then
163                Report.Failed ("multiplication for case" & Integer'Image (I));
164                exit when Failure_Count > 40+8; -- Avoid displaying dozens of messages.
165	     end if;
166	  end loop;
167      exception
168	 when others =>
169	    Thwart_Optimization;
170            Report.Failed ("unexpected exception in multiplication test");
171      end Multiplication_Test;
172
173
174      procedure Do_Test is
175      begin
176         Addition_Test;
177         Multiplication_Test;
178      end Do_Test;
179   end Guard_Digit_Check;
180
181   package Chk_Float is new Guard_Digit_Check (Float);
182
183   -- check the floating point type with the most digits
184   type A_Long_Float is digits System.Max_Digits;
185   package Chk_A_Long_Float is new Guard_Digit_Check (A_Long_Float);
186begin
187   Report.Test ("CXG2005",
188                "Check the accuracy of floating point" &
189                " addition and multiplication");
190
191   if Verbose then
192      Report.Comment ("checking Standard.Float");
193   end if;
194   Chk_Float.Do_Test;
195
196   if Verbose then
197      Report.Comment ("checking a digits" &
198                      Integer'Image (System.Max_Digits) &
199                      " floating point type");
200   end if;
201   Chk_A_Long_Float.Do_Test;
202
203   Report.Result;
204end CXG2005;
205