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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxg/] [cxg2003.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn 
-- CXG2003.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 sqrt function returns
28 
--      results that are within the error bound allowed.
29 
--
30 
-- TEST DESCRIPTION:
31 
--      This test contains three test packages that are almost
32 
--      identical.  The first two packages differ only in the
33 
--      floating point type that is being tested.  The first
34 
--      and third package differ only in whether the generic
35 
--      elementary functions package or the pre-instantiated
36 
--      package is used.
37 
--      The test package is not generic so that the arguments
38 
--      and expected results for some of the test values
39 
--      can be expressed as universal real instead of being
40 
--      computed at runtime.
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 
--       2 FEB 96   SAIC    Initial release for 2.1
56 
--      18 AUG 96   SAIC    Made Check consistent with other tests.
57 
--
58 
--!
59 
 
60 
with System;
61 
with Report;
62 
with Ada.Numerics.Generic_Elementary_Functions;
63 
with Ada.Numerics.Elementary_Functions;
64 
procedure CXG2003 is
65 
   Verbose : constant Boolean := False;
66 
 
67 
   package Float_Check is
68 
      subtype Real is Float;
69 
      procedure Do_Test;
70 
   end Float_Check;
71 
 
72 
   package body Float_Check is
73 
      package Elementary_Functions is new
74 
           Ada.Numerics.Generic_Elementary_Functions (Real);
75 
      function Sqrt (X : Real) return Real renames
76 
           Elementary_Functions.Sqrt;
77 
      function Log (X : Real) return Real renames
78 
           Elementary_Functions.Log;
79 
      function Exp (X : Real) return Real renames
80 
           Elementary_Functions.Exp;
81 
 
82 
      -- The default Maximum Relative Error is the value specified
83 
      -- in the LRM.
84 
      Default_MRE : constant Real := 2.0;
85 
 
86 
      procedure Check (Actual, Expected : Real;
87 
                       Test_Name : String;
88 
                       MRE : Real := Default_MRE) is
89 
         Rel_Error : Real;
90 
         Abs_Error : Real;
91 
         Max_Error : Real;
92 
      begin
93 
         -- In the case where the expected result is very small or 0
94 
         -- we compute the maximum error as a multiple of Model_Epsilon instead
95 
         -- of Model_Epsilon and Expected.
96 
         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
97 
         Abs_Error := MRE * Real'Model_Epsilon;
98 
         if Rel_Error > Abs_Error then
99 
            Max_Error := Rel_Error;
100 
         else
101 
            Max_Error := Abs_Error;
102 
         end if;
103 
 
104 
         if abs (Actual - Expected) > Max_Error then
105 
            Report.Failed (Test_Name &
106 
                           " actual: " & Real'Image (Actual) &
107 
                           " expected: " & Real'Image (Expected) &
108 
                           " difference: " &
109 
                           Real'Image (Actual - Expected) &
110 
                           " mre:" & Real'Image (Max_Error) );
111 
         elsif Verbose then
112 
            if Actual = Expected then
113 
               Report.Comment (Test_Name & "  exact result");
114 
            else
115 
               Report.Comment (Test_Name & "  passed");
116 
            end if;
117 
         end if;
118 
      end Check;
119 
 
120 
 
121 
     procedure Argument_Range_Check (A, B : Real;
122 
                                      Test : String) is
123 
         -- test a logarithmically distributed selection of
124 
         -- arguments selected from the range A to B.
125 
         X : Real;
126 
         Expected : Real;
127 
         Y : Real;
128 
         C : Real := Log(B/A);
129 
         Max_Samples : constant := 1000;
130 
 
131 
      begin
132 
         for I in 1..Max_Samples loop
133 
            Expected :=  A * Exp(C * Real (I) / Real (Max_Samples));
134 
            X := Expected * Expected;
135 
            Y := Sqrt (X);
136 
 
137 
            -- note that since the expected value is computed, we
138 
            -- must take the error in that computation into account.
139 
            Check (Y, Expected,
140 
                   "test " & Test & " -" &
141 
                   Integer'Image (I) &
142 
                   " of argument range",
143 
                   3.0);
144 
         end loop;
145 
      exception
146 
         when Constraint_Error =>
147 
            Report.Failed
148 
               ("Constraint_Error raised in argument range check");
149 
         when others =>
150 
            Report.Failed ("exception in argument range check");
151 
      end Argument_Range_Check;
152 
 
153 
      procedure Do_Test is
154 
      begin
155 
 
156 
         --- test 1 ---
157 
         declare
158 
            T : constant := (Real'Machine_EMax - 1) / 2;
159 
            X : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
160 
            Expected : constant := (1.0 * Real'Machine_Radix) ** T;
161 
            Y : Real;
162 
         begin
163 
            Y := Sqrt (X);
164 
            Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))");
165 
         exception
166 
            when Constraint_Error =>
167 
               Report.Failed ("Constraint_Error raised in test 1");
168 
            when others =>
169 
               Report.Failed ("exception in test 1");
170 
         end;
171 
 
172 
         --- test 2 ---
173 
         declare
174 
            T : constant := (Real'Model_EMin + 1) / 2;
175 
            X : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
176 
            Expected : constant := (1.0 * Real'Machine_Radix) ** T;
177 
            Y : Real;
178 
         begin
179 
            Y := Sqrt (X);
180 
            Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))");
181 
         exception
182 
            when Constraint_Error =>
183 
               Report.Failed ("Constraint_Error raised in test 2");
184 
            when others =>
185 
               Report.Failed ("exception in test 2");
186 
         end;
187 
 
188 
         --- test 3 ---
189 
         declare
190 
            X : constant := 1.0;
191 
            Expected : constant := 1.0;
192 
            Y : Real;
193 
         begin
194 
            Y := Sqrt(X);
195 
            Check (Y, Expected, "test 3 -- sqrt(1.0)",
196 
                 0.0);   -- no error allowed
197 
         exception
198 
            when Constraint_Error =>
199 
               Report.Failed ("Constraint_Error raised in test 3");
200 
            when others =>
201 
               Report.Failed ("exception in test 3");
202 
         end;
203 
 
204 
         --- test 4 ---
205 
         declare
206 
            X : constant := 0.0;
207 
            Expected : constant := 0.0;
208 
            Y : Real;
209 
         begin
210 
            Y := Sqrt(X);
211 
            Check (Y, Expected, "test 4 -- sqrt(0.0)",
212 
                 0.0);   -- no error allowed
213 
         exception
214 
            when Constraint_Error =>
215 
               Report.Failed ("Constraint_Error raised in test 4");
216 
            when others =>
217 
               Report.Failed ("exception in test 4");
218 
         end;
219 
 
220 
         --- test 5 ---
221 
         declare
222 
            X : constant := -1.0;
223 
            Y : Real;
224 
         begin
225 
            Y := Sqrt(X);
226 
            -- the following code should not be executed.
227 
            -- The call to Check is to keep the call to Sqrt from
228 
            -- appearing to be dead code.
229 
            Check (Y, -1.0, "test 5 -- sqrt(-1)" );
230 
            Report.Failed ("test 5 - argument_error expected");
231 
         exception
232 
            when Constraint_Error =>
233 
               Report.Failed ("Constraint_Error raised in test 5");
234 
            when Ada.Numerics.Argument_Error =>
235 
               if Verbose then
236 
                  Report.Comment ("test 5 correctly got argument_error");
237 
               end if;
238 
            when others =>
239 
               Report.Failed ("exception in test 5");
240 
         end;
241 
 
242 
         --- test 6 ---
243 
         declare
244 
            X : constant := Ada.Numerics.Pi ** 2;
245 
            Expected : constant := Ada.Numerics.Pi;
246 
            Y : Real;
247 
         begin
248 
            Y := Sqrt (X);
249 
            Check (Y, Expected, "test 6 -- sqrt(pi**2)");
250 
         exception
251 
            when Constraint_Error =>
252 
               Report.Failed ("Constraint_Error raised in test 6");
253 
            when others =>
254 
               Report.Failed ("exception in test 6");
255 
         end;
256 
 
257 
         --- test 7 & 8 ---
258 
         Argument_Range_Check (1.0/Sqrt(Real(Real'Machine_Radix)),
259 
                                1.0,
260 
                                "7");
261 
         Argument_Range_Check (1.0,
262 
                                Sqrt(Real(Real'Machine_Radix)),
263 
                                "8");
264 
      end Do_Test;
265 
   end Float_Check;
266 
 
267 
   -----------------------------------------------------------------------
268 
   -----------------------------------------------------------------------
269 
   -- check the floating point type with the most digits
270 
   type A_Long_Float is digits System.Max_Digits;
271 
 
272 
 
273 
   package A_Long_Float_Check is
274 
      subtype Real is A_Long_Float;
275 
      procedure Do_Test;
276 
   end A_Long_Float_Check;
277 
 
278 
   package body A_Long_Float_Check is
279 
      package Elementary_Functions is new
280 
           Ada.Numerics.Generic_Elementary_Functions (Real);
281 
      function Sqrt (X : Real) return Real renames
282 
           Elementary_Functions.Sqrt;
283 
      function Log (X : Real) return Real renames
284 
           Elementary_Functions.Log;
285 
      function Exp (X : Real) return Real renames
286 
           Elementary_Functions.Exp;
287 
 
288 
      -- The default Maximum Relative Error is the value specified
289 
      -- in the LRM.
290 
      Default_MRE : constant Real := 2.0;
291 
 
292 
      procedure Check (Actual, Expected : Real;
293 
                       Test_Name : String;
294 
                       MRE : Real := Default_MRE) is
295 
         Rel_Error : Real;
296 
         Abs_Error : Real;
297 
         Max_Error : Real;
298 
      begin
299 
         -- In the case where the expected result is very small or 0
300 
         -- we compute the maximum error as a multiple of Model_Epsilon instead
301 
         -- of Model_Epsilon and Expected.
302 
         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
303 
         Abs_Error := MRE * Real'Model_Epsilon;
304 
         if Rel_Error > Abs_Error then
305 
            Max_Error := Rel_Error;
306 
         else
307 
            Max_Error := Abs_Error;
308 
         end if;
309 
 
310 
         if abs (Actual - Expected) > Max_Error then
311 
            Report.Failed (Test_Name &
312 
                           " actual: " & Real'Image (Actual) &
313 
                           " expected: " & Real'Image (Expected) &
314 
                           " difference: " &
315 
                           Real'Image (Actual - Expected) &
316 
                           " mre:" & Real'Image (Max_Error) );
317 
         elsif Verbose then
318 
            if Actual = Expected then
319 
               Report.Comment (Test_Name & "  exact result");
320 
            else
321 
               Report.Comment (Test_Name & "  passed");
322 
            end if;
323 
         end if;
324 
      end Check;
325 
 
326 
 
327 
      procedure Argument_Range_Check (A, B : Real;
328 
                                      Test : String) is
329 
         -- test a logarithmically distributed selection of
330 
         -- arguments selected from the range A to B.
331 
         X : Real;
332 
         Expected : Real;
333 
         Y : Real;
334 
         C : Real := Log(B/A);
335 
         Max_Samples : constant := 1000;
336 
 
337 
      begin
338 
         for I in 1..Max_Samples loop
339 
            Expected :=  A * Exp(C * Real (I) / Real (Max_Samples));
340 
            X := Expected * Expected;
341 
            Y := Sqrt (X);
342 
 
343 
            -- note that since the expected value is computed, we
344 
            -- must take the error in that computation into account.
345 
            Check (Y, Expected,
346 
                   "test " & Test & " -" &
347 
                   Integer'Image (I) &
348 
                   " of argument range",
349 
                   3.0);
350 
         end loop;
351 
      exception
352 
         when Constraint_Error =>
353 
            Report.Failed
354 
               ("Constraint_Error raised in argument range check");
355 
         when others =>
356 
            Report.Failed ("exception in argument range check");
357 
      end Argument_Range_Check;
358 
 
359 
 
360 
      procedure Do_Test is
361 
      begin
362 
 
363 
         --- test 1 ---
364 
         declare
365 
            T : constant := (Real'Machine_EMax - 1) / 2;
366 
            X : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
367 
            Expected : constant := (1.0 * Real'Machine_Radix) ** T;
368 
            Y : Real;
369 
         begin
370 
            Y := Sqrt (X);
371 
            Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))");
372 
         exception
373 
            when Constraint_Error =>
374 
               Report.Failed ("Constraint_Error raised in test 1");
375 
            when others =>
376 
               Report.Failed ("exception in test 1");
377 
         end;
378 
 
379 
         --- test 2 ---
380 
         declare
381 
            T : constant := (Real'Model_EMin + 1) / 2;
382 
            X : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
383 
            Expected : constant := (1.0 * Real'Machine_Radix) ** T;
384 
            Y : Real;
385 
         begin
386 
            Y := Sqrt (X);
387 
            Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))");
388 
         exception
389 
            when Constraint_Error =>
390 
               Report.Failed ("Constraint_Error raised in test 2");
391 
            when others =>
392 
               Report.Failed ("exception in test 2");
393 
         end;
394 
 
395 
         --- test 3 ---
396 
         declare
397 
            X : constant := 1.0;
398 
            Expected : constant := 1.0;
399 
            Y : Real;
400 
         begin
401 
            Y := Sqrt(X);
402 
            Check (Y, Expected, "test 3 -- sqrt(1.0)",
403 
                 0.0);   -- no error allowed
404 
         exception
405 
            when Constraint_Error =>
406 
               Report.Failed ("Constraint_Error raised in test 3");
407 
            when others =>
408 
               Report.Failed ("exception in test 3");
409 
         end;
410 
 
411 
         --- test 4 ---
412 
         declare
413 
            X : constant := 0.0;
414 
            Expected : constant := 0.0;
415 
            Y : Real;
416 
         begin
417 
            Y := Sqrt(X);
418 
            Check (Y, Expected, "test 4 -- sqrt(0.0)",
419 
                 0.0);   -- no error allowed
420 
         exception
421 
            when Constraint_Error =>
422 
               Report.Failed ("Constraint_Error raised in test 4");
423 
            when others =>
424 
               Report.Failed ("exception in test 4");
425 
         end;
426 
 
427 
         --- test 5 ---
428 
         declare
429 
            X : constant := -1.0;
430 
            Y : Real;
431 
         begin
432 
            Y := Sqrt(X);
433 
            -- the following code should not be executed.
434 
            -- The call to Check is to keep the call to Sqrt from
435 
            -- appearing to be dead code.
436 
            Check (Y, -1.0, "test 5 -- sqrt(-1)" );
437 
            Report.Failed ("test 5 - argument_error expected");
438 
         exception
439 
            when Constraint_Error =>
440 
               Report.Failed ("Constraint_Error raised in test 5");
441 
            when Ada.Numerics.Argument_Error =>
442 
               if Verbose then
443 
                  Report.Comment ("test 5 correctly got argument_error");
444 
               end if;
445 
            when others =>
446 
               Report.Failed ("exception in test 5");
447 
         end;
448 
 
449 
         --- test 6 ---
450 
         declare
451 
            X : constant := Ada.Numerics.Pi ** 2;
452 
            Expected : constant := Ada.Numerics.Pi;
453 
            Y : Real;
454 
         begin
455 
            Y := Sqrt (X);
456 
            Check (Y, Expected, "test 6 -- sqrt(pi**2)");
457 
         exception
458 
            when Constraint_Error =>
459 
               Report.Failed ("Constraint_Error raised in test 6");
460 
            when others =>
461 
               Report.Failed ("exception in test 6");
462 
         end;
463 
 
464 
         --- test 7 & 8 ---
465 
         Argument_Range_Check (1.0/Sqrt(Real(Real'Machine_Radix)),
466 
                                1.0,
467 
                                "7");
468 
         Argument_Range_Check (1.0,
469 
                                Sqrt(Real(Real'Machine_Radix)),
470 
                                "8");
471 
      end Do_Test;
472 
   end A_Long_Float_Check;
473 
 
474 
   -----------------------------------------------------------------------
475 
   -----------------------------------------------------------------------
476 
 
477 
   package Non_Generic_Check is
478 
      procedure Do_Test;
479 
   end Non_Generic_Check;
480 
 
481 
   package body Non_Generic_Check is
482 
      package EF renames
483 
           Ada.Numerics.Elementary_Functions;
484 
      subtype Real is Float;
485 
 
486 
      -- The default Maximum Relative Error is the value specified
487 
      -- in the LRM.
488 
      Default_MRE : constant Real := 2.0;
489 
 
490 
      procedure Check (Actual, Expected : Real;
491 
                       Test_Name : String;
492 
                       MRE : Real := Default_MRE) is
493 
         Rel_Error : Real;
494 
         Abs_Error : Real;
495 
         Max_Error : Real;
496 
      begin
497 
         -- In the case where the expected result is very small or 0
498 
         -- we compute the maximum error as a multiple of Model_Epsilon instead
499 
         -- of Model_Epsilon and Expected.
500 
         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
501 
         Abs_Error := MRE * Real'Model_Epsilon;
502 
         if Rel_Error > Abs_Error then
503 
            Max_Error := Rel_Error;
504 
         else
505 
            Max_Error := Abs_Error;
506 
         end if;
507 
 
508 
         if abs (Actual - Expected) > Max_Error then
509 
            Report.Failed (Test_Name &
510 
                           " actual: " & Real'Image (Actual) &
511 
                           " expected: " & Real'Image (Expected) &
512 
                           " difference: " &
513 
                           Real'Image (Actual - Expected) &
514 
                           " mre:" & Real'Image (Max_Error) );
515 
         elsif Verbose then
516 
            if Actual = Expected then
517 
               Report.Comment (Test_Name & "  exact result");
518 
            else
519 
               Report.Comment (Test_Name & "  passed");
520 
            end if;
521 
         end if;
522 
      end Check;
523 
 
524 
 
525 
 
526 
      procedure Argument_Range_Check (A, B : Float;
527 
                                      Test : String) is
528 
         -- test a logarithmically distributed selection of
529 
         -- arguments selected from the range A to B.
530 
         X : Float;
531 
         Expected : Float;
532 
         Y : Float;
533 
         C : Float := EF.Log(B/A);
534 
         Max_Samples : constant := 1000;
535 
 
536 
      begin
537 
         for I in 1..Max_Samples loop
538 
            Expected :=  A * EF.Exp(C * Float (I) / Float (Max_Samples));
539 
            X := Expected * Expected;
540 
            Y := EF.Sqrt (X);
541 
 
542 
            -- note that since the expected value is computed, we
543 
            -- must take the error in that computation into account.
544 
            Check (Y, Expected,
545 
                   "test " & Test & " -" &
546 
                   Integer'Image (I) &
547 
                   " of argument range",
548 
                   3.0);
549 
         end loop;
550 
      exception
551 
         when Constraint_Error =>
552 
            Report.Failed
553 
               ("Constraint_Error raised in argument range check");
554 
         when others =>
555 
            Report.Failed ("exception in argument range check");
556 
      end Argument_Range_Check;
557 
 
558 
 
559 
      procedure Do_Test is
560 
      begin
561 
 
562 
         --- test 1 ---
563 
         declare
564 
            T : constant := (Float'Machine_EMax - 1) / 2;
565 
            X : constant := (1.0 * Float'Machine_Radix) ** (2 * T);
566 
            Expected : constant := (1.0 * Float'Machine_Radix) ** T;
567 
            Y : Float;
568 
         begin
569 
            Y := EF.Sqrt (X);
570 
            Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))");
571 
         exception
572 
            when Constraint_Error =>
573 
               Report.Failed ("Constraint_Error raised in test 1");
574 
            when others =>
575 
               Report.Failed ("exception in test 1");
576 
         end;
577 
 
578 
         --- test 2 ---
579 
         declare
580 
            T : constant := (Float'Model_EMin + 1) / 2;
581 
            X : constant := (1.0 * Float'Machine_Radix) ** (2 * T);
582 
            Expected : constant := (1.0 * Float'Machine_Radix) ** T;
583 
            Y : Float;
584 
         begin
585 
            Y := EF.Sqrt (X);
586 
            Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))");
587 
         exception
588 
            when Constraint_Error =>
589 
               Report.Failed ("Constraint_Error raised in test 2");
590 
            when others =>
591 
               Report.Failed ("exception in test 2");
592 
         end;
593 
 
594 
         --- test 3 ---
595 
         declare
596 
            X : constant := 1.0;
597 
            Expected : constant := 1.0;
598 
            Y : Float;
599 
         begin
600 
            Y := EF.Sqrt(X);
601 
            Check (Y, Expected, "test 3 -- sqrt(1.0)",
602 
                 0.0);   -- no error allowed
603 
         exception
604 
            when Constraint_Error =>
605 
               Report.Failed ("Constraint_Error raised in test 3");
606 
            when others =>
607 
               Report.Failed ("exception in test 3");
608 
         end;
609 
 
610 
         --- test 4 ---
611 
         declare
612 
            X : constant := 0.0;
613 
            Expected : constant := 0.0;
614 
            Y : Float;
615 
         begin
616 
            Y := EF.Sqrt(X);
617 
            Check (Y, Expected, "test 4 -- sqrt(0.0)",
618 
                 0.0);   -- no error allowed
619 
         exception
620 
            when Constraint_Error =>
621 
               Report.Failed ("Constraint_Error raised in test 4");
622 
            when others =>
623 
               Report.Failed ("exception in test 4");
624 
         end;
625 
 
626 
         --- test 5 ---
627 
         declare
628 
            X : constant := -1.0;
629 
            Y : Float;
630 
         begin
631 
            Y := EF.Sqrt(X);
632 
            -- the following code should not be executed.
633 
            -- The call to Check is to keep the call to Sqrt from
634 
            -- appearing to be dead code.
635 
            Check (Y, -1.0, "test 5 -- sqrt(-1)" );
636 
            Report.Failed ("test 5 - argument_error expected");
637 
         exception
638 
            when Constraint_Error =>
639 
               Report.Failed ("Constraint_Error raised in test 5");
640 
            when Ada.Numerics.Argument_Error =>
641 
               if Verbose then
642 
                  Report.Comment ("test 5 correctly got argument_error");
643 
               end if;
644 
            when others =>
645 
               Report.Failed ("exception in test 5");
646 
         end;
647 
 
648 
         --- test 6 ---
649 
         declare
650 
            X : constant := Ada.Numerics.Pi ** 2;
651 
            Expected : constant := Ada.Numerics.Pi;
652 
            Y : Float;
653 
         begin
654 
            Y := EF.Sqrt (X);
655 
            Check (Y, Expected, "test 6 -- sqrt(pi**2)");
656 
         exception
657 
            when Constraint_Error =>
658 
               Report.Failed ("Constraint_Error raised in test 6");
659 
            when others =>
660 
               Report.Failed ("exception in test 6");
661 
         end;
662 
 
663 
         --- test 7 & 8 ---
664 
         Argument_Range_Check (1.0/EF.Sqrt(Float(Float'Machine_Radix)),
665 
                                1.0,
666 
                                "7");
667 
         Argument_Range_Check (1.0,
668 
                                EF.Sqrt(Float(Float'Machine_Radix)),
669 
                                "8");
670 
      end Do_Test;
671 
   end Non_Generic_Check;
672 
 
673 
   -----------------------------------------------------------------------
674 
   -----------------------------------------------------------------------
675 
 
676 
begin
677 
   Report.Test ("CXG2003",
678 
                "Check the accuracy of the sqrt function");
679 
 
680 
   if Verbose then
681 
      Report.Comment ("checking Standard.Float");
682 
   end if;
683 
 
684 
   Float_Check.Do_Test;
685 
 
686 
   if Verbose then
687 
      Report.Comment ("checking a digits" &
688 
                      Integer'Image (System.Max_Digits) &
689 
                      " floating point type");
690 
   end if;
691 
 
692 
   A_Long_Float_Check.Do_Test;
693 
 
694 
   if Verbose then
695 
      Report.Comment ("checking non-generic package");
696 
   end if;
697 
 
698 
   Non_Generic_Check.Do_Test;
699 
 
700 
   Report.Result;
701 
end CXG2003;

powered by: WebSVN 2.1.0

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