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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CXG2015.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 ARCSIN and ARCCOS functions return
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 in a specific range where a Taylor series can be
37
--         used to compute an accurate result for comparison.
38
--         Exception checks.
39
--      The Taylor series tests are a direct translation of the
40
--      FORTRAN code found in the reference.
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
--      18 Mar 96   SAIC    Initial release for 2.1
56
--      24 Apr 96   SAIC    Fixed error bounds.
57
--      17 Aug 96   SAIC    Added reference information and improved
58
--                          checking for machines with more than 23
59
--                          digits of precision.
60
--      03 Feb 97   PWB.CTA Removed checks with explicit Cycle => 2.0*Pi
61
--      22 Dec 99   RLB     Added model range checking to "exact" results,
62
--                          in order to avoid too strictly requiring a specific
63
--                          result, and too weakly checking results.
64
--
65
-- CHANGE NOTE:
66
--      According to Ken Dritz, author of the Numerics Annex of the RM,
67
--      one should never specify the cycle 2.0*Pi for the trigonometric
68
--      functions.  In particular, if the machine number for the first
69
--      argument is not an exact multiple of the machine number for the
70
--      explicit cycle, then the specified exact results cannot be
71
--      reasonably expected.  The affected checks in this test have been
72
--      marked as comments, with the additional notation "pwb-math".
73
--      Phil Brashear
74
--!
75
 
76
--
77
-- References:
78
--
79
-- Software Manual for the Elementary Functions
80
-- William J. Cody, Jr. and William Waite
81
-- Prentice-Hall, 1980
82
--
83
-- CRC Standard Mathematical Tables
84
-- 23rd Edition
85
--
86
-- Implementation and Testing of Function Software
87
-- W. J. Cody
88
-- Problems and Methodologies in Mathematical Software Production
89
-- editors P. C. Messina and A. Murli
90
-- Lecture Notes in Computer Science   Volume 142
91
-- Springer Verlag, 1982
92
--
93
-- CELEFUNT: A Portable Test Package for Complex Elementary Functions
94
-- ACM Collected Algorithms number 714
95
 
96
with System;
97
with Report;
98
with Ada.Numerics.Generic_Elementary_Functions;
99
procedure CXG2015 is
100
   Verbose : constant Boolean := False;
101
   Max_Samples : constant := 1000;
102
 
103
 
104
   -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
105
   Sqrt2 : constant :=
106
        1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
107
   Sqrt3 : constant :=
108
        1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
109
 
110
   Pi : constant := Ada.Numerics.Pi;
111
 
112
   -- relative error bound from G.2.4(7);6.0
113
   Minimum_Error : constant := 4.0;
114
 
115
   generic
116
      type Real is digits <>;
117
      Half_PI_Low : in Real; -- The machine number closest to, but not greater
118
                             -- than PI/2.0.
119
      Half_PI_High : in Real;-- The machine number closest to, but not less
120
                             -- than PI/2.0.
121
      PI_Low : in Real;      -- The machine number closest to, but not greater
122
                             -- than PI.
123
      PI_High : in Real;     -- The machine number closest to, but not less
124
                             -- than PI.
125
   package Generic_Check is
126
      procedure Do_Test;
127
   end Generic_Check;
128
 
129
   package body Generic_Check is
130
      package Elementary_Functions is new
131
           Ada.Numerics.Generic_Elementary_Functions (Real);
132
 
133
      function Arcsin (X : Real) return Real renames
134
           Elementary_Functions.Arcsin;
135
      function Arcsin (X, Cycle : Real) return Real renames
136
           Elementary_Functions.Arcsin;
137
      function Arccos (X : Real) return Real renames
138
           Elementary_Functions.ArcCos;
139
      function Arccos (X, Cycle : Real) return Real renames
140
           Elementary_Functions.ArcCos;
141
 
142
      -- needed for support
143
      function Log (X, Base : Real) return Real renames
144
           Elementary_Functions.Log;
145
 
146
      -- flag used to terminate some tests early
147
      Accuracy_Error_Reported : Boolean := False;
148
 
149
      -- The following value is a lower bound on the accuracy
150
      -- required.  It is normally 0.0 so that the lower bound
151
      -- is computed from Model_Epsilon.  However, for tests
152
      -- where the expected result is only known to a certain
153
      -- amount of precision this bound takes on a non-zero
154
      -- value to account for that level of precision.
155
      Error_Low_Bound : Real := 0.0;
156
 
157
 
158
      procedure Check (Actual, Expected : Real;
159
                       Test_Name : String;
160
                       MRE : Real) is
161
         Max_Error : Real;
162
         Rel_Error : Real;
163
         Abs_Error : Real;
164
      begin
165
         -- In the case where the expected result is very small or 0
166
         -- we compute the maximum error as a multiple of Model_Epsilon instead
167
         -- of Model_Epsilon and Expected.
168
         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
169
         Abs_Error := MRE * Real'Model_Epsilon;
170
         if Rel_Error > Abs_Error then
171
            Max_Error := Rel_Error;
172
         else
173
            Max_Error := Abs_Error;
174
         end if;
175
 
176
         -- take into account the low bound on the error
177
         if Max_Error < Error_Low_Bound then
178
            Max_Error := Error_Low_Bound;
179
         end if;
180
 
181
         if abs (Actual - Expected) > Max_Error then
182
            Accuracy_Error_Reported := True;
183
            Report.Failed (Test_Name &
184
                           " actual: " & Real'Image (Actual) &
185
                           " expected: " & Real'Image (Expected) &
186
                           " difference: " & Real'Image (Actual - Expected) &
187
                           " max err:" & Real'Image (Max_Error) );
188
         elsif Verbose then
189
            if Actual = Expected then
190
               Report.Comment (Test_Name & "  exact result");
191
            else
192
               Report.Comment (Test_Name & "  passed");
193
            end if;
194
         end if;
195
      end Check;
196
 
197
 
198
      procedure Special_Value_Test is
199
         -- In the following tests the expected result is accurate
200
         -- to the machine precision so the minimum guaranteed error
201
         -- bound can be used.
202
 
203
         type Data_Point is
204
            record
205
               Degrees,
206
               Radians,
207
               Argument,
208
               Error_Bound : Real;
209
            end record;
210
 
211
         type Test_Data_Type is array (Positive range <>) of Data_Point;
212
 
213
         -- the values in the following tables only involve static
214
         -- expressions so no loss of precision occurs.  However,
215
         -- rounding can be an issue with expressions involving Pi
216
         -- and square roots.  The error bound specified in the
217
         -- table takes the sqrt error into account but not the
218
         -- error due to Pi.  The Pi error is added in in the
219
         -- radians test below.
220
 
221
         Arcsin_Test_Data : constant Test_Data_Type := (
222
         --  degrees      radians          sine  error_bound   test #
223
          --(  0.0,           0.0,          0.0,     0.0 ),    -- 1 - In Exact_Result_Test.
224
            ( 30.0,        Pi/6.0,          0.5,     4.0 ),    -- 2
225
            ( 60.0,        Pi/3.0,    Sqrt3/2.0,     5.0 ),    -- 3
226
          --( 90.0,        Pi/2.0,          1.0,     4.0 ),    -- 4 - In Exact_Result_Test.
227
          --(-90.0,       -Pi/2.0,         -1.0,     4.0 ),    -- 5 - In Exact_Result_Test.
228
            (-60.0,       -Pi/3.0,   -Sqrt3/2.0,     5.0 ),    -- 6
229
            (-30.0,       -Pi/6.0,         -0.5,     4.0 ),    -- 7
230
            ( 45.0,        Pi/4.0,    Sqrt2/2.0,     5.0 ),    -- 8
231
            (-45.0,       -Pi/4.0,   -Sqrt2/2.0,     5.0 ) );  -- 9
232
 
233
         Arccos_Test_Data : constant Test_Data_Type := (
234
         --  degrees      radians       cosine   error_bound   test #
235
          --(  0.0,           0.0,         1.0,      0.0 ),    -- 1 - In Exact_Result_Test.
236
            ( 30.0,        Pi/6.0,   Sqrt3/2.0,      5.0 ),    -- 2
237
            ( 60.0,        Pi/3.0,         0.5,      4.0 ),    -- 3
238
          --( 90.0,        Pi/2.0,         0.0,      4.0 ),    -- 4 - In Exact_Result_Test.
239
            (120.0,    2.0*Pi/3.0,        -0.5,      4.0 ),    -- 5
240
            (150.0,    5.0*Pi/6.0,  -Sqrt3/2.0,      5.0 ),    -- 6
241
          --(180.0,            Pi,        -1.0,      4.0 ),    -- 7 - In Exact_Result_Test.
242
            ( 45.0,        Pi/4.0,   Sqrt2/2.0,      5.0 ),    -- 8
243
            (135.0,    3.0*Pi/4.0,  -Sqrt2/2.0,      5.0 ) );  -- 9
244
 
245
         Cycle_Error,
246
         Radian_Error : Real;
247
      begin
248
         for I in Arcsin_Test_Data'Range loop
249
 
250
            -- note exact result requirements  A.5.1(38);6.0 and
251
            -- G.2.4(12);6.0
252
            if Arcsin_Test_Data (I).Error_Bound = 0.0 then
253
               Cycle_Error := 0.0;
254
               Radian_Error := 0.0;
255
            else
256
               Cycle_Error := Arcsin_Test_Data (I).Error_Bound;
257
               -- allow for rounding error in the specification of Pi
258
               Radian_Error := Cycle_Error + 1.0;
259
            end if;
260
 
261
            Check (Arcsin (Arcsin_Test_Data (I).Argument),
262
                   Arcsin_Test_Data (I).Radians,
263
                   "test" & Integer'Image (I) &
264
                   " arcsin(" &
265
                   Real'Image (Arcsin_Test_Data (I).Argument) &
266
                   ")",
267
                   Radian_Error);
268
--pwb-math            Check (Arcsin (Arcsin_Test_Data (I).Argument, 2.0 * Pi),
269
--pwb-math                   Arcsin_Test_Data (I).Radians,
270
--pwb-math                   "test" & Integer'Image (I) &
271
--pwb-math                   " arcsin(" &
272
--pwb-math                   Real'Image (Arcsin_Test_Data (I).Argument) &
273
--pwb-math                   ", 2pi)",
274
--pwb-math                   Cycle_Error);
275
            Check (Arcsin (Arcsin_Test_Data (I).Argument, 360.0),
276
                   Arcsin_Test_Data (I).Degrees,
277
                   "test" & Integer'Image (I) &
278
                   " arcsin(" &
279
                   Real'Image (Arcsin_Test_Data (I).Argument) &
280
                   ", 360)",
281
                   Cycle_Error);
282
         end loop;
283
 
284
 
285
         for I in Arccos_Test_Data'Range loop
286
 
287
            -- note exact result requirements  A.5.1(39);6.0 and
288
            -- G.2.4(12);6.0
289
            if Arccos_Test_Data (I).Error_Bound = 0.0 then
290
               Cycle_Error := 0.0;
291
               Radian_Error := 0.0;
292
            else
293
               Cycle_Error := Arccos_Test_Data (I).Error_Bound;
294
               -- allow for rounding error in the specification of Pi
295
               Radian_Error := Cycle_Error + 1.0;
296
            end if;
297
 
298
            Check (Arccos (Arccos_Test_Data (I).Argument),
299
                   Arccos_Test_Data (I).Radians,
300
                   "test" & Integer'Image (I) &
301
                   " arccos(" &
302
                   Real'Image (Arccos_Test_Data (I).Argument) &
303
                   ")",
304
                   Radian_Error);
305
--pwb-math            Check (Arccos (Arccos_Test_Data (I).Argument, 2.0 * Pi),
306
--pwb-math                   Arccos_Test_Data (I).Radians,
307
--pwb-math                   "test" & Integer'Image (I) &
308
--pwb-math                   " arccos(" &
309
--pwb-math                   Real'Image (Arccos_Test_Data (I).Argument) &
310
--pwb-math                   ", 2pi)",
311
--pwb-math                   Cycle_Error);
312
            Check (Arccos (Arccos_Test_Data (I).Argument, 360.0),
313
                   Arccos_Test_Data (I).Degrees,
314
                   "test" & Integer'Image (I) &
315
                   " arccos(" &
316
                   Real'Image (Arccos_Test_Data (I).Argument) &
317
                   ", 360)",
318
                   Cycle_Error);
319
         end loop;
320
 
321
      exception
322
         when Constraint_Error =>
323
            Report.Failed ("Constraint_Error raised in special value test");
324
         when others =>
325
            Report.Failed ("exception in special value test");
326
      end Special_Value_Test;
327
 
328
 
329
      procedure Check_Exact (Actual, Expected_Low, Expected_High : Real;
330
                             Test_Name : String) is
331
         -- If the expected result is not a model number, then Expected_Low is
332
         -- the first machine number less than the (exact) expected
333
         -- result, and Expected_High is the first machine number greater than
334
         -- the (exact) expected result. If the expected result is a model
335
         -- number, Expected_Low = Expected_High = the result.
336
         Model_Expected_Low  : Real := Expected_Low;
337
         Model_Expected_High : Real := Expected_High;
338
      begin
339
         -- Calculate the first model number nearest to, but below (or equal)
340
         -- to the expected result:
341
         while Real'Model (Model_Expected_Low) /= Model_Expected_Low loop
342
            -- Try the next machine number lower:
343
            Model_Expected_Low := Real'Adjacent(Model_Expected_Low, 0.0);
344
         end loop;
345
         -- Calculate the first model number nearest to, but above (or equal)
346
         -- to the expected result:
347
         while Real'Model (Model_Expected_High) /= Model_Expected_High loop
348
            -- Try the next machine number higher:
349
            Model_Expected_High := Real'Adjacent(Model_Expected_High, 100.0);
350
         end loop;
351
 
352
         if Actual < Model_Expected_Low or Actual > Model_Expected_High then
353
            Accuracy_Error_Reported := True;
354
            if Actual < Model_Expected_Low then
355
               Report.Failed (Test_Name &
356
                              " actual: " & Real'Image (Actual) &
357
                              " expected low: " & Real'Image (Model_Expected_Low) &
358
                              " expected high: " & Real'Image (Model_Expected_High) &
359
                              " difference: " & Real'Image (Actual - Expected_Low));
360
            else
361
               Report.Failed (Test_Name &
362
                              " actual: " & Real'Image (Actual) &
363
                              " expected low: " & Real'Image (Model_Expected_Low) &
364
                              " expected high: " & Real'Image (Model_Expected_High) &
365
                              " difference: " & Real'Image (Expected_High - Actual));
366
            end if;
367
         elsif Verbose then
368
            Report.Comment (Test_Name & "  passed");
369
         end if;
370
      end Check_Exact;
371
 
372
 
373
      procedure Exact_Result_Test is
374
      begin
375
         --  A.5.1(38)
376
         Check_Exact (Arcsin (0.0),       0.0, 0.0, "arcsin(0)");
377
         Check_Exact (Arcsin (0.0, 45.0), 0.0, 0.0, "arcsin(0,45)");
378
 
379
         --  A.5.1(39)
380
         Check_Exact (Arccos (1.0),       0.0, 0.0, "arccos(1)");
381
         Check_Exact (Arccos (1.0, 75.0), 0.0, 0.0, "arccos(1,75)");
382
 
383
         --  G.2.4(11-13)
384
         Check_Exact (Arcsin (1.0), Half_PI_Low, Half_PI_High, "arcsin(1)");
385
         Check_Exact (Arcsin (1.0, 360.0), 90.0, 90.0, "arcsin(1,360)");
386
 
387
         Check_Exact (Arcsin (-1.0), -Half_PI_High, -Half_PI_Low, "arcsin(-1)");
388
         Check_Exact (Arcsin (-1.0, 360.0), -90.0, -90.0, "arcsin(-1,360)");
389
 
390
         Check_Exact (Arccos (0.0), Half_PI_Low, Half_PI_High, "arccos(0)");
391
         Check_Exact (Arccos (0.0, 360.0), 90.0, 90.0, "arccos(0,360)");
392
 
393
         Check_Exact (Arccos (-1.0), PI_Low, PI_High, "arccos(-1)");
394
         Check_Exact (Arccos (-1.0, 360.0), 180.0, 180.0, "arccos(-1,360)");
395
 
396
      exception
397
         when Constraint_Error =>
398
            Report.Failed ("Constraint_Error raised in Exact_Result Test");
399
         when others =>
400
            Report.Failed ("Exception in Exact_Result Test");
401
      end Exact_Result_Test;
402
 
403
 
404
      procedure Arcsin_Taylor_Series_Test is
405
         -- the following range is chosen so that the Taylor series
406
         -- used will produce a result accurate to machine precision.
407
         --
408
         -- The following formula is used for the Taylor series:
409
         --  TS(x) =  x { 1 + (xsq/2) [ (1/3) + (3/4)xsq { (1/5) +
410
         --                (5/6)xsq [ (1/7) + (7/8)xsq/9 ] } ] }
411
         --   where xsq = x * x
412
         --
413
         A : constant := -0.125;
414
         B : constant :=  0.125;
415
         X : Real;
416
         Y, Y_Sq : Real;
417
         Actual, Sum, Xm : Real;
418
         -- terms in Taylor series
419
         K : constant Integer := Integer (
420
                Log (
421
                  Real (Real'Machine_Radix) ** Real'Machine_Mantissa,
422
                  10.0)) + 1;
423
      begin
424
         Accuracy_Error_Reported := False;  -- reset
425
         for I in 1..Max_Samples loop
426
            -- make sure there is no error in x-1, x, and x+1
427
            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
428
 
429
            Y := X;
430
            Y_Sq := Y * Y;
431
            Sum := 0.0;
432
            Xm := Real (K + K + 1);
433
            for M in 1 .. K loop
434
               Sum := Y_Sq * (Sum + 1.0/Xm);
435
               Xm := Xm - 2.0;
436
               Sum := Sum * (Xm /(Xm + 1.0));
437
            end loop;
438
            Sum := Sum * Y;
439
            Actual := Y + Sum;
440
            Sum := (Y - Actual) + Sum;
441
            if not Real'Machine_Rounds then
442
               Actual := Actual + (Sum + Sum);
443
            end if;
444
 
445
            Check (Actual, Arcsin (X),
446
                   "Taylor Series test" & Integer'Image (I) & ": arcsin(" &
447
                   Real'Image (X) & ") ",
448
                   Minimum_Error);
449
 
450
            if Accuracy_Error_Reported then
451
              -- only report the first error in this test in order to keep
452
              -- lots of failures from producing a huge error log
453
              return;
454
            end if;
455
 
456
         end loop;
457
 
458
      exception
459
         when Constraint_Error =>
460
            Report.Failed
461
               ("Constraint_Error raised in Arcsin_Taylor_Series_Test" &
462
                " for X=" & Real'Image (X));
463
         when others =>
464
            Report.Failed ("exception in Arcsin_Taylor_Series_Test" &
465
                " for X=" & Real'Image (X));
466
      end Arcsin_Taylor_Series_Test;
467
 
468
 
469
 
470
      procedure Arccos_Taylor_Series_Test is
471
         -- the following range is chosen so that the Taylor series
472
         -- used will produce a result accurate to machine precision.
473
         --
474
         -- The following formula is used for the Taylor series:
475
         --  TS(x) =  x { 1 + (xsq/2) [ (1/3) + (3/4)xsq { (1/5) +
476
         --                (5/6)xsq [ (1/7) + (7/8)xsq/9 ] } ] }
477
         --  arccos(x) = pi/2 - TS(x)
478
         A : constant := -0.125;
479
         B : constant :=  0.125;
480
         C1, C2 : Real;
481
         X : Real;
482
         Y, Y_Sq : Real;
483
         Actual, Sum, Xm, S : Real;
484
         -- terms in Taylor series
485
         K : constant Integer := Integer (
486
                Log (
487
                  Real (Real'Machine_Radix) ** Real'Machine_Mantissa,
488
                  10.0)) + 1;
489
      begin
490
         if Real'Digits > 23 then
491
            -- constants in this section only accurate to 23 digits
492
            Error_Low_Bound := 0.00000_00000_00000_00000_001;
493
            Report.Comment ("arctan accuracy checked to 23 digits");
494
         end if;
495
 
496
         -- C1 + C2 equals Pi/2 accurate to 23 digits
497
         if Real'Machine_Radix = 10 then
498
            C1 := 1.57;
499
            C2 := 7.9632679489661923132E-4;
500
         else
501
            C1 := 201.0 / 128.0;
502
            C2 := 4.8382679489661923132E-4;
503
         end if;
504
 
505
         Accuracy_Error_Reported := False;  -- reset
506
         for I in 1..Max_Samples loop
507
            -- make sure there is no error in x-1, x, and x+1
508
            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
509
 
510
            Y := X;
511
            Y_Sq := Y * Y;
512
            Sum := 0.0;
513
            Xm := Real (K + K + 1);
514
            for M in 1 .. K loop
515
               Sum := Y_Sq * (Sum + 1.0/Xm);
516
               Xm := Xm - 2.0;
517
               Sum := Sum * (Xm /(Xm + 1.0));
518
            end loop;
519
            Sum := Sum * Y;
520
 
521
            -- at this point we have arcsin(x).
522
            -- We compute arccos(x) = pi/2 - arcsin(x).
523
            -- The following code segment is translated directly from
524
            -- the CELEFUNT FORTRAN implementation
525
 
526
            S := C1 + C2;
527
            Sum := ((C1 - S) + C2) - Sum;
528
            Actual := S + Sum;
529
            Sum := ((S - Actual) + Sum) - Y;
530
            S := Actual;
531
            Actual := S + Sum;
532
            Sum := (S - Actual) + Sum;
533
 
534
            if not Real'Machine_Rounds then
535
               Actual := Actual + (Sum + Sum);
536
            end if;
537
 
538
            Check (Actual, Arccos (X),
539
                   "Taylor Series test" & Integer'Image (I) & ": arccos(" &
540
                   Real'Image (X) & ") ",
541
                   Minimum_Error);
542
 
543
              -- only report the first error in this test in order to keep
544
              -- lots of failures from producing a huge error log
545
            exit when Accuracy_Error_Reported;
546
         end loop;
547
         Error_Low_Bound := 0.0;  -- reset
548
      exception
549
         when Constraint_Error =>
550
            Report.Failed
551
               ("Constraint_Error raised in Arccos_Taylor_Series_Test" &
552
                " for X=" & Real'Image (X));
553
         when others =>
554
            Report.Failed ("exception in Arccos_Taylor_Series_Test" &
555
                " for X=" & Real'Image (X));
556
      end Arccos_Taylor_Series_Test;
557
 
558
 
559
 
560
      procedure Identity_Test is
561
         -- test the identity arcsin(-x) = -arcsin(x)
562
         -- range chosen to be most of the valid range of the argument.
563
         A : constant := -0.999;
564
         B : constant :=  0.999;
565
         X : Real;
566
      begin
567
         Accuracy_Error_Reported := False;  -- reset
568
         for I in 1..Max_Samples loop
569
            -- make sure there is no error in x-1, x, and x+1
570
            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
571
 
572
            Check (Arcsin(-X), -Arcsin (X),
573
                   "Identity test" & Integer'Image (I) & ": arcsin(" &
574
                   Real'Image (X) & ") ",
575
                   8.0);   -- 2 arcsin evaluations => twice the error bound
576
 
577
            if Accuracy_Error_Reported then
578
              -- only report the first error in this test in order to keep
579
              -- lots of failures from producing a huge error log
580
              return;
581
            end if;
582
         end loop;
583
      end Identity_Test;
584
 
585
 
586
      procedure Exception_Test is
587
         X1, X2 : Real := 0.0;
588
      begin
589
            begin
590
              X1 := Arcsin (1.1);
591
              Report.Failed ("no exception for Arcsin (1.1)");
592
            exception
593
               when Constraint_Error =>
594
                  Report.Failed ("Constraint_Error instead of " &
595
                     "Argument_Error for Arcsin (1.1)");
596
               when Ada.Numerics.Argument_Error =>
597
                  null;    -- expected result
598
               when others =>
599
                  Report.Failed ("wrong exception for Arcsin(1.1)");
600
            end;
601
 
602
            begin
603
              X2 := Arccos (-1.1);
604
              Report.Failed ("no exception for Arccos (-1.1)");
605
            exception
606
               when Constraint_Error =>
607
                  Report.Failed ("Constraint_Error instead of " &
608
                     "Argument_Error for Arccos (-1.1)");
609
               when Ada.Numerics.Argument_Error =>
610
                  null;    -- expected result
611
               when others =>
612
                  Report.Failed ("wrong exception for Arccos(-1.1)");
613
            end;
614
 
615
 
616
         -- optimizer thwarting
617
         if Report.Ident_Bool (False) then
618
            Report.Comment (Real'Image (X1 + X2));
619
         end if;
620
      end Exception_Test;
621
 
622
 
623
      procedure Do_Test is
624
      begin
625
         Special_Value_Test;
626
         Exact_Result_Test;
627
         Arcsin_Taylor_Series_Test;
628
         Arccos_Taylor_Series_Test;
629
         Identity_Test;
630
         Exception_Test;
631
      end Do_Test;
632
   end Generic_Check;
633
 
634
   -----------------------------------------------------------------------
635
   -----------------------------------------------------------------------
636
   -- These expressions must be truly static, which is why we have to do them
637
   -- outside of the generic, and we use the named numbers. Note that we know
638
   -- that PI is not a machine number (it is irrational), and it should be
639
   -- represented to more digits than supported by the target machine.
640
   Float_Half_PI_Low  : constant := Float'Adjacent(PI/2.0,  0.0);
641
   Float_Half_PI_High : constant := Float'Adjacent(PI/2.0, 10.0);
642
   Float_PI_Low       : constant := Float'Adjacent(PI,      0.0);
643
   Float_PI_High      : constant := Float'Adjacent(PI,     10.0);
644
   package Float_Check is new Generic_Check (Float,
645
        Half_PI_Low  => Float_Half_PI_Low,
646
        Half_PI_High => Float_Half_PI_High,
647
        PI_Low  => Float_PI_Low,
648
        PI_High => Float_PI_High);
649
 
650
   -- check the floating point type with the most digits
651
   type A_Long_Float is digits System.Max_Digits;
652
   A_Long_Float_Half_PI_Low  : constant := A_Long_Float'Adjacent(PI/2.0,  0.0);
653
   A_Long_Float_Half_PI_High : constant := A_Long_Float'Adjacent(PI/2.0, 10.0);
654
   A_Long_Float_PI_Low       : constant := A_Long_Float'Adjacent(PI,      0.0);
655
   A_Long_Float_PI_High      : constant := A_Long_Float'Adjacent(PI,     10.0);
656
   package A_Long_Float_Check is new Generic_Check (A_Long_Float,
657
        Half_PI_Low  => A_Long_Float_Half_PI_Low,
658
        Half_PI_High => A_Long_Float_Half_PI_High,
659
        PI_Low  => A_Long_Float_PI_Low,
660
        PI_High => A_Long_Float_PI_High);
661
 
662
   -----------------------------------------------------------------------
663
   -----------------------------------------------------------------------
664
 
665
 
666
begin
667
   Report.Test ("CXG2015",
668
                "Check the accuracy of the ARCSIN and ARCCOS functions");
669
 
670
   if Verbose then
671
      Report.Comment ("checking Standard.Float");
672
   end if;
673
 
674
   Float_Check.Do_Test;
675
 
676
   if Verbose then
677
      Report.Comment ("checking a digits" &
678
                      Integer'Image (System.Max_Digits) &
679
                      " floating point type");
680
   end if;
681
 
682
   A_Long_Float_Check.Do_Test;
683
 
684
 
685
   Report.Result;
686
end CXG2015;

powered by: WebSVN 2.1.0

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