|
111
|
1 -- CXG2002.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 "abs" or modulus function returns
|
|
|
28 -- results that are within the error bound allowed.
|
|
|
29 --
|
|
|
30 -- TEST DESCRIPTION:
|
|
|
31 -- This test uses a generic package to compute and check the
|
|
|
32 -- values of the modulus function. In addition, a non-generic
|
|
|
33 -- copy of this package is used to check the non-generic package
|
|
|
34 -- Ada.Numerics.Complex_Types.
|
|
|
35 -- Of special interest is the case where either the real or
|
|
|
36 -- the imaginary part of the argument is very large while the
|
|
|
37 -- other part is very small or 0.
|
|
|
38 -- We want to check that the value is computed such that
|
|
|
39 -- an overflow does not occur. If computed directly from the
|
|
|
40 -- definition
|
|
|
41 -- abs (x+yi) = sqrt(x**2 + y**2)
|
|
|
42 -- then overflow or underflow is much more likely than if the
|
|
|
43 -- argument is normalized first.
|
|
|
44 --
|
|
|
45 -- SPECIAL REQUIREMENTS
|
|
|
46 -- The Strict Mode for the numerical accuracy must be
|
|
|
47 -- selected. The method by which this mode is selected
|
|
|
48 -- is implementation dependent.
|
|
|
49 --
|
|
|
50 -- APPLICABILITY CRITERIA:
|
|
|
51 -- This test applies only to implementations supporting the
|
|
|
52 -- Numerics Annex.
|
|
|
53 -- This test only applies to the Strict Mode for numerical
|
|
|
54 -- accuracy.
|
|
|
55 --
|
|
|
56 --
|
|
|
57 -- CHANGE HISTORY:
|
|
|
58 -- 31 JAN 96 SAIC Initial release for 2.1
|
|
|
59 -- 02 JUN 98 EDS Add parens to intermediate calculations.
|
|
|
60 --!
|
|
|
61
|
|
|
62 --
|
|
|
63 -- Reference:
|
|
|
64 -- Problems and Methodologies in Mathematical Software Production;
|
|
|
65 -- editors: P. C. Messina and A Murli;
|
|
|
66 -- Lecture Notes in Computer Science
|
|
|
67 -- Volume 142
|
|
|
68 -- Springer Verlag 1982
|
|
|
69 --
|
|
|
70
|
|
|
71 with System;
|
|
|
72 with Report;
|
|
|
73 with Ada.Numerics.Generic_Complex_Types;
|
|
|
74 with Ada.Numerics.Complex_Types;
|
|
|
75 procedure CXG2002 is
|
|
|
76 Verbose : constant Boolean := False;
|
|
|
77 Maximum_Relative_Error : constant := 3.0;
|
|
|
78
|
|
|
79 generic
|
|
|
80 type Real is digits <>;
|
|
|
81 package Generic_Check is
|
|
|
82 procedure Do_Test;
|
|
|
83 end Generic_Check;
|
|
|
84
|
|
|
85 package body Generic_Check is
|
|
|
86 package Complex_Types is new
|
|
|
87 Ada.Numerics.Generic_Complex_Types (Real);
|
|
|
88 use Complex_Types;
|
|
|
89
|
|
|
90 procedure Check (Actual, Expected : Real;
|
|
|
91 Test_Name : String;
|
|
|
92 MRE : Real := Maximum_Relative_Error) is
|
|
|
93 Rel_Error,
|
|
|
94 Abs_Error,
|
|
|
95 Max_Error : Real;
|
|
|
96 begin
|
|
|
97 -- In the case where the expected result is very small or 0
|
|
|
98 -- we compute the maximum error as a multiple of Model_Epsilon instead
|
|
|
99 -- of Model_Epsilon and Expected.
|
|
|
100 Rel_Error := MRE * (abs Expected * Real'Model_Epsilon);
|
|
|
101 Abs_Error := MRE * Real'Model_Epsilon;
|
|
|
102 if Rel_Error > Abs_Error then
|
|
|
103 Max_Error := Rel_Error;
|
|
|
104 else
|
|
|
105 Max_Error := Abs_Error;
|
|
|
106 end if;
|
|
|
107
|
|
|
108 if abs (Actual - Expected) > Max_Error then
|
|
|
109 Report.Failed (Test_Name &
|
|
|
110 " actual: " & Real'Image (Actual) &
|
|
|
111 " expected: " & Real'Image (Expected) &
|
|
|
112 " difference: " &
|
|
|
113 Real'Image (Expected - Actual) &
|
|
|
114 " max_err:" & Real'Image (Max_Error) );
|
|
|
115 elsif Verbose then
|
|
|
116 if Actual = Expected then
|
|
|
117 Report.Comment (Test_Name & " exact result");
|
|
|
118 else
|
|
|
119 Report.Comment (Test_Name & " passed");
|
|
|
120 end if;
|
|
|
121 end if;
|
|
|
122 end Check;
|
|
|
123
|
|
|
124
|
|
|
125 procedure Do_Test is
|
|
|
126 Z : Complex;
|
|
|
127 X : Real;
|
|
|
128 T : Real;
|
|
|
129 begin
|
|
|
130
|
|
|
131 --- test 1 ---
|
|
|
132 begin
|
|
|
133 T := Real'Safe_Last;
|
|
|
134 Z := T + 0.0*i;
|
|
|
135 X := abs Z;
|
|
|
136 Check (X, T, "test 1 -- abs(bigreal + 0i)");
|
|
|
137 exception
|
|
|
138 when Constraint_Error =>
|
|
|
139 Report.Failed ("Constraint_Error raised in test 1");
|
|
|
140 when others =>
|
|
|
141 Report.Failed ("exception in test 1");
|
|
|
142 end;
|
|
|
143
|
|
|
144 --- test 2 ---
|
|
|
145 begin
|
|
|
146 T := Real'Safe_Last;
|
|
|
147 Z := 0.0 + T*i;
|
|
|
148 X := Modulus (Z);
|
|
|
149 Check (X, T, "test 2 -- abs(0 + bigreal*i)");
|
|
|
150 exception
|
|
|
151 when Constraint_Error =>
|
|
|
152 Report.Failed ("Constraint_Error raised in test 2");
|
|
|
153 when others =>
|
|
|
154 Report.Failed ("exception in test 2");
|
|
|
155 end;
|
|
|
156
|
|
|
157 --- test 3 ---
|
|
|
158 begin
|
|
|
159 Z := 3.0 + 4.0*i;
|
|
|
160 X := abs Z;
|
|
|
161 Check (X, 5.0 , "test 3 -- abs(3 + 4*i)");
|
|
|
162 exception
|
|
|
163 when Constraint_Error =>
|
|
|
164 Report.Failed ("Constraint_Error raised in test 3");
|
|
|
165 when others =>
|
|
|
166 Report.Failed ("exception in test 3");
|
|
|
167 end;
|
|
|
168
|
|
|
169 --- test 4 ---
|
|
|
170 declare
|
|
|
171 S : Real;
|
|
|
172 begin
|
|
|
173 S := Real(Real'Machine_Radix) ** (Real'Machine_EMax - 3);
|
|
|
174 Z := 3.0 * S + 4.0*S*i;
|
|
|
175 X := abs Z;
|
|
|
176 Check (X, 5.0*S, "test 4 -- abs(3S + 4S*i) for large S",
|
|
|
177 5.0*Real'Model_Epsilon);
|
|
|
178 exception
|
|
|
179 when Constraint_Error =>
|
|
|
180 Report.Failed ("Constraint_Error raised in test 4");
|
|
|
181 when others =>
|
|
|
182 Report.Failed ("exception in test 4");
|
|
|
183 end;
|
|
|
184
|
|
|
185 --- test 5 ---
|
|
|
186 begin
|
|
|
187 T := Real'Model_Small;
|
|
|
188 Z := T + 0.0*i;
|
|
|
189 X := abs Z;
|
|
|
190 Check (X, T , "test 5 -- abs(small + 0*i)");
|
|
|
191 exception
|
|
|
192 when Constraint_Error =>
|
|
|
193 Report.Failed ("Constraint_Error raised in test 5");
|
|
|
194 when others =>
|
|
|
195 Report.Failed ("exception in test 5");
|
|
|
196 end;
|
|
|
197
|
|
|
198 --- test 6 ---
|
|
|
199 begin
|
|
|
200 T := Real'Model_Small;
|
|
|
201 Z := 0.0 + T*i;
|
|
|
202 X := abs Z;
|
|
|
203 Check (X, T , "test 6 -- abs(0 + small*i)");
|
|
|
204 exception
|
|
|
205 when Constraint_Error =>
|
|
|
206 Report.Failed ("Constraint_Error raised in test 6");
|
|
|
207 when others =>
|
|
|
208 Report.Failed ("exception in test 6");
|
|
|
209 end;
|
|
|
210
|
|
|
211 --- test 7 ---
|
|
|
212 declare
|
|
|
213 S : Real;
|
|
|
214 begin
|
|
|
215 S := Real(Real'Machine_Radix) ** (Real'Model_EMin + 3);
|
|
|
216 Z := 3.0 * S + 4.0*S*i;
|
|
|
217 X := abs Z;
|
|
|
218 Check (X, 5.0*S, "test 7 -- abs(3S + 4S*i) for small S",
|
|
|
219 5.0*Real'Model_Epsilon);
|
|
|
220 exception
|
|
|
221 when Constraint_Error =>
|
|
|
222 Report.Failed ("Constraint_Error raised in test 7");
|
|
|
223 when others =>
|
|
|
224 Report.Failed ("exception in test 7");
|
|
|
225 end;
|
|
|
226
|
|
|
227 --- test 8 ---
|
|
|
228 declare
|
|
|
229 -- CRC Standard Mathematical Tables; 23rd Edition; pg 738
|
|
|
230 Sqrt2 : constant :=
|
|
|
231 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
|
|
|
232 begin
|
|
|
233 Z := 1.0 + 1.0*i;
|
|
|
234 X := abs Z;
|
|
|
235 Check (X, Sqrt2 , "test 8 -- abs(1 + 1*i)");
|
|
|
236 exception
|
|
|
237 when Constraint_Error =>
|
|
|
238 Report.Failed ("Constraint_Error raised in test 8");
|
|
|
239 when others =>
|
|
|
240 Report.Failed ("exception in test 8");
|
|
|
241 end;
|
|
|
242
|
|
|
243 --- test 9 ---
|
|
|
244 begin
|
|
|
245 T := 0.0;
|
|
|
246 Z := T + 0.0*i;
|
|
|
247 X := abs Z;
|
|
|
248 Check (X, T , "test 5 -- abs(0 + 0*i)");
|
|
|
249 exception
|
|
|
250 when Constraint_Error =>
|
|
|
251 Report.Failed ("Constraint_Error raised in test 9");
|
|
|
252 when others =>
|
|
|
253 Report.Failed ("exception in test 9");
|
|
|
254 end;
|
|
|
255 end Do_Test;
|
|
|
256 end Generic_Check;
|
|
|
257
|
|
|
258 -----------------------------------------------------------------------
|
|
|
259 --- non generic copy of the above generic package
|
|
|
260 -----------------------------------------------------------------------
|
|
|
261
|
|
|
262 package Non_Generic_Check is
|
|
|
263 subtype Real is Float;
|
|
|
264 procedure Do_Test;
|
|
|
265 end Non_Generic_Check;
|
|
|
266
|
|
|
267 package body Non_Generic_Check is
|
|
|
268 use Ada.Numerics.Complex_Types;
|
|
|
269
|
|
|
270 procedure Check (Actual, Expected : Real;
|
|
|
271 Test_Name : String;
|
|
|
272 MRE : Real := Maximum_Relative_Error) is
|
|
|
273 Rel_Error,
|
|
|
274 Abs_Error,
|
|
|
275 Max_Error : Real;
|
|
|
276 begin
|
|
|
277 -- In the case where the expected result is very small or 0
|
|
|
278 -- we compute the maximum error as a multiple of Model_Epsilon instead
|
|
|
279 -- of Model_Epsilon and Expected.
|
|
|
280 Rel_Error := MRE * (abs Expected * Real'Model_Epsilon);
|
|
|
281 Abs_Error := MRE * Real'Model_Epsilon;
|
|
|
282 if Rel_Error > Abs_Error then
|
|
|
283 Max_Error := Rel_Error;
|
|
|
284 else
|
|
|
285 Max_Error := Abs_Error;
|
|
|
286 end if;
|
|
|
287
|
|
|
288 if abs (Actual - Expected) > Max_Error then
|
|
|
289 Report.Failed (Test_Name &
|
|
|
290 " actual: " & Real'Image (Actual) &
|
|
|
291 " expected: " & Real'Image (Expected) &
|
|
|
292 " difference: " &
|
|
|
293 Real'Image (Expected - Actual) &
|
|
|
294 " max_err:" & Real'Image (Max_Error) );
|
|
|
295 elsif Verbose then
|
|
|
296 if Actual = Expected then
|
|
|
297 Report.Comment (Test_Name & " exact result");
|
|
|
298 else
|
|
|
299 Report.Comment (Test_Name & " passed");
|
|
|
300 end if;
|
|
|
301 end if;
|
|
|
302 end Check;
|
|
|
303
|
|
|
304
|
|
|
305 procedure Do_Test is
|
|
|
306 Z : Complex;
|
|
|
307 X : Real;
|
|
|
308 T : Real;
|
|
|
309 begin
|
|
|
310
|
|
|
311 --- test 1 ---
|
|
|
312 begin
|
|
|
313 T := Real'Safe_Last;
|
|
|
314 Z := T + 0.0*i;
|
|
|
315 X := abs Z;
|
|
|
316 Check (X, T, "test 1 -- abs(bigreal + 0i)");
|
|
|
317 exception
|
|
|
318 when Constraint_Error =>
|
|
|
319 Report.Failed ("Constraint_Error raised in test 1");
|
|
|
320 when others =>
|
|
|
321 Report.Failed ("exception in test 1");
|
|
|
322 end;
|
|
|
323
|
|
|
324 --- test 2 ---
|
|
|
325 begin
|
|
|
326 T := Real'Safe_Last;
|
|
|
327 Z := 0.0 + T*i;
|
|
|
328 X := Modulus (Z);
|
|
|
329 Check (X, T, "test 2 -- abs(0 + bigreal*i)");
|
|
|
330 exception
|
|
|
331 when Constraint_Error =>
|
|
|
332 Report.Failed ("Constraint_Error raised in test 2");
|
|
|
333 when others =>
|
|
|
334 Report.Failed ("exception in test 2");
|
|
|
335 end;
|
|
|
336
|
|
|
337 --- test 3 ---
|
|
|
338 begin
|
|
|
339 Z := 3.0 + 4.0*i;
|
|
|
340 X := abs Z;
|
|
|
341 Check (X, 5.0 , "test 3 -- abs(3 + 4*i)");
|
|
|
342 exception
|
|
|
343 when Constraint_Error =>
|
|
|
344 Report.Failed ("Constraint_Error raised in test 3");
|
|
|
345 when others =>
|
|
|
346 Report.Failed ("exception in test 3");
|
|
|
347 end;
|
|
|
348
|
|
|
349 --- test 4 ---
|
|
|
350 declare
|
|
|
351 S : Real;
|
|
|
352 begin
|
|
|
353 S := Real(Real'Machine_Radix) ** (Real'Machine_EMax - 3);
|
|
|
354 Z := 3.0 * S + 4.0*S*i;
|
|
|
355 X := abs Z;
|
|
|
356 Check (X, 5.0*S, "test 4 -- abs(3S + 4S*i) for large S",
|
|
|
357 5.0*Real'Model_Epsilon);
|
|
|
358 exception
|
|
|
359 when Constraint_Error =>
|
|
|
360 Report.Failed ("Constraint_Error raised in test 4");
|
|
|
361 when others =>
|
|
|
362 Report.Failed ("exception in test 4");
|
|
|
363 end;
|
|
|
364
|
|
|
365 --- test 5 ---
|
|
|
366 begin
|
|
|
367 T := Real'Model_Small;
|
|
|
368 Z := T + 0.0*i;
|
|
|
369 X := abs Z;
|
|
|
370 Check (X, T , "test 5 -- abs(small + 0*i)");
|
|
|
371 exception
|
|
|
372 when Constraint_Error =>
|
|
|
373 Report.Failed ("Constraint_Error raised in test 5");
|
|
|
374 when others =>
|
|
|
375 Report.Failed ("exception in test 5");
|
|
|
376 end;
|
|
|
377
|
|
|
378 --- test 6 ---
|
|
|
379 begin
|
|
|
380 T := Real'Model_Small;
|
|
|
381 Z := 0.0 + T*i;
|
|
|
382 X := abs Z;
|
|
|
383 Check (X, T , "test 6 -- abs(0 + small*i)");
|
|
|
384 exception
|
|
|
385 when Constraint_Error =>
|
|
|
386 Report.Failed ("Constraint_Error raised in test 6");
|
|
|
387 when others =>
|
|
|
388 Report.Failed ("exception in test 6");
|
|
|
389 end;
|
|
|
390
|
|
|
391 --- test 7 ---
|
|
|
392 declare
|
|
|
393 S : Real;
|
|
|
394 begin
|
|
|
395 S := Real(Real'Machine_Radix) ** (Real'Model_EMin + 3);
|
|
|
396 Z := 3.0 * S + 4.0*S*i;
|
|
|
397 X := abs Z;
|
|
|
398 Check (X, 5.0*S, "test 7 -- abs(3S + 4S*i) for small S",
|
|
|
399 5.0*Real'Model_Epsilon);
|
|
|
400 exception
|
|
|
401 when Constraint_Error =>
|
|
|
402 Report.Failed ("Constraint_Error raised in test 7");
|
|
|
403 when others =>
|
|
|
404 Report.Failed ("exception in test 7");
|
|
|
405 end;
|
|
|
406
|
|
|
407 --- test 8 ---
|
|
|
408 declare
|
|
|
409 -- CRC Standard Mathematical Tables; 23rd Edition; pg 738
|
|
|
410 Sqrt2 : constant :=
|
|
|
411 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
|
|
|
412 begin
|
|
|
413 Z := 1.0 + 1.0*i;
|
|
|
414 X := abs Z;
|
|
|
415 Check (X, Sqrt2 , "test 8 -- abs(1 + 1*i)");
|
|
|
416 exception
|
|
|
417 when Constraint_Error =>
|
|
|
418 Report.Failed ("Constraint_Error raised in test 8");
|
|
|
419 when others =>
|
|
|
420 Report.Failed ("exception in test 8");
|
|
|
421 end;
|
|
|
422
|
|
|
423 --- test 9 ---
|
|
|
424 begin
|
|
|
425 T := 0.0;
|
|
|
426 Z := T + 0.0*i;
|
|
|
427 X := abs Z;
|
|
|
428 Check (X, T , "test 5 -- abs(0 + 0*i)");
|
|
|
429 exception
|
|
|
430 when Constraint_Error =>
|
|
|
431 Report.Failed ("Constraint_Error raised in test 9");
|
|
|
432 when others =>
|
|
|
433 Report.Failed ("exception in test 9");
|
|
|
434 end;
|
|
|
435 end Do_Test;
|
|
|
436 end Non_Generic_Check;
|
|
|
437
|
|
|
438 -----------------------------------------------------------------------
|
|
|
439 --- end of "manual instantiation"
|
|
|
440 -----------------------------------------------------------------------
|
|
|
441 package Chk_Float is new Generic_Check (Float);
|
|
|
442
|
|
|
443 -- check the floating point type with the most digits
|
|
|
444 type A_Long_Float is digits System.Max_Digits;
|
|
|
445 package Chk_A_Long_Float is new Generic_Check (A_Long_Float);
|
|
|
446 begin
|
|
|
447 Report.Test ("CXG2002",
|
|
|
448 "Check the accuracy of the complex modulus" &
|
|
|
449 " function");
|
|
|
450
|
|
|
451 if Verbose then
|
|
|
452 Report.Comment ("checking Standard.Float");
|
|
|
453 end if;
|
|
|
454 Chk_Float.Do_Test;
|
|
|
455
|
|
|
456 if Verbose then
|
|
|
457 Report.Comment ("checking a digits" &
|
|
|
458 Integer'Image (System.Max_Digits) &
|
|
|
459 " floating point type");
|
|
|
460 end if;
|
|
|
461 Chk_A_Long_Float.Do_Test;
|
|
|
462
|
|
|
463 if Verbose then
|
|
|
464 Report.Comment ("checking non-generic package");
|
|
|
465 end if;
|
|
|
466 Non_Generic_Check.Do_Test;
|
|
|
467 Report.Result;
|
|
|
468 end CXG2002;
|
