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

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

Line No. Rev Author Line
1 294 jeremybenn 
-- CXG2008.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 complex multiplication and division
28 
--      operations return results that are within the allowed
29 
--      error bound.
30 
--      Check that all the required pure Numerics packages are pure.
31 
--
32 
-- TEST DESCRIPTION:
33 
--      This test contains three test packages that are almost
34 
--      identical.  The first two packages differ only in the
35 
--      floating point type that is being tested.  The first
36 
--      and third package differ only in whether the generic
37 
--      complex types package or the pre-instantiated
38 
--      package is used.
39 
--      The test package is not generic so that the arguments
40 
--      and expected results for some of the test values
41 
--      can be expressed as universal real instead of being
42 
--      computed at runtime.
43 
--
44 
-- SPECIAL REQUIREMENTS
45 
--      The Strict Mode for the numerical accuracy must be
46 
--      selected.  The method by which this mode is selected
47 
--      is implementation dependent.
48 
--
49 
-- APPLICABILITY CRITERIA:
50 
--      This test applies only to implementations supporting the
51 
--      Numerics Annex.
52 
--      This test only applies to the Strict Mode for numerical
53 
--      accuracy.
54 
--
55 
--
56 
-- CHANGE HISTORY:
57 
--      24 FEB 96   SAIC    Initial release for 2.1
58 
--      03 JUN 98   EDS     Correct the test program's incorrect assumption
59 
--                          that Constraint_Error must be raised by complex
60 
--                          division by zero, which is contrary to the
61 
--                          allowance given by the Ada 95 standard G.1.1(40).
62 
--      13 MAR 01   RLB     Replaced commented out Pure check on non-generic
63 
--                          packages, as required by Defect Report
64 
--                          8652/0020 and as reflected in Technical
65 
--                          Corrigendum 1.
66 
--!
67 
 
68 
------------------------------------------------------------------------------
69 
-- Check that the required pure packages are pure by withing them from a
70 
-- pure package. The non-generic versions of those packages are required to
71 
-- be pure by Defect Report 8652/0020, Technical Corrigendum 1 [A.5.1(9/1) and
72 
-- G.1.1(25/1)].
73 
with Ada.Numerics.Generic_Elementary_Functions;
74 
with Ada.Numerics.Elementary_Functions;
75 
with Ada.Numerics.Generic_Complex_Types;
76 
with Ada.Numerics.Complex_Types;
77 
with Ada.Numerics.Generic_Complex_Elementary_Functions;
78 
with Ada.Numerics.Complex_Elementary_Functions;
79 
package CXG2008_0 is
80 
  pragma Pure;
81 
   -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
82 
   Sqrt2 : constant :=
83 
        1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
84 
   Sqrt3 : constant :=
85 
        1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
86 
end CXG2008_0;
87 
 
88 
------------------------------------------------------------------------------
89 
 
90 
with System;
91 
with Report;
92 
with Ada.Numerics.Generic_Complex_Types;
93 
with Ada.Numerics.Complex_Types;
94 
with CXG2008_0;  use CXG2008_0;
95 
procedure CXG2008 is
96 
   Verbose : constant Boolean := False;
97 
 
98 
   package Float_Check is
99 
      subtype Real is Float;
100 
      procedure Do_Test;
101 
   end Float_Check;
102 
 
103 
   package body Float_Check is
104 
      package Complex_Types is new
105 
           Ada.Numerics.Generic_Complex_Types (Real);
106 
      use Complex_Types;
107 
 
108 
      -- keep track if an accuracy failure has occurred so the test
109 
      -- can be short-circuited to avoid thousands of error messages.
110 
      Failure_Detected : Boolean := False;
111 
 
112 
      Mult_MBE : constant Real := 5.0;
113 
      Divide_MBE : constant Real := 13.0;
114 
 
115 
 
116 
      procedure Check (Actual, Expected : Complex;
117 
                       Test_Name : String;
118 
                       MBE : Real) is
119 
         Rel_Error : Real;
120 
         Abs_Error : Real;
121 
         Max_Error : Real;
122 
      begin
123 
         -- In the case where the expected result is very small or 0
124 
         -- we compute the maximum error as a multiple of Model_Epsilon instead
125 
         -- of Model_Epsilon and Expected.
126 
         Rel_Error := MBE * abs Expected.Re * Real'Model_Epsilon;
127 
         Abs_Error := MBE * Real'Model_Epsilon;
128 
         if Rel_Error > Abs_Error then
129 
            Max_Error := Rel_Error;
130 
         else
131 
            Max_Error := Abs_Error;
132 
         end if;
133 
 
134 
         if abs (Actual.Re - Expected.Re) > Max_Error then
135 
            Failure_Detected := True;
136 
            Report.Failed (Test_Name &
137 
                           " actual.re: " & Real'Image (Actual.Re) &
138 
                           " expected.re: " & Real'Image (Expected.Re) &
139 
                           " difference.re " &
140 
                           Real'Image (Actual.Re - Expected.Re) &
141 
                           " mre:" & Real'Image (Max_Error) );
142 
         elsif Verbose then
143 
            if Actual = Expected then
144 
               Report.Comment (Test_Name & " exact result for real part");
145 
            else
146 
               Report.Comment (Test_Name & " passed for real part");
147 
            end if;
148 
         end if;
149 
 
150 
         Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon;
151 
         if Rel_Error > Abs_Error then
152 
            Max_Error := Rel_Error;
153 
         else
154 
            Max_Error := Abs_Error;
155 
         end if;
156 
         if abs (Actual.Im - Expected.Im) > Max_Error then
157 
            Failure_Detected := True;
158 
            Report.Failed (Test_Name &
159 
                           " actual.im: " & Real'Image (Actual.Im) &
160 
                           " expected.im: " & Real'Image (Expected.Im) &
161 
                           " difference.im " &
162 
                           Real'Image (Actual.Im - Expected.Im) &
163 
                           " mre:" & Real'Image (Max_Error) );
164 
         elsif Verbose then
165 
            if Actual = Expected then
166 
               Report.Comment (Test_Name & " exact result for imaginary part");
167 
            else
168 
               Report.Comment (Test_Name & " passed for imaginary part");
169 
            end if;
170 
         end if;
171 
      end Check;
172 
 
173 
 
174 
      procedure Special_Values is
175 
      begin
176 
 
177 
         --- test 1 ---
178 
         declare
179 
            T : constant := (Real'Machine_EMax - 1) / 2;
180 
            Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
181 
            Expected : Complex := (0.0, 0.0);
182 
            X : Complex := (0.0, 0.0);
183 
            Y : Complex := (Big, Big);
184 
            Z : Complex;
185 
         begin
186 
            Z := X * Y;
187 
            Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)",
188 
                   Mult_MBE);
189 
            Z := Y * X;
190 
            Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)",
191 
                   Mult_MBE);
192 
         exception
193 
            when Constraint_Error =>
194 
               Report.Failed ("Constraint_Error raised in test 1");
195 
            when others =>
196 
               Report.Failed ("exception in test 1");
197 
         end;
198 
 
199 
         --- test 2 ---
200 
         declare
201 
            T : constant := Real'Model_EMin + 1;
202 
            Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
203 
            U : Complex := (Tiny, Tiny);
204 
            X : Complex := (0.0, 0.0);
205 
            Expected : Complex := (0.0, 0.0);
206 
            Z : Complex;
207 
         begin
208 
            Z := U * X;
209 
            Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)",
210 
                   Mult_MBE);
211 
         exception
212 
            when Constraint_Error =>
213 
               Report.Failed ("Constraint_Error raised in test 2");
214 
            when others =>
215 
               Report.Failed ("exception in test 2");
216 
         end;
217 
 
218 
         --- test 3 ---
219 
         declare
220 
            T : constant := (Real'Machine_EMax - 1) / 2;
221 
            Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
222 
            B : Complex := (Big, Big);
223 
            X : Complex := (0.0, 0.0);
224 
            Z : Complex;
225 
         begin
226 
            if Real'Machine_Overflows then
227 
               Z := B / X;
228 
               Report.Failed ("test 3 - Constraint_Error not raised");
229 
               Check (Z, Z, "not executed - optimizer thwarting", 0.0);
230 
            end if;
231 
         exception
232 
            when Constraint_Error => null;  -- expected
233 
            when others =>
234 
               Report.Failed ("exception in test 3");
235 
         end;
236 
 
237 
         --- test 4 ---
238 
         declare
239 
            T : constant := Real'Model_EMin + 1;
240 
            Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
241 
            U : Complex := (Tiny, Tiny);
242 
            X : Complex := (0.0, 0.0);
243 
            Z : Complex;
244 
         begin
245 
            if Real'Machine_Overflows then
246 
               Z := U / X;
247 
               Report.Failed ("test 4 - Constraint_Error not raised");
248 
               Check (Z, Z, "not executed - optimizer thwarting", 0.0);
249 
            end if;
250 
         exception
251 
            when Constraint_Error => null;  -- expected
252 
            when others =>
253 
               Report.Failed ("exception in test 4");
254 
         end;
255 
 
256 
 
257 
         --- test 5 ---
258 
         declare
259 
            X : Complex := (Sqrt2, Sqrt2);
260 
            Z : Complex;
261 
            Expected : constant Complex := (0.0, 4.0);
262 
         begin
263 
            Z := X * X;
264 
            Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)",
265 
                   Mult_MBE);
266 
         exception
267 
            when Constraint_Error =>
268 
               Report.Failed ("Constraint_Error raised in test 5");
269 
            when others =>
270 
               Report.Failed ("exception in test 5");
271 
         end;
272 
 
273 
         --- test 6 ---
274 
         declare
275 
            X : Complex := Sqrt3 - Sqrt3 * i;
276 
            Z : Complex;
277 
            Expected : constant Complex := (0.0, -6.0);
278 
         begin
279 
            Z := X * X;
280 
            Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)",
281 
                   Mult_MBE);
282 
         exception
283 
            when Constraint_Error =>
284 
               Report.Failed ("Constraint_Error raised in test 6");
285 
            when others =>
286 
               Report.Failed ("exception in test 6");
287 
         end;
288 
 
289 
         --- test 7 ---
290 
         declare
291 
            X : Complex := Sqrt2 + Sqrt2 * i;
292 
            Y : Complex := Sqrt2 - Sqrt2 * i;
293 
            Z : Complex;
294 
            Expected : constant Complex := 0.0 + i;
295 
         begin
296 
            Z := X / Y;
297 
            Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)",
298 
                   Divide_MBE);
299 
         exception
300 
            when Constraint_Error =>
301 
               Report.Failed ("Constraint_Error raised in test 7");
302 
            when others =>
303 
               Report.Failed ("exception in test 7");
304 
         end;
305 
      end Special_Values;
306 
 
307 
 
308 
      procedure Do_Mult_Div (X, Y : Complex) is
309 
         Z : Complex;
310 
         Args : constant String :=
311 
           "X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " &
312 
           "Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ;
313 
      begin
314 
         Z := (X * X) / X;
315 
         Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE);
316 
         Z := (X * Y) / X;
317 
         Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE);
318 
         Z := (X * Y) / Y;
319 
         Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE);
320 
      exception
321 
         when Constraint_Error =>
322 
            Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args);
323 
         when others =>
324 
            Report.Failed ("exception in Do_Mult_Div for " & Args);
325 
      end Do_Mult_Div;
326 
 
327 
      -- select complex values X and Y where the real and imaginary
328 
      -- parts are selected from the ranges (1/radix..1) and
329 
      -- (1..radix).  This translates into quite a few combinations.
330 
      procedure Mult_Div_Check is
331 
         Samples : constant := 17;
332 
         Radix : constant Real := Real(Real'Machine_Radix);
333 
         Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix);
334 
         Low_Sample : Real;  -- (1/radix .. 1)
335 
         High_Sample : Real; -- (1 .. radix)
336 
         Sample : array (1..2) of Real;
337 
         X, Y : Complex;
338 
      begin
339 
         for I in 1 .. Samples loop
340 
            Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) +
341 
                          Inv_Radix;
342 
            Sample (1) := Low_Sample;
343 
            for J in 1 .. Samples loop
344 
               High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) +
345 
                              Radix;
346 
               Sample (2) := High_Sample;
347 
               for K in 1 .. 2 loop
348 
                  for L in 1 .. 2 loop
349 
                     X := Complex'(Sample (K), Sample (L));
350 
                     Y := Complex'(Sample (L), Sample (K));
351 
                     Do_Mult_Div (X, Y);
352 
                     if Failure_Detected then
353 
                        return;   -- minimize flood of error messages
354 
                     end if;
355 
                  end loop;
356 
               end loop;
357 
            end loop;  -- J
358 
         end loop;  -- I
359 
      end Mult_Div_Check;
360 
 
361 
 
362 
      procedure Do_Test is
363 
      begin
364 
         Special_Values;
365 
         Mult_Div_Check;
366 
      end Do_Test;
367 
   end Float_Check;
368 
 
369 
   -----------------------------------------------------------------------
370 
   -----------------------------------------------------------------------
371 
   -- check the floating point type with the most digits
372 
 
373 
   package A_Long_Float_Check is
374 
      type A_Long_Float is digits System.Max_Digits;
375 
      subtype Real is A_Long_Float;
376 
      procedure Do_Test;
377 
   end A_Long_Float_Check;
378 
 
379 
   package body A_Long_Float_Check is
380 
 
381 
      package Complex_Types is new
382 
           Ada.Numerics.Generic_Complex_Types (Real);
383 
      use Complex_Types;
384 
 
385 
      -- keep track if an accuracy failure has occurred so the test
386 
      -- can be short-circuited to avoid thousands of error messages.
387 
      Failure_Detected : Boolean := False;
388 
 
389 
      Mult_MBE : constant Real := 5.0;
390 
      Divide_MBE : constant Real := 13.0;
391 
 
392 
 
393 
      procedure Check (Actual, Expected : Complex;
394 
                       Test_Name : String;
395 
                       MBE : Real) is
396 
         Rel_Error : Real;
397 
         Abs_Error : Real;
398 
         Max_Error : Real;
399 
      begin
400 
         -- In the case where the expected result is very small or 0
401 
         -- we compute the maximum error as a multiple of Model_Epsilon instead
402 
         -- of Model_Epsilon and Expected.
403 
         Rel_Error := MBE * abs Expected.Re * Real'Model_Epsilon;
404 
         Abs_Error := MBE * Real'Model_Epsilon;
405 
         if Rel_Error > Abs_Error then
406 
            Max_Error := Rel_Error;
407 
         else
408 
            Max_Error := Abs_Error;
409 
         end if;
410 
 
411 
         if abs (Actual.Re - Expected.Re) > Max_Error then
412 
            Failure_Detected := True;
413 
            Report.Failed (Test_Name &
414 
                           " actual.re: " & Real'Image (Actual.Re) &
415 
                           " expected.re: " & Real'Image (Expected.Re) &
416 
                           " difference.re " &
417 
                           Real'Image (Actual.Re - Expected.Re) &
418 
                           " mre:" & Real'Image (Max_Error) );
419 
         elsif Verbose then
420 
            if Actual = Expected then
421 
               Report.Comment (Test_Name & " exact result for real part");
422 
            else
423 
               Report.Comment (Test_Name & " passed for real part");
424 
            end if;
425 
         end if;
426 
 
427 
         Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon;
428 
         if Rel_Error > Abs_Error then
429 
            Max_Error := Rel_Error;
430 
         else
431 
            Max_Error := Abs_Error;
432 
         end if;
433 
         if abs (Actual.Im - Expected.Im) > Max_Error then
434 
            Failure_Detected := True;
435 
            Report.Failed (Test_Name &
436 
                           " actual.im: " & Real'Image (Actual.Im) &
437 
                           " expected.im: " & Real'Image (Expected.Im) &
438 
                           " difference.im " &
439 
                           Real'Image (Actual.Im - Expected.Im) &
440 
                           " mre:" & Real'Image (Max_Error) );
441 
         elsif Verbose then
442 
            if Actual = Expected then
443 
               Report.Comment (Test_Name & " exact result for imaginary part");
444 
            else
445 
               Report.Comment (Test_Name & " passed for imaginary part");
446 
            end if;
447 
         end if;
448 
      end Check;
449 
 
450 
 
451 
      procedure Special_Values is
452 
      begin
453 
 
454 
         --- test 1 ---
455 
         declare
456 
            T : constant := (Real'Machine_EMax - 1) / 2;
457 
            Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
458 
            Expected : Complex := (0.0, 0.0);
459 
            X : Complex := (0.0, 0.0);
460 
            Y : Complex := (Big, Big);
461 
            Z : Complex;
462 
         begin
463 
            Z := X * Y;
464 
            Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)",
465 
                   Mult_MBE);
466 
            Z := Y * X;
467 
            Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)",
468 
                   Mult_MBE);
469 
         exception
470 
            when Constraint_Error =>
471 
               Report.Failed ("Constraint_Error raised in test 1");
472 
            when others =>
473 
               Report.Failed ("exception in test 1");
474 
         end;
475 
 
476 
         --- test 2 ---
477 
         declare
478 
            T : constant := Real'Model_EMin + 1;
479 
            Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
480 
            U : Complex := (Tiny, Tiny);
481 
            X : Complex := (0.0, 0.0);
482 
            Expected : Complex := (0.0, 0.0);
483 
            Z : Complex;
484 
         begin
485 
            Z := U * X;
486 
            Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)",
487 
                   Mult_MBE);
488 
         exception
489 
            when Constraint_Error =>
490 
               Report.Failed ("Constraint_Error raised in test 2");
491 
            when others =>
492 
               Report.Failed ("exception in test 2");
493 
         end;
494 
 
495 
         --- test 3 ---
496 
         declare
497 
            T : constant := (Real'Machine_EMax - 1) / 2;
498 
            Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
499 
            B : Complex := (Big, Big);
500 
            X : Complex := (0.0, 0.0);
501 
            Z : Complex;
502 
         begin
503 
            if Real'Machine_Overflows then
504 
               Z := B / X;
505 
               Report.Failed ("test 3 - Constraint_Error not raised");
506 
               Check (Z, Z, "not executed - optimizer thwarting", 0.0);
507 
            end if;
508 
         exception
509 
            when Constraint_Error => null;  -- expected
510 
            when others =>
511 
               Report.Failed ("exception in test 3");
512 
         end;
513 
 
514 
         --- test 4 ---
515 
         declare
516 
            T : constant := Real'Model_EMin + 1;
517 
            Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
518 
            U : Complex := (Tiny, Tiny);
519 
            X : Complex := (0.0, 0.0);
520 
            Z : Complex;
521 
         begin
522 
            if Real'Machine_Overflows then
523 
               Z := U / X;
524 
               Report.Failed ("test 4 - Constraint_Error not raised");
525 
               Check (Z, Z, "not executed - optimizer thwarting", 0.0);
526 
            end if;
527 
         exception
528 
            when Constraint_Error => null;  -- expected
529 
            when others =>
530 
               Report.Failed ("exception in test 4");
531 
         end;
532 
 
533 
 
534 
         --- test 5 ---
535 
         declare
536 
            X : Complex := (Sqrt2, Sqrt2);
537 
            Z : Complex;
538 
            Expected : constant Complex := (0.0, 4.0);
539 
         begin
540 
            Z := X * X;
541 
            Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)",
542 
                   Mult_MBE);
543 
         exception
544 
            when Constraint_Error =>
545 
               Report.Failed ("Constraint_Error raised in test 5");
546 
            when others =>
547 
               Report.Failed ("exception in test 5");
548 
         end;
549 
 
550 
         --- test 6 ---
551 
         declare
552 
            X : Complex := Sqrt3 - Sqrt3 * i;
553 
            Z : Complex;
554 
            Expected : constant Complex := (0.0, -6.0);
555 
         begin
556 
            Z := X * X;
557 
            Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)",
558 
                   Mult_MBE);
559 
         exception
560 
            when Constraint_Error =>
561 
               Report.Failed ("Constraint_Error raised in test 6");
562 
            when others =>
563 
               Report.Failed ("exception in test 6");
564 
         end;
565 
 
566 
         --- test 7 ---
567 
         declare
568 
            X : Complex := Sqrt2 + Sqrt2 * i;
569 
            Y : Complex := Sqrt2 - Sqrt2 * i;
570 
            Z : Complex;
571 
            Expected : constant Complex := 0.0 + i;
572 
         begin
573 
            Z := X / Y;
574 
            Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)",
575 
                   Divide_MBE);
576 
         exception
577 
            when Constraint_Error =>
578 
               Report.Failed ("Constraint_Error raised in test 7");
579 
            when others =>
580 
               Report.Failed ("exception in test 7");
581 
         end;
582 
      end Special_Values;
583 
 
584 
 
585 
      procedure Do_Mult_Div (X, Y : Complex) is
586 
         Z : Complex;
587 
         Args : constant String :=
588 
           "X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " &
589 
           "Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ;
590 
      begin
591 
         Z := (X * X) / X;
592 
         Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE);
593 
         Z := (X * Y) / X;
594 
         Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE);
595 
         Z := (X * Y) / Y;
596 
         Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE);
597 
      exception
598 
         when Constraint_Error =>
599 
            Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args);
600 
         when others =>
601 
            Report.Failed ("exception in Do_Mult_Div for " & Args);
602 
      end Do_Mult_Div;
603 
 
604 
      -- select complex values X and Y where the real and imaginary
605 
      -- parts are selected from the ranges (1/radix..1) and
606 
      -- (1..radix).  This translates into quite a few combinations.
607 
      procedure Mult_Div_Check is
608 
         Samples : constant := 17;
609 
         Radix : constant Real := Real(Real'Machine_Radix);
610 
         Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix);
611 
         Low_Sample : Real;  -- (1/radix .. 1)
612 
         High_Sample : Real; -- (1 .. radix)
613 
         Sample : array (1..2) of Real;
614 
         X, Y : Complex;
615 
      begin
616 
         for I in 1 .. Samples loop
617 
            Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) +
618 
                          Inv_Radix;
619 
            Sample (1) := Low_Sample;
620 
            for J in 1 .. Samples loop
621 
               High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) +
622 
                              Radix;
623 
               Sample (2) := High_Sample;
624 
               for K in 1 .. 2 loop
625 
                  for L in 1 .. 2 loop
626 
                     X := Complex'(Sample (K), Sample (L));
627 
                     Y := Complex'(Sample (L), Sample (K));
628 
                     Do_Mult_Div (X, Y);
629 
                     if Failure_Detected then
630 
                        return;   -- minimize flood of error messages
631 
                     end if;
632 
                  end loop;
633 
               end loop;
634 
            end loop;  -- J
635 
         end loop;  -- I
636 
      end Mult_Div_Check;
637 
 
638 
 
639 
      procedure Do_Test is
640 
      begin
641 
         Special_Values;
642 
         Mult_Div_Check;
643 
      end Do_Test;
644 
   end A_Long_Float_Check;
645 
 
646 
   -----------------------------------------------------------------------
647 
   -----------------------------------------------------------------------
648 
 
649 
   package Non_Generic_Check is
650 
      subtype Real is Float;
651 
      procedure Do_Test;
652 
   end Non_Generic_Check;
653 
 
654 
   package body Non_Generic_Check is
655 
 
656 
      use Ada.Numerics.Complex_Types;
657 
 
658 
      -- keep track if an accuracy failure has occurred so the test
659 
      -- can be short-circuited to avoid thousands of error messages.
660 
      Failure_Detected : Boolean := False;
661 
 
662 
      Mult_MBE : constant Real := 5.0;
663 
      Divide_MBE : constant Real := 13.0;
664 
 
665 
 
666 
      procedure Check (Actual, Expected : Complex;
667 
                       Test_Name : String;
668 
                       MBE : Real) is
669 
         Rel_Error : Real;
670 
         Abs_Error : Real;
671 
         Max_Error : Real;
672 
      begin
673 
         -- In the case where the expected result is very small or 0
674 
         -- we compute the maximum error as a multiple of Model_Epsilon instead
675 
         -- of Model_Epsilon and Expected.
676 
         Rel_Error := MBE * abs Expected.Re * Real'Model_Epsilon;
677 
         Abs_Error := MBE * Real'Model_Epsilon;
678 
         if Rel_Error > Abs_Error then
679 
            Max_Error := Rel_Error;
680 
         else
681 
            Max_Error := Abs_Error;
682 
         end if;
683 
 
684 
         if abs (Actual.Re - Expected.Re) > Max_Error then
685 
            Failure_Detected := True;
686 
            Report.Failed (Test_Name &
687 
                           " actual.re: " & Real'Image (Actual.Re) &
688 
                           " expected.re: " & Real'Image (Expected.Re) &
689 
                           " difference.re " &
690 
                           Real'Image (Actual.Re - Expected.Re) &
691 
                           " mre:" & Real'Image (Max_Error) );
692 
         elsif Verbose then
693 
            if Actual = Expected then
694 
               Report.Comment (Test_Name & " exact result for real part");
695 
            else
696 
               Report.Comment (Test_Name & " passed for real part");
697 
            end if;
698 
         end if;
699 
 
700 
         Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon;
701 
         if Rel_Error > Abs_Error then
702 
            Max_Error := Rel_Error;
703 
         else
704 
            Max_Error := Abs_Error;
705 
         end if;
706 
         if abs (Actual.Im - Expected.Im) > Max_Error then
707 
            Failure_Detected := True;
708 
            Report.Failed (Test_Name &
709 
                           " actual.im: " & Real'Image (Actual.Im) &
710 
                           " expected.im: " & Real'Image (Expected.Im) &
711 
                           " difference.im " &
712 
                           Real'Image (Actual.Im - Expected.Im) &
713 
                           " mre:" & Real'Image (Max_Error) );
714 
         elsif Verbose then
715 
            if Actual = Expected then
716 
               Report.Comment (Test_Name & " exact result for imaginary part");
717 
            else
718 
               Report.Comment (Test_Name & " passed for imaginary part");
719 
            end if;
720 
         end if;
721 
      end Check;
722 
 
723 
 
724 
      procedure Special_Values is
725 
      begin
726 
 
727 
         --- test 1 ---
728 
         declare
729 
            T : constant := (Real'Machine_EMax - 1) / 2;
730 
            Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
731 
            Expected : Complex := (0.0, 0.0);
732 
            X : Complex := (0.0, 0.0);
733 
            Y : Complex := (Big, Big);
734 
            Z : Complex;
735 
         begin
736 
            Z := X * Y;
737 
            Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)",
738 
                   Mult_MBE);
739 
            Z := Y * X;
740 
            Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)",
741 
                   Mult_MBE);
742 
         exception
743 
            when Constraint_Error =>
744 
               Report.Failed ("Constraint_Error raised in test 1");
745 
            when others =>
746 
               Report.Failed ("exception in test 1");
747 
         end;
748 
 
749 
         --- test 2 ---
750 
         declare
751 
            T : constant := Real'Model_EMin + 1;
752 
            Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
753 
            U : Complex := (Tiny, Tiny);
754 
            X : Complex := (0.0, 0.0);
755 
            Expected : Complex := (0.0, 0.0);
756 
            Z : Complex;
757 
         begin
758 
            Z := U * X;
759 
            Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)",
760 
                   Mult_MBE);
761 
         exception
762 
            when Constraint_Error =>
763 
               Report.Failed ("Constraint_Error raised in test 2");
764 
            when others =>
765 
               Report.Failed ("exception in test 2");
766 
         end;
767 
 
768 
         --- test 3 ---
769 
         declare
770 
            T : constant := (Real'Machine_EMax - 1) / 2;
771 
            Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
772 
            B : Complex := (Big, Big);
773 
            X : Complex := (0.0, 0.0);
774 
            Z : Complex;
775 
         begin
776 
            if Real'Machine_Overflows then
777 
               Z := B / X;
778 
               Report.Failed ("test 3 - Constraint_Error not raised");
779 
               Check (Z, Z, "not executed - optimizer thwarting", 0.0);
780 
            end if;
781 
         exception
782 
            when Constraint_Error => null;  -- expected
783 
            when others =>
784 
               Report.Failed ("exception in test 3");
785 
         end;
786 
 
787 
         --- test 4 ---
788 
         declare
789 
            T : constant := Real'Model_EMin + 1;
790 
            Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
791 
            U : Complex := (Tiny, Tiny);
792 
            X : Complex := (0.0, 0.0);
793 
            Z : Complex;
794 
         begin
795 
            if Real'Machine_Overflows then
796 
               Z := U / X;
797 
               Report.Failed ("test 4 - Constraint_Error not raised");
798 
               Check (Z, Z, "not executed - optimizer thwarting", 0.0);
799 
            end if;
800 
         exception
801 
            when Constraint_Error => null;  -- expected
802 
            when others =>
803 
               Report.Failed ("exception in test 4");
804 
         end;
805 
 
806 
 
807 
         --- test 5 ---
808 
         declare
809 
            X : Complex := (Sqrt2, Sqrt2);
810 
            Z : Complex;
811 
            Expected : constant Complex := (0.0, 4.0);
812 
         begin
813 
            Z := X * X;
814 
            Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)",
815 
                   Mult_MBE);
816 
         exception
817 
            when Constraint_Error =>
818 
               Report.Failed ("Constraint_Error raised in test 5");
819 
            when others =>
820 
               Report.Failed ("exception in test 5");
821 
         end;
822 
 
823 
         --- test 6 ---
824 
         declare
825 
            X : Complex := Sqrt3 - Sqrt3 * i;
826 
            Z : Complex;
827 
            Expected : constant Complex := (0.0, -6.0);
828 
         begin
829 
            Z := X * X;
830 
            Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)",
831 
                   Mult_MBE);
832 
         exception
833 
            when Constraint_Error =>
834 
               Report.Failed ("Constraint_Error raised in test 6");
835 
            when others =>
836 
               Report.Failed ("exception in test 6");
837 
         end;
838 
 
839 
         --- test 7 ---
840 
         declare
841 
            X : Complex := Sqrt2 + Sqrt2 * i;
842 
            Y : Complex := Sqrt2 - Sqrt2 * i;
843 
            Z : Complex;
844 
            Expected : constant Complex := 0.0 + i;
845 
         begin
846 
            Z := X / Y;
847 
            Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)",
848 
                   Divide_MBE);
849 
         exception
850 
            when Constraint_Error =>
851 
               Report.Failed ("Constraint_Error raised in test 7");
852 
            when others =>
853 
               Report.Failed ("exception in test 7");
854 
         end;
855 
      end Special_Values;
856 
 
857 
 
858 
      procedure Do_Mult_Div (X, Y : Complex) is
859 
         Z : Complex;
860 
         Args : constant String :=
861 
           "X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " &
862 
           "Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ;
863 
      begin
864 
         Z := (X * X) / X;
865 
         Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE);
866 
         Z := (X * Y) / X;
867 
         Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE);
868 
         Z := (X * Y) / Y;
869 
         Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE);
870 
      exception
871 
         when Constraint_Error =>
872 
            Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args);
873 
         when others =>
874 
            Report.Failed ("exception in Do_Mult_Div for " & Args);
875 
      end Do_Mult_Div;
876 
 
877 
      -- select complex values X and Y where the real and imaginary
878 
      -- parts are selected from the ranges (1/radix..1) and
879 
      -- (1..radix).  This translates into quite a few combinations.
880 
      procedure Mult_Div_Check is
881 
         Samples : constant := 17;
882 
         Radix : constant Real := Real(Real'Machine_Radix);
883 
         Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix);
884 
         Low_Sample : Real;  -- (1/radix .. 1)
885 
         High_Sample : Real; -- (1 .. radix)
886 
         Sample : array (1..2) of Real;
887 
         X, Y : Complex;
888 
      begin
889 
         for I in 1 .. Samples loop
890 
            Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) +
891 
                          Inv_Radix;
892 
            Sample (1) := Low_Sample;
893 
            for J in 1 .. Samples loop
894 
               High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) +
895 
                              Radix;
896 
               Sample (2) := High_Sample;
897 
               for K in 1 .. 2 loop
898 
                  for L in 1 .. 2 loop
899 
                     X := Complex'(Sample (K), Sample (L));
900 
                     Y := Complex'(Sample (L), Sample (K));
901 
                     Do_Mult_Div (X, Y);
902 
                     if Failure_Detected then
903 
                        return;   -- minimize flood of error messages
904 
                     end if;
905 
                  end loop;
906 
               end loop;
907 
            end loop;  -- J
908 
         end loop;  -- I
909 
      end Mult_Div_Check;
910 
 
911 
 
912 
      procedure Do_Test is
913 
      begin
914 
         Special_Values;
915 
         Mult_Div_Check;
916 
      end Do_Test;
917 
   end Non_Generic_Check;
918 
 
919 
   -----------------------------------------------------------------------
920 
   -----------------------------------------------------------------------
921 
 
922 
begin
923 
   Report.Test ("CXG2008",
924 
                "Check the accuracy of the complex multiplication and" &
925 
                " division operators");
926 
 
927 
   if Verbose then
928 
      Report.Comment ("checking Standard.Float");
929 
   end if;
930 
 
931 
   Float_Check.Do_Test;
932 
 
933 
   if Verbose then
934 
      Report.Comment ("checking a digits" &
935 
                      Integer'Image (System.Max_Digits) &
936 
                      " floating point type");
937 
   end if;
938 
 
939 
   A_Long_Float_Check.Do_Test;
940 
 
941 
   if Verbose then
942 
      Report.Comment ("checking non-generic package");
943 
   end if;
944 
 
945 
   Non_Generic_Check.Do_Test;
946 
 
947 
   Report.Result;
948 
end CXG2008;

powered by: WebSVN 2.1.0

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