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/] [cxg2016.a] - Blame information for rev 154

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CXG2016.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 ARCTAN function returns a
28
--      result that is 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
--         Exception checks.
37
--
38
-- SPECIAL REQUIREMENTS
39
--      The Strict Mode for the numerical accuracy must be
40
--      selected.  The method by which this mode is selected
41
--      is implementation dependent.
42
--
43
-- APPLICABILITY CRITERIA:
44
--      This test applies only to implementations supporting the
45
--      Numerics Annex.
46
--      This test only applies to the Strict Mode for numerical
47
--      accuracy.
48
--
49
--
50
-- CHANGE HISTORY:
51
--      19 Mar 96   SAIC    Initial release for 2.1
52
--      30 APR 96   SAIC    Fixed optimization issue
53
--      17 AUG 96   SAIC    Incorporated Reviewer's suggestions.
54
--      12 OCT 96   SAIC    Incorporated Reviewer's suggestions.
55
--      02 DEC 97   EDS     Remove procedure Identity_1_Test and calls to
56
--                          procedure.
57
--      29 JUN 98   EDS     Replace -0.0 with call to ImpDef.Annex_G.Negative_Zero
58
--      28 APR 99   RLB     Replaced comma accidentally deleted in above change.
59
--      15 DEC 99   RLB     Added model range checking to "exact" results,
60
--                          in order to avoid too strictly requiring a specific
61
--                          result.
62
--!
63
 
64
--
65
-- References:
66
--
67
-- Software Manual for the Elementary Functions
68
-- William J. Cody, Jr. and William Waite
69
-- Prentice-Hall, 1980
70
--
71
-- CRC Standard Mathematical Tables
72
-- 23rd Edition
73
--
74
-- Implementation and Testing of Function Software
75
-- W. J. Cody
76
-- Problems and Methodologies in Mathematical Software Production
77
-- editors P. C. Messina and A. Murli
78
-- Lecture Notes in Computer Science   Volume 142
79
-- Springer Verlag, 1982
80
--
81
 
82
with System;
83
with Report;
84
with Ada.Numerics.Generic_Elementary_Functions;
85
with Impdef.Annex_G;
86
procedure CXG2016 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
   Pi : constant := Ada.Numerics.Pi;
97
 
98
   generic
99
      type Real is digits <>;
100
      Half_PI_Low : in Real; -- The machine number closest to, but not greater
101
                             -- than PI/2.0.
102
      Half_PI_High : in Real;-- The machine number closest to, but not less
103
                             -- than PI/2.0.
104
      PI_Low : in Real;      -- The machine number closest to, but not greater
105
                             -- than PI.
106
      PI_High : in Real;     -- The machine number closest to, but not less
107
                             -- than PI.
108
   package Generic_Check is
109
      procedure Do_Test;
110
   end Generic_Check;
111
 
112
   package body Generic_Check is
113
      package Elementary_Functions is new
114
           Ada.Numerics.Generic_Elementary_Functions (Real);
115
 
116
      function Arctan (Y : Real;
117
                       X : Real := 1.0) return Real renames
118
           Elementary_Functions.Arctan;
119
      function Arctan (Y : Real;
120
                       X : Real := 1.0;
121
                       Cycle : Real) return Real renames
122
           Elementary_Functions.Arctan;
123
 
124
      -- flag used to terminate some tests early
125
      Accuracy_Error_Reported : Boolean := False;
126
 
127
      -- The following value is a lower bound on the accuracy
128
      -- required.  It is normally 0.0 so that the lower bound
129
      -- is computed from Model_Epsilon.  However, for tests
130
      -- where the expected result is only known to a certain
131
      -- amount of precision this bound takes on a non-zero
132
      -- value to account for that level of precision.
133
      Error_Low_Bound : Real := 0.0;
134
 
135
      procedure Check (Actual, Expected : Real;
136
                       Test_Name : String;
137
                       MRE : Real) is
138
         Max_Error : Real;
139
         Rel_Error : Real;
140
         Abs_Error : Real;
141
      begin
142
         -- In the case where the expected result is very small or 0
143
         -- we compute the maximum error as a multiple of Model_Epsilon
144
         -- instead of Model_Epsilon and Expected.
145
         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
146
         Abs_Error := MRE * Real'Model_Epsilon;
147
         if Rel_Error > Abs_Error then
148
            Max_Error := Rel_Error;
149
         else
150
            Max_Error := Abs_Error;
151
         end if;
152
 
153
         -- take into account the low bound on the error
154
         if Max_Error < Error_Low_Bound then
155
            Max_Error := Error_Low_Bound;
156
         end if;
157
 
158
         if abs (Actual - Expected) > Max_Error then
159
            Accuracy_Error_Reported := True;
160
            Report.Failed (Test_Name &
161
                           " actual: " & Real'Image (Actual) &
162
                           " expected: " & Real'Image (Expected) &
163
                           " difference: " & Real'Image (Actual - Expected) &
164
                           " max err:" & Real'Image (Max_Error) );
165
         elsif Verbose then
166
            if Actual = Expected then
167
               Report.Comment (Test_Name & "  exact result");
168
            else
169
               Report.Comment (Test_Name & "  passed");
170
            end if;
171
         end if;
172
      end Check;
173
 
174
 
175
      procedure Special_Value_Test is
176
      -- If eta is very small, arctan(x + eta) ~= arctan(x) + eta/(1+x*x).
177
      --
178
      -- For tests 4 and 5, there is an error of 4.0ME for arctan + an
179
      -- additional error of 1.0ME because pi is not exact for a total of 5.0ME.
180
      --
181
      -- In test 3 there is the error for pi plus an additional error
182
      -- of (1.0ME)/4 since sqrt3 is not exact, for a total of 5.25ME.
183
      --
184
      -- In test 2 there is the error for pi plus an additional error
185
      -- of (3/4)(1.0ME) since sqrt3 is not exact, for a total of 5.75ME.
186
 
187
 
188
         type Data_Point is
189
            record
190
               Degrees,
191
               Radians,
192
               Tangent,
193
               Allowed_Error : Real;
194
            end record;
195
 
196
         type Test_Data_Type is array (Positive range <>) of Data_Point;
197
 
198
         -- the values in the following table only involve static
199
         -- expressions so no additional loss of precision occurs.
200
         Test_Data : constant Test_Data_Type := (
201
         --  degrees      radians       tangent   error     test #
202
            (  0.0,           0.0,          0.0,   4.0 ),    -- 1
203
            ( 30.0,        Pi/6.0,    Sqrt3/3.0,   5.75),    -- 2
204
            ( 60.0,        Pi/3.0,        Sqrt3,   5.25),    -- 3
205
            ( 45.0,        Pi/4.0,          1.0,   5.0 ),    -- 4
206
            (-45.0,       -Pi/4.0,         -1.0,   5.0 ) );  -- 5
207
 
208
      begin
209
         for I in Test_Data'Range loop
210
            Check (Arctan (Test_Data (I).Tangent),
211
                   Test_Data (I).Radians,
212
                   "special value test" & Integer'Image (I) &
213
                      " arctan(" &
214
                      Real'Image (Test_Data (I).Tangent) &
215
                      ")",
216
                   Test_Data (I).Allowed_Error);
217
            Check (Arctan (Test_Data (I).Tangent, Cycle => 360.0),
218
                   Test_Data (I).Degrees,
219
                   "special value test" & Integer'Image (I) &
220
                      " arctan(" &
221
                      Real'Image (Test_Data (I).Tangent) &
222
                      ", cycle=>360)",
223
                   Test_Data (I).Allowed_Error);
224
         end loop;
225
 
226
      exception
227
         when Constraint_Error =>
228
            Report.Failed ("Constraint_Error raised in special value test");
229
         when others =>
230
            Report.Failed ("exception in special value test");
231
      end Special_Value_Test;
232
 
233
 
234
 
235
      procedure Check_Exact (Actual, Expected_Low, Expected_High : Real;
236
                             Test_Name : String) is
237
         -- If the expected result is not a model number, then Expected_Low is
238
         -- the first machine number less than the (exact) expected
239
         -- result, and Expected_High is the first machine number greater than
240
         -- the (exact) expected result. If the expected result is a model
241
         -- number, Expected_Low = Expected_High = the result.
242
         Model_Expected_Low  : Real := Expected_Low;
243
         Model_Expected_High : Real := Expected_High;
244
      begin
245
         -- Calculate the first model number nearest to, but below (or equal)
246
         -- to the expected result:
247
         while Real'Model (Model_Expected_Low) /= Model_Expected_Low loop
248
            -- Try the next machine number lower:
249
            Model_Expected_Low := Real'Adjacent(Model_Expected_Low, 0.0);
250
         end loop;
251
         -- Calculate the first model number nearest to, but above (or equal)
252
         -- to the expected result:
253
         while Real'Model (Model_Expected_High) /= Model_Expected_High loop
254
            -- Try the next machine number higher:
255
            Model_Expected_High := Real'Adjacent(Model_Expected_High, 100.0);
256
         end loop;
257
 
258
         if Actual < Model_Expected_Low or Actual > Model_Expected_High then
259
            Accuracy_Error_Reported := True;
260
            if Actual < Model_Expected_Low then
261
               Report.Failed (Test_Name &
262
                              " actual: " & Real'Image (Actual) &
263
                              " expected low: " & Real'Image (Model_Expected_Low) &
264
                              " expected high: " & Real'Image (Model_Expected_High) &
265
                              " difference: " & Real'Image (Actual - Expected_Low));
266
            else
267
               Report.Failed (Test_Name &
268
                              " actual: " & Real'Image (Actual) &
269
                              " expected low: " & Real'Image (Model_Expected_Low) &
270
                              " expected high: " & Real'Image (Model_Expected_High) &
271
                              " difference: " & Real'Image (Expected_High - Actual));
272
            end if;
273
         elsif Verbose then
274
            Report.Comment (Test_Name & "  passed");
275
         end if;
276
      end Check_Exact;
277
 
278
 
279
      procedure Exact_Result_Test is
280
      begin
281
         --  A.5.1(40);6.0
282
         Check_Exact (Arctan (0.0, 1.0),       0.0, 0.0, "arctan(0,1)");
283
         Check_Exact (Arctan (0.0, 1.0, 27.0), 0.0, 0.0, "arctan(0,1,27)");
284
 
285
         --  G.2.4(11-13);6.0
286
 
287
         Check_Exact (Arctan (1.0, 0.0), Half_PI_Low, Half_PI_High,
288
              "arctan(1,0)");
289
         Check_Exact (Arctan (1.0, 0.0, 360.0), 90.0, 90.0, "arctan(1,0,360)");
290
 
291
         Check_Exact (Arctan (-1.0, 0.0), -Half_PI_High, -Half_PI_Low,
292
              "arctan(-1,0)");
293
         Check_Exact (Arctan (-1.0, 0.0, 360.0), -90.0, -90.0,
294
              "arctan(-1,0,360)");
295
 
296
         if Real'Signed_Zeros then
297
            Check_Exact (Arctan (0.0, -1.0), PI_Low, PI_High, "arctan(+0,-1)");
298
            Check_Exact (Arctan (0.0, -1.0, 360.0), 180.0, 180.0,
299
                  "arctan(+0,-1,360)");
300
            Check_Exact (Arctan ( Real ( ImpDef.Annex_G.Negative_Zero ), -1.0),
301
                   -PI_High, -PI_Low, "arctan(-0,-1)");
302
            Check_Exact (Arctan ( Real ( ImpDef.Annex_G.Negative_Zero ), -1.0,
303
                   360.0), -180.0, -180.0, "arctan(-0,-1,360)");
304
         else
305
            Check_Exact (Arctan (0.0, -1.0), PI_Low, PI_High, "arctan(0,-1)");
306
            Check_Exact (Arctan (0.0, -1.0, 360.0), 180.0, 180.0,
307
                   "arctan(0,-1,360)");
308
         end if;
309
      exception
310
         when Constraint_Error =>
311
            Report.Failed ("Constraint_Error raised in Exact_Result Test");
312
         when others =>
313
            Report.Failed ("Exception in Exact_Result Test");
314
      end Exact_Result_Test;
315
 
316
 
317
      procedure Taylor_Series_Test is
318
      -- This test checks the Arctan by using a taylor series expansion that
319
      -- will produce a result accurate to 19 decimal digits for
320
      -- the range under test.
321
      --
322
      -- The maximum relative error bound for this test is
323
      --  4 for the arctan operation and 2 for the Taylor series
324
      -- for a total of 6 * Model_Epsilon
325
 
326
         A : constant := -1.0/16.0;
327
         B : constant :=  1.0/16.0;
328
         X : Real;
329
         Actual, Expected : Real;
330
         Sum, Em, X_Squared : Real;
331
      begin
332
         if Real'Digits > 19 then
333
            -- Taylor series calculation produces result accurate to 19
334
            -- digits.  If type being tested has more digits then set
335
            -- the error low bound to account for this.
336
            -- The error low bound is conservatively set to 6*10**-19
337
            Error_Low_Bound := 0.00000_00000_00000_0006;
338
            Report.Comment ("arctan accuracy checked to 19 digits");
339
         end if;
340
 
341
         Accuracy_Error_Reported := False;  -- reset
342
         for I in 0..Max_Samples loop
343
            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
344
            X_Squared := X * X;
345
            Em := 17.0;
346
            Sum := X_Squared / Em;
347
 
348
            for II in 1 .. 7 loop
349
               Em := Em - 2.0;
350
               Sum := (1.0 / Em - Sum) * X_Squared;
351
            end loop;
352
            Sum := -X * Sum;
353
            Expected := X + Sum;
354
            Sum := (X - Expected) + Sum;
355
            if not Real'Machine_Rounds then
356
               Expected := Expected + (Sum + Sum);
357
            end if;
358
 
359
            Actual := Arctan (X);
360
 
361
            Check (Actual, Expected,
362
                   "Taylor_Series_Test " & Integer'Image (I) & ": arctan(" &
363
                   Real'Image (X) & ") ",
364
                   6.0);
365
 
366
            if Accuracy_Error_Reported then
367
              -- only report the first error in this test in order to keep
368
              -- lots of failures from producing a huge error log
369
              return;
370
            end if;
371
 
372
         end loop;
373
         Error_Low_Bound := 0.0;  -- reset
374
      exception
375
         when Constraint_Error =>
376
            Report.Failed
377
               ("Constraint_Error raised in Taylor_Series_Test");
378
         when others =>
379
            Report.Failed ("exception in Taylor_Series_Test");
380
      end Taylor_Series_Test;
381
 
382
 
383
      procedure Exception_Test is
384
         X1, X2, X3 : Real := 0.0;
385
      begin
386
 
387
         begin  -- A.5.1(20);6.0
388
           X1 := Arctan(0.0, Cycle => 0.0);
389
           Report.Failed ("no exception for cycle = 0.0");
390
         exception
391
            when Ada.Numerics.Argument_Error => null;
392
            when others =>
393
               Report.Failed ("wrong exception for cycle = 0.0");
394
         end;
395
 
396
         begin  -- A.5.1(20);6.0
397
           X2 := Arctan (0.0, Cycle => -1.0);
398
           Report.Failed ("no exception for cycle < 0.0");
399
         exception
400
            when Ada.Numerics.Argument_Error => null;
401
            when others =>
402
               Report.Failed ("wrong exception for cycle < 0.0");
403
         end;
404
 
405
         begin  -- A.5.1(25);6.0
406
           X3 := Arctan (0.0, 0.0);
407
           Report.Failed ("no exception for arctan(0,0)");
408
         exception
409
            when Ada.Numerics.Argument_Error => null;
410
            when others =>
411
               Report.Failed ("wrong exception for arctan(0,0)");
412
         end;
413
 
414
         -- optimizer thwarting
415
         if Report.Ident_Bool (False) then
416
            Report.Comment (Real'Image (X1 + X2 + X3));
417
         end if;
418
      end Exception_Test;
419
 
420
 
421
      procedure Do_Test is
422
      begin
423
         Special_Value_Test;
424
         Exact_Result_Test;
425
         Taylor_Series_Test;
426
         Exception_Test;
427
      end Do_Test;
428
   end Generic_Check;
429
 
430
   -----------------------------------------------------------------------
431
   -----------------------------------------------------------------------
432
   -- These expressions must be truly static, which is why we have to do them
433
   -- outside of the generic, and we use the named numbers. Note that we know
434
   -- that PI is not a machine number (it is irrational), and it should be
435
   -- represented to more digits than supported by the target machine.
436
   Float_Half_PI_Low  : constant := Float'Adjacent(PI/2.0,  0.0);
437
   Float_Half_PI_High : constant := Float'Adjacent(PI/2.0, 10.0);
438
   Float_PI_Low       : constant := Float'Adjacent(PI,      0.0);
439
   Float_PI_High      : constant := Float'Adjacent(PI,     10.0);
440
   package Float_Check is new Generic_Check (Float,
441
        Half_PI_Low  => Float_Half_PI_Low,
442
        Half_PI_High => Float_Half_PI_High,
443
        PI_Low  => Float_PI_Low,
444
        PI_High => Float_PI_High);
445
 
446
   -- check the Floating point type with the most digits
447
   type A_Long_Float is digits System.Max_Digits;
448
   A_Long_Float_Half_PI_Low  : constant := A_Long_Float'Adjacent(PI/2.0,  0.0);
449
   A_Long_Float_Half_PI_High : constant := A_Long_Float'Adjacent(PI/2.0, 10.0);
450
   A_Long_Float_PI_Low       : constant := A_Long_Float'Adjacent(PI,      0.0);
451
   A_Long_Float_PI_High      : constant := A_Long_Float'Adjacent(PI,     10.0);
452
   package A_Long_Float_Check is new Generic_Check (A_Long_Float,
453
        Half_PI_Low  => A_Long_Float_Half_PI_Low,
454
        Half_PI_High => A_Long_Float_Half_PI_High,
455
        PI_Low  => A_Long_Float_PI_Low,
456
        PI_High => A_Long_Float_PI_High);
457
 
458
   -----------------------------------------------------------------------
459
   -----------------------------------------------------------------------
460
 
461
 
462
begin
463
   Report.Test ("CXG2016",
464
                "Check the accuracy of the ARCTAN function");
465
 
466
   if Verbose then
467
      Report.Comment ("checking Standard.Float");
468
   end if;
469
 
470
   Float_Check.Do_Test;
471
 
472
   if Verbose then
473
      Report.Comment ("checking a digits" &
474
                      Integer'Image (System.Max_Digits) &
475
                      " floating point type");
476
   end if;
477
 
478
   A_Long_Float_Check.Do_Test;
479
 
480
 
481
   Report.Result;
482
end CXG2016;

powered by: WebSVN 2.1.0

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