OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxg/] [cxg2012.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CXG2012.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 the exponentiation operator returns
28
--      results that are within the error bound allowed.
29
--
30
-- TEST DESCRIPTION:
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
34
--      several parts:
35
--         Special value checks where the result is a known constant.
36
--         Checks that use an identity for determining the result.
37
--         Exception checks.
38
--      While this test concentrates on the "**" operator
39
--      defined in Generic_Elementary_Functions, a check is also
40
--      performed on the standard "**" operator.
41
--
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.
46
--
47
-- APPLICABILITY CRITERIA:
48
--      This test applies only to implementations supporting the
49
--      Numerics Annex.
50
--      This test only applies to the Strict Mode for numerical
51
--      accuracy.
52
--
53
--
54
-- CHANGE HISTORY:
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.
62
--
63
--!
64
 
65
--
66
-- References:
67
--
68
-- Software Manual for the Elementary Functions
69
-- William J. Cody, Jr. and William Waite
70
-- Prentice-Hall, 1980
71
--
72
-- CRC Standard Mathematical Tables
73
-- 23rd Edition
74
--
75
-- Implementation and Testing of Function Software
76
-- W. J. Cody
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
81
--
82
 
83
with System;
84
with Report;
85
with Ada.Numerics.Generic_Elementary_Functions;
86
procedure CXG2012 is
87
   Verbose : constant Boolean := False;
88
   Max_Samples : constant := 1000;
89
 
90
   -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
91
   Sqrt2 : constant :=
92
        1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
93
   Sqrt3 : constant :=
94
        1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
95
 
96
 
97
   generic
98
      type Real is digits <>;
99
   package Generic_Check is
100
      procedure Do_Test;
101
   end Generic_Check;
102
 
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."**";
114
 
115
      -- flag used to terminate some tests early
116
      Accuracy_Error_Reported : Boolean := False;
117
 
118
 
119
 
120
      procedure Check (Actual, Expected : Real;
121
                       Test_Name : String;
122
                       MRE : Real) is
123
         Max_Error : Real;
124
         Rel_Error : Real;
125
         Abs_Error : Real;
126
      begin
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;
134
         else
135
            Max_Error := Abs_Error;
136
         end if;
137
 
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) );
145
         elsif Verbose then
146
            if Actual = Expected then
147
               Report.Comment (Test_Name & "  exact result");
148
            else
149
               Report.Comment (Test_Name & "  passed");
150
            end if;
151
         end if;
152
      end Check;
153
 
154
 
155
      -- the following version of Check computes the allowed error bound
156
      -- using the operands
157
      procedure Check (Actual, Expected : Real;
158
                       Left, Right : Real;
159
                       Test_Name : String;
160
                       MRE_Factor : Real := 1.0) is
161
         MRE : Real;
162
      begin
163
         MRE := MRE_Factor * (4.0 + abs (Right * Log(Left)) / 32.0);
164
         Check (Actual, Expected, Test_Name, MRE);
165
      end Check;
166
 
167
 
168
      procedure Real_To_Integer_Test is
169
         type Int_Check is
170
            record
171
               Left : Real;
172
               Right : Integer;
173
               Expected : Real;
174
            end record;
175
         type Int_Checks is array (Positive range <>) of Int_Check;
176
 
177
         -- the following tests use only model numbers so the result
178
         -- is expected to be exact.
179
         IC : constant Int_Checks :=
180
         ( (  2.0,   5,       32.0),
181
           ( -2.0,   5,      -32.0),
182
           (  0.5,  -5,       32.0),
183
           (  2.0,   0,        1.0),
184
           (  0.0,   0,        1.0) );
185
      begin
186
         for I in IC'Range loop
187
            declare
188
               Y : Real;
189
            begin
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
196
            exception
197
               when Constraint_Error =>
198
                  Report.Failed ("Constraint_Error raised in rtoi test " &
199
                     Integer'Image (I));
200
               when others =>
201
                  Report.Failed ("exception in rtoi test " &
202
                     Integer'Image (I));
203
            end;
204
         end loop;
205
      end Real_To_Integer_Test;
206
 
207
 
208
      procedure Special_Value_Test is
209
         No_Error : constant := 0.0;
210
      begin
211
         Check (0.0 ** 1.0, 0.0, "0**1", No_Error);
212
         Check (1.0 ** 0.0, 1.0, "1**0", No_Error);
213
 
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");
216
 
217
         Check (Sqrt2 ** 4.0,   4.0,  Sqrt2, 4.0,  "Sqrt2**4");
218
         Check (Sqrt3 ** 6.0,  27.0,  Sqrt3, 6.0,  "Sqrt3**6");
219
 
220
         Check (2.0 ** 0.5,   Sqrt2,    2.0, 0.5,  "2.0**0.5");
221
 
222
      exception
223
         when Constraint_Error =>
224
            Report.Failed ("Constraint_Error raised in Special Value Test");
225
         when others =>
226
            Report.Failed ("exception in Special Value Test");
227
      end Special_Value_Test;
228
 
229
 
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;
234
         X : Real;
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
242
      begin
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);
246
 
247
            Check (X ** 1.0, X,  -- exact result required
248
                   "Small range" & Integer'Image (I) & ": " &
249
                   Real'Image (X) & " ** 1.0",
250
                   0.0);
251
 
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",
255
                   1.25);
256
 
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
261
 
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
266
 
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
270
              return;
271
            end if;
272
 
273
         end loop;
274
 
275
      exception
276
         when Constraint_Error =>
277
            Report.Failed
278
               ("Constraint_Error raised in Small Range Test");
279
         when others =>
280
            Report.Failed ("exception in Small Range Test");
281
      end Small_Range_Test;
282
 
283
 
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;
288
         B : Real;
289
         X : Real;
290
         Iteration : Integer := 0;
291
         Subtest : Character := 'X';
292
      begin
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
298
            Iteration := I;
299
            Subtest := 'X';
300
            X :=  Real'Machine((B - A) * (Real (I) / Real (Max_Samples)) + A);
301
 
302
            Subtest := 'A';
303
            Check (X ** 1.0, X,  -- exact result required
304
                   "Large range" & Integer'Image (I) & ": " &
305
                   Real'Image (X) & " ** 1.0",
306
                   0.0);
307
 
308
            Subtest := 'B';
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
313
 
314
            Subtest := 'C';
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
319
 
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
323
              return;
324
            end if;
325
 
326
         end loop;
327
      exception
328
         when Constraint_Error =>
329
            Report.Failed
330
               ("Constraint_Error raised in Large Range Test" &
331
                Integer'Image (Iteration) & Subtest);
332
         when others =>
333
            Report.Failed ("exception in Large Range Test" &
334
                Integer'Image (Iteration) & Subtest);
335
      end Large_Range_Test;
336
 
337
 
338
      procedure Exception_Test is
339
         X1, X2, X3, X4 : Real;
340
      begin
341
         begin
342
            X1 := 0.0 ** (-1.0);
343
            Report.Failed ("exception not raised for 0**-1");
344
         exception
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
349
            when others =>
350
               Report.Failed ("wrong exception raised for 0**-1");
351
         end;
352
 
353
         begin
354
            X2 := 0.0 ** 0.0;
355
            Report.Failed ("exception not raised for 0**0");
356
         exception
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");
361
            when others =>
362
               Report.Failed ("wrong exception raised for 0**0");
363
         end;
364
 
365
         begin
366
            X3 := (-1.0) ** 1.0;
367
            Report.Failed ("exception not raised for -1**1");
368
         exception
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");
373
            when others =>
374
               Report.Failed ("wrong exception raised for -1**1");
375
         end;
376
 
377
         begin
378
            X4 := (-2.0) ** 2.0;
379
            Report.Failed ("exception not raised for -2**2");
380
         exception
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");
385
            when others =>
386
               Report.Failed ("wrong exception raised for -2**2");
387
         end;
388
 
389
         -- optimizer thwarting
390
         if Report.Ident_Bool (False) then
391
            Report.Comment (Real'Image (X1+X2+X3+X4));
392
         end if;
393
      end Exception_Test;
394
 
395
 
396
      procedure Do_Test is
397
      begin
398
         Real_To_Integer_Test;
399
         Special_Value_Test;
400
         Small_Range_Test;
401
         Large_Range_Test;
402
         Exception_Test;
403
      end Do_Test;
404
   end Generic_Check;
405
 
406
   -----------------------------------------------------------------------
407
   -----------------------------------------------------------------------
408
   package Float_Check is new Generic_Check (Float);
409
 
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);
413
 
414
   -----------------------------------------------------------------------
415
   -----------------------------------------------------------------------
416
 
417
 
418
begin
419
   Report.Test ("CXG2012",
420
                "Check the accuracy of the ** operator");
421
 
422
   if Verbose then
423
      Report.Comment ("checking Standard.Float");
424
   end if;
425
 
426
   Float_Check.Do_Test;
427
 
428
   if Verbose then
429
      Report.Comment ("checking a digits" &
430
                      Integer'Image (System.Max_Digits) &
431
                      " floating point type");
432
   end if;
433
 
434
   A_Long_Float_Check.Do_Test;
435
 
436
 
437
   Report.Result;
438
end CXG2012;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.