3 -- Grant of Unlimited Rights
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
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.
27 -- Check that the exponentiation operator returns
28 -- results that are within the error bound allowed.
31 -- This test consists of a generic package that is
32 -- instantiated to check both Float and a long float type.
33 -- The test for each floating point type is divided into
35 -- Special value checks where the result is a known constant.
36 -- Checks that use an identity for determining the result.
38 -- While this test concentrates on the "**" operator
39 -- defined in Generic_Elementary_Functions, a check is also
40 -- performed on the standard "**" operator.
42 -- SPECIAL REQUIREMENTS
43 -- The Strict Mode for the numerical accuracy must be
44 -- selected. The method by which this mode is selected
45 -- is implementation dependent.
47 -- APPLICABILITY CRITERIA:
48 -- This test applies only to implementations supporting the
50 -- This test only applies to the Strict Mode for numerical
55 -- 7 Mar 96 SAIC Initial release for 2.1
56 -- 2 Sep 96 SAIC Improvements as suggested by reviewers
57 -- 3 Jun 98 EDS Add parens to ensure that the expression is not
58 -- evaluated by multiplying its two large terms
59 -- together and overflowing.
60 -- 3 Dec 01 RLB Added 'Machine to insure that equality tests
61 -- are certain to work.
68 -- Software Manual for the Elementary Functions
69 -- William J. Cody, Jr. and William Waite
70 -- Prentice-Hall, 1980
72 -- CRC Standard Mathematical Tables
75 -- Implementation and Testing of Function Software
77 -- Problems and Methodologies in Mathematical Software Production
78 -- editors P. C. Messina and A. Murli
79 -- Lecture Notes in Computer Science Volume 142
80 -- Springer Verlag, 1982
85 with Ada
.Numerics
.Generic_Elementary_Functions
;
87 Verbose
: constant Boolean := False;
88 Max_Samples
: constant := 1000;
90 -- CRC Standard Mathematical Tables; 23rd Edition; pg 738
92 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695
;
94 1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039
;
98 type Real
is digits <>;
99 package Generic_Check
is
103 package body Generic_Check
is
104 package Elementary_Functions
is new
105 Ada
.Numerics
.Generic_Elementary_Functions
(Real
);
106 function Sqrt
(X
: Real
) return Real
renames
107 Elementary_Functions
.Sqrt
;
108 function Exp
(X
: Real
) return Real
renames
109 Elementary_Functions
.Exp
;
110 function Log
(X
: Real
) return Real
renames
111 Elementary_Functions
.Log
;
112 function "**" (L
, R
: Real
) return Real
renames
113 Elementary_Functions
."**";
115 -- flag used to terminate some tests early
116 Accuracy_Error_Reported
: Boolean := False;
120 procedure Check
(Actual
, Expected
: Real
;
127 -- In the case where the expected result is very small or 0
128 -- we compute the maximum error as a multiple of Model_Epsilon
129 -- instead of Model_Epsilon and Expected.
130 Rel_Error
:= MRE
* (abs Expected
* Real
'Model_Epsilon);
131 Abs_Error
:= MRE
* Real
'Model_Epsilon;
132 if Rel_Error
> Abs_Error
then
133 Max_Error
:= Rel_Error
;
135 Max_Error
:= Abs_Error
;
138 if abs (Actual
- Expected
) > Max_Error
then
139 Accuracy_Error_Reported
:= True;
140 Report
.Failed
(Test_Name
&
141 " actual: " & Real
'Image (Actual
) &
142 " expected: " & Real
'Image (Expected
) &
143 " difference: " & Real
'Image (Actual
- Expected
) &
144 " max err:" & Real
'Image (Max_Error
) );
146 if Actual
= Expected
then
147 Report
.Comment
(Test_Name
& " exact result");
149 Report
.Comment
(Test_Name
& " passed");
155 -- the following version of Check computes the allowed error bound
156 -- using the operands
157 procedure Check
(Actual
, Expected
: Real
;
160 MRE_Factor
: Real
:= 1.0) is
163 MRE
:= MRE_Factor
* (4.0 + abs (Right
* Log
(Left
)) / 32.0);
164 Check
(Actual
, Expected
, Test_Name
, MRE
);
168 procedure Real_To_Integer_Test
is
175 type Int_Checks
is array (Positive range <>) of Int_Check
;
177 -- the following tests use only model numbers so the result
178 -- is expected to be exact.
179 IC
: constant Int_Checks
:=
186 for I
in IC
'Range loop
190 Y
:= IC
(I
).Left
** IC
(I
).Right
;
191 Check
(Y
, IC
(I
).Expected
,
192 "real to integer test" &
193 Real
'Image (IC
(I
).Left
) & " ** " &
194 Integer'Image (IC
(I
).Right
),
195 0.0); -- no error allowed
197 when Constraint_Error
=>
198 Report
.Failed
("Constraint_Error raised in rtoi test " &
201 Report
.Failed
("exception in rtoi test " &
205 end Real_To_Integer_Test
;
208 procedure Special_Value_Test
is
209 No_Error
: constant := 0.0;
211 Check
(0.0 ** 1.0, 0.0, "0**1", No_Error
);
212 Check
(1.0 ** 0.0, 1.0, "1**0", No_Error
);
214 Check
( 2.0 ** 5.0, 32.0, 2.0, 5.0, "2**5");
215 Check
( 0.5**(-5.0), 32.0, 0.5, -5.0, "0.5**-5");
217 Check
(Sqrt2
** 4.0, 4.0, Sqrt2
, 4.0, "Sqrt2**4");
218 Check
(Sqrt3
** 6.0, 27.0, Sqrt3
, 6.0, "Sqrt3**6");
220 Check
(2.0 ** 0.5, Sqrt2
, 2.0, 0.5, "2.0**0.5");
223 when Constraint_Error
=>
224 Report
.Failed
("Constraint_Error raised in Special Value Test");
226 Report
.Failed
("exception in Special Value Test");
227 end Special_Value_Test
;
230 procedure Small_Range_Test
is
231 -- Several checks over the range 1/radix .. 1
232 A
: constant Real
:= 1.0 / Real
(Real
'Machine_Radix);
233 B
: constant Real
:= 1.0;
235 -- In the cases below where the expected result is
236 -- inexact we allow an additional error amount of
237 -- 1.0 * Model_Epsilon to account for that error.
238 -- This is accomplished by the factor of 1.25 times
239 -- the computed error bound (which is > 4.0) thus
240 -- increasing the error bound by at least
241 -- 1.0 * Model_Epsilon
243 Accuracy_Error_Reported
:= False; -- reset
244 for I
in 0..Max_Samples
loop
245 X
:= Real
'Machine((B
- A
) * Real
(I
) / Real
(Max_Samples
) + A
);
247 Check
(X
** 1.0, X
, -- exact result required
248 "Small range" & Integer'Image (I
) & ": " &
249 Real
'Image (X
) & " ** 1.0",
252 Check
((X
*X
) ** 1.5, X
**3, X
*X
, 1.5,
253 "Small range" & Integer'Image (I
) & ": " &
254 Real
'Image (X
*X
) & " ** 1.5",
257 Check
(X
** 13.5, 1.0 / (X
** (-13.5)), X
, 13.5,
258 "Small range" & Integer'Image (I
) & ": " &
259 Real
'Image (X
) & " ** 13.5",
260 2.0); -- 2 ** computations
262 Check
((X
*X
) ** 1.25, X
**(2.5), X
*X
, 1.25,
263 "Small range" & Integer'Image (I
) & ": " &
264 Real
'Image (X
*X
) & " ** 1.25",
265 2.0); -- 2 ** computations
267 if Accuracy_Error_Reported
then
268 -- only report the first error in this test in order to keep
269 -- lots of failures from producing a huge error log
276 when Constraint_Error
=>
278 ("Constraint_Error raised in Small Range Test");
280 Report
.Failed
("exception in Small Range Test");
281 end Small_Range_Test
;
284 procedure Large_Range_Test
is
285 -- Check over the range A to B where A is 1.0 and
286 -- B is a large value.
287 A
: constant Real
:= 1.0;
290 Iteration
: Integer := 0;
291 Subtest
: Character := 'X';
293 -- upper bound of range should be as large as possible where
294 -- B**3 is still valid.
295 B
:= Real
'Safe_Last ** 0.333;
296 Accuracy_Error_Reported
:= False; -- reset
297 for I
in 0..Max_Samples
loop
300 X
:= Real
'Machine((B
- A
) * (Real
(I
) / Real
(Max_Samples
)) + A
);
303 Check
(X
** 1.0, X
, -- exact result required
304 "Large range" & Integer'Image (I
) & ": " &
305 Real
'Image (X
) & " ** 1.0",
309 Check
((X
*X
) ** 1.5, X
**3, X
*X
, 1.5,
310 "Large range" & Integer'Image (I
) & ": " &
311 Real
'Image (X
*X
) & " ** 1.5",
312 1.25); -- inexact expected result
315 Check
((X
*X
) ** 1.25, X
**(2.5), X
*X
, 1.25,
316 "Large range" & Integer'Image (I
) & ": " &
317 Real
'Image (X
*X
) & " ** 1.25",
318 2.0); -- two ** operators
320 if Accuracy_Error_Reported
then
321 -- only report the first error in this test in order to keep
322 -- lots of failures from producing a huge error log
328 when Constraint_Error
=>
330 ("Constraint_Error raised in Large Range Test" &
331 Integer'Image (Iteration
) & Subtest
);
333 Report
.Failed
("exception in Large Range Test" &
334 Integer'Image (Iteration
) & Subtest
);
335 end Large_Range_Test
;
338 procedure Exception_Test
is
339 X1
, X2
, X3
, X4
: Real
;
343 Report
.Failed
("exception not raised for 0**-1");
345 when Ada
.Numerics
.Argument_Error
=>
346 Report
.Failed
("argument_error raised instead of" &
347 " constraint_error for 0**-1");
348 when Constraint_Error
=> null; -- ok
350 Report
.Failed
("wrong exception raised for 0**-1");
355 Report
.Failed
("exception not raised for 0**0");
357 when Ada
.Numerics
.Argument_Error
=> null; -- ok
358 when Constraint_Error
=>
359 Report
.Failed
("constraint_error raised instead of" &
360 " argument_error for 0**0");
362 Report
.Failed
("wrong exception raised for 0**0");
367 Report
.Failed
("exception not raised for -1**1");
369 when Ada
.Numerics
.Argument_Error
=> null; -- ok
370 when Constraint_Error
=>
371 Report
.Failed
("constraint_error raised instead of" &
372 " argument_error for -1**1");
374 Report
.Failed
("wrong exception raised for -1**1");
379 Report
.Failed
("exception not raised for -2**2");
381 when Ada
.Numerics
.Argument_Error
=> null; -- ok
382 when Constraint_Error
=>
383 Report
.Failed
("constraint_error raised instead of" &
384 " argument_error for -2**2");
386 Report
.Failed
("wrong exception raised for -2**2");
389 -- optimizer thwarting
390 if Report
.Ident_Bool
(False) then
391 Report
.Comment
(Real
'Image (X1
+X2
+X3
+X4
));
398 Real_To_Integer_Test
;
406 -----------------------------------------------------------------------
407 -----------------------------------------------------------------------
408 package Float_Check
is new Generic_Check
(Float);
410 -- check the floating point type with the most digits
411 type A_Long_Float
is digits System
.Max_Digits
;
412 package A_Long_Float_Check
is new Generic_Check
(A_Long_Float
);
414 -----------------------------------------------------------------------
415 -----------------------------------------------------------------------
419 Report
.Test
("CXG2012",
420 "Check the accuracy of the ** operator");
423 Report
.Comment
("checking Standard.Float");
429 Report
.Comment
("checking a digits" &
430 Integer'Image (System
.Max_Digits
) &
431 " floating point type");
434 A_Long_Float_Check
.Do_Test
;