Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/cxa/cxa5a03.a @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 -- CXA5A03.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 functions Tan, Tanh, and Arctanh provide correct | |
28 -- results. | |
29 -- | |
30 -- TEST DESCRIPTION: | |
31 -- This test examines both the version of Tan, Tanh, and Arctanh | |
32 -- the instantiation of the Ada.Numerics.Generic_Elementary_Functions | |
33 -- with a type derived from type Float, as well as the preinstantiated | |
34 -- version of this package for type Float. | |
35 -- Prescribed results, including instances prescribed to raise | |
36 -- exceptions, are examined in the test cases. In addition, | |
37 -- certain evaluations are performed where the actual function result | |
38 -- is compared with the expected result (within an epsilon range of | |
39 -- accuracy). | |
40 -- | |
41 -- TEST FILES: | |
42 -- The following files comprise this test: | |
43 -- | |
44 -- FXA5A00.A (foundation code) | |
45 -- CXA5A03.A | |
46 -- | |
47 -- | |
48 -- CHANGE HISTORY: | |
49 -- 14 Mar 95 SAIC Initial prerelease version. | |
50 -- 06 Apr 95 SAIC Corrected errors in context clause references | |
51 -- and usage of Cycle parameter. | |
52 -- 13 Jun 95 SAIC Incorporated use of Dont_Optimize procedure, and | |
53 -- use of Result_Within_Range function overloaded for | |
54 -- FXA5A00.New_Float_Type. | |
55 -- 29 Jun 98 EDS Protected exception tests by first testing | |
56 -- for 'Machine_Overflows | |
57 -- | |
58 --! | |
59 | |
60 with Ada.Numerics.Elementary_Functions; | |
61 with Ada.Numerics.Generic_Elementary_Functions; | |
62 with FXA5A00; | |
63 with Report; | |
64 | |
65 procedure CXA5A03 is | |
66 begin | |
67 | |
68 Report.Test ("CXA5A03", "Check that the functions Tan, Tanh, and " & | |
69 "Arctanh provide correct results"); | |
70 | |
71 Test_Block: | |
72 declare | |
73 | |
74 use Ada.Numerics; | |
75 use FXA5A00; | |
76 | |
77 package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float); | |
78 package EF renames Ada.Numerics.Elementary_Functions; | |
79 | |
80 The_Result : Float; | |
81 New_Float_Result : New_Float; | |
82 | |
83 procedure Dont_Optimize_Float is new Dont_Optimize(Float); | |
84 procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float); | |
85 | |
86 begin | |
87 | |
88 -- Testing of Tan Function, both instantiated and pre-instantiated | |
89 -- version. | |
90 | |
91 -- Check that no exception occurs on computing the Tan with very | |
92 -- large (positive and negative) input values. | |
93 | |
94 begin | |
95 New_Float_Result := GEF.Tan (New_Float(FXA5A00.Large)); | |
96 Dont_Optimize_New_Float(New_Float_Result, 1); | |
97 exception | |
98 when others => | |
99 Report.Failed("Unexpected exception on GEF.Tan with large " & | |
100 "positive value"); | |
101 end; | |
102 | |
103 begin | |
104 The_Result := EF.Tan (FXA5A00.Minus_Large); | |
105 Dont_Optimize_Float(The_Result, 2); | |
106 exception | |
107 when others => | |
108 Report.Failed("Unexpected exception on EF.Tan with large " & | |
109 "negative value"); | |
110 end; | |
111 | |
112 | |
113 -- Check that no exception occurs on computing the Tan with very | |
114 -- small (positive and negative) input values. | |
115 | |
116 begin | |
117 New_Float_Result := GEF.Tan (New_Float(FXA5A00.Small)); | |
118 Dont_Optimize_New_Float(New_Float_Result, 3); | |
119 exception | |
120 when others => | |
121 Report.Failed("Unexpected exception on GEF.Tan with small " & | |
122 "positive value"); | |
123 end; | |
124 | |
125 begin | |
126 The_Result := EF.Tan (-FXA5A00.Small); | |
127 Dont_Optimize_Float(The_Result, 4); | |
128 exception | |
129 when others => | |
130 Report.Failed("Unexpected exception on EF.Tan with small " & | |
131 "negative value"); | |
132 end; | |
133 | |
134 | |
135 -- Check prescribed result from Tan function. When the parameter X | |
136 -- has the value zero, the Tan function yields a result of zero. | |
137 | |
138 if GEF.Tan(0.0) /= 0.0 or | |
139 EF.Tan(0.0) /= 0.0 | |
140 then | |
141 Report.Failed("Incorrect result from Tan function with zero " & | |
142 "value input parameter"); | |
143 end if; | |
144 | |
145 | |
146 -- Check the results of the Tan function with various input parameters. | |
147 | |
148 if not (Result_Within_Range(GEF.Tan(0.7854), 1.0, 0.001) and | |
149 Result_Within_Range(GEF.Tan(0.8436), 1.124, 0.001) and | |
150 Result_Within_Range( EF.Tan(Pi), 0.0, 0.001) and | |
151 Result_Within_Range( EF.Tan(-Pi), 0.0, 0.001) and | |
152 Result_Within_Range(GEF.Tan(0.5381), 0.597, 0.001) and | |
153 Result_Within_Range( EF.Tan(0.1978), 0.200, 0.001)) | |
154 then | |
155 Report.Failed("Incorrect result from Tan function with various " & | |
156 "input parameters"); | |
157 end if; | |
158 | |
159 | |
160 -- Testing of Tan function with cycle parameter. | |
161 | |
162 -- Check that Constraint_Error is raised by the Tan function with | |
163 -- specified cycle, when the value of the parameter X is an odd | |
164 -- multiple of the quarter cycle. | |
165 | |
166 if New_Float'Machine_Overflows = True then | |
167 begin | |
168 New_Float_Result := GEF.Tan(270.0, 360.0); | |
169 Report.Failed("Constraint_Error not raised by GEF.Tan on odd " & | |
170 "multiple of the quarter cycle"); | |
171 Dont_Optimize_New_Float(New_Float_Result, 5); | |
172 exception | |
173 when Constraint_Error => null; -- OK, expected exception. | |
174 when others => | |
175 Report.Failed("Unexpected exception raised by GEF.Tan on odd " & | |
176 "multiple of the quarter cycle"); | |
177 end; | |
178 end if; | |
179 | |
180 -- Check that the exception Numerics.Argument_Error is raised, when | |
181 -- the value of the parameter Cycle is zero or negative. | |
182 | |
183 begin | |
184 New_Float_Result := GEF.Tan(X => 1.0, Cycle => -360.0); | |
185 Report.Failed("Argument_Error not raised by GEF.Tan when Cycle " & | |
186 "parameter has negative value"); | |
187 Dont_Optimize_New_Float(New_Float_Result, 6); | |
188 exception | |
189 when Argument_Error => null; -- OK, expected exception. | |
190 when others => | |
191 Report.Failed("Unexpected exception raised by GEF.Tan when Cycle " & | |
192 "parameter has negative value"); | |
193 end; | |
194 | |
195 begin | |
196 The_Result := EF.Tan(1.0, Cycle => 0.0); | |
197 Report.Failed("Argument_Error not raised by GEF.Tan when Cycle " & | |
198 "parameter has a zero value"); | |
199 Dont_Optimize_Float(The_Result, 7); | |
200 exception | |
201 when Argument_Error => null; -- OK, expected exception. | |
202 when others => | |
203 Report.Failed("Unexpected exception raised by EF.Tan when Cycle " & | |
204 "parameter has a zero value"); | |
205 end; | |
206 | |
207 | |
208 -- Check that no exception occurs on computing the Tan with very | |
209 -- large (positive and negative) input values. | |
210 | |
211 begin | |
212 New_Float_Result := GEF.Tan (New_Float(FXA5A00.Large), 360.0); | |
213 Dont_Optimize_New_Float(New_Float_Result, 8); | |
214 exception | |
215 when others => | |
216 Report.Failed("Unexpected exception on GEF.Tan with large " & | |
217 "positive value"); | |
218 end; | |
219 | |
220 begin | |
221 The_Result := EF.Tan (FXA5A00.Minus_Large, Cycle => 360.0); | |
222 Dont_Optimize_Float(The_Result, 9); | |
223 exception | |
224 when others => | |
225 Report.Failed("Unexpected exception on EF.Tan with large " & | |
226 "negative value"); | |
227 end; | |
228 | |
229 | |
230 -- Check prescribed result from Tan function with Cycle parameter. | |
231 | |
232 if GEF.Tan(0.0, 360.0) /= 0.0 or | |
233 EF.Tan(0.0, Cycle => 360.0) /= 0.0 | |
234 then | |
235 Report.Failed("Incorrect result from Tan function with cycle " & | |
236 "parameter, using a zero value input parameter"); | |
237 end if; | |
238 | |
239 | |
240 -- Check the Tan function, with specified Cycle parameter, with a | |
241 -- variety of input parameters. | |
242 | |
243 if not Result_Within_Range(GEF.Tan(30.0, 360.0), 0.577, 0.001) or | |
244 not Result_Within_Range( EF.Tan(57.0, 360.0), 1.540, 0.001) or | |
245 not Result_Within_Range(GEF.Tan(115.0, 360.0), -2.145, 0.001) or | |
246 not Result_Within_Range( EF.Tan(299.0, 360.0), -1.804, 0.001) or | |
247 not Result_Within_Range(GEF.Tan(390.0, 360.0), 0.577, 0.001) or | |
248 not Result_Within_Range( EF.Tan(520.0, 360.0), -0.364, 0.001) | |
249 then | |
250 Report.Failed("Incorrect result from the Tan function with " & | |
251 "cycle parameter, with various input parameter " & | |
252 "values"); | |
253 end if; | |
254 | |
255 | |
256 | |
257 -- Testing of Tanh Function, both instantiated and pre-instantiated | |
258 -- version. | |
259 | |
260 -- Check that no exception occurs on computing the Tan with very | |
261 -- large (positive and negative) input values. | |
262 | |
263 begin | |
264 New_Float_Result := GEF.Tanh (New_Float(FXA5A00.Large)); | |
265 Dont_Optimize_New_Float(New_Float_Result, 10); | |
266 exception | |
267 when others => | |
268 Report.Failed("Unexpected exception on GEF.Tanh with large " & | |
269 "positive value"); | |
270 end; | |
271 | |
272 begin | |
273 The_Result := EF.Tanh (FXA5A00.Minus_Large); | |
274 Dont_Optimize_Float(The_Result, 11); | |
275 exception | |
276 when others => | |
277 Report.Failed("Unexpected exception on EF.Tanh with large " & | |
278 "negative value"); | |
279 end; | |
280 | |
281 | |
282 -- Check for prescribed result of Tanh with zero value input parameter. | |
283 | |
284 if GEF.Tanh (0.0) /= 0.0 or | |
285 EF.Tanh (0.0) /= 0.0 | |
286 then | |
287 Report.Failed("Incorrect result from Tanh with zero parameter"); | |
288 end if; | |
289 | |
290 | |
291 -- Check the results of the Tanh function with various input | |
292 -- parameters. | |
293 | |
294 if not (FXA5A00.Result_Within_Range(GEF.Tanh(2.99), 0.995, 0.001) and | |
295 FXA5A00.Result_Within_Range(GEF.Tanh(0.130), 0.129, 0.001) and | |
296 FXA5A00.Result_Within_Range( EF.Tanh(Pi), 0.996, 0.001) and | |
297 FXA5A00.Result_Within_Range( EF.Tanh(-Pi), -0.996, 0.001) and | |
298 FXA5A00.Result_Within_Range(GEF.Tanh(0.60), 0.537, 0.001) and | |
299 FXA5A00.Result_Within_Range( EF.Tanh(1.04), 0.778, 0.001) and | |
300 FXA5A00.Result_Within_Range(GEF.Tanh(1.55), 0.914, 0.001) and | |
301 FXA5A00.Result_Within_Range( EF.Tanh(-2.14), -0.973, 0.001)) | |
302 then | |
303 Report.Failed("Incorrect result from Tanh function with various " & | |
304 "input parameters"); | |
305 end if; | |
306 | |
307 | |
308 | |
309 -- Testing of Arctanh Function, both instantiated and pre-instantiated | |
310 -- version. | |
311 | |
312 -- Check that Constraint_Error is raised by the Arctanh function | |
313 -- when the absolute value of the parameter X is one. | |
314 | |
315 if New_Float'Machine_Overflows = True then | |
316 begin | |
317 New_Float_Result := GEF.Arctanh(X => 1.0); | |
318 Report.Failed("Constraint_Error not raised by Function Arctanh " & | |
319 "when provided a parameter value of 1.0"); | |
320 Dont_Optimize_New_Float(New_Float_Result, 12); | |
321 exception | |
322 when Constraint_Error => null; -- OK, expected exception. | |
323 when others => | |
324 Report.Failed("Unexpected exception raised by Function Arctanh " | |
325 & "when provided a parameter value of 1.0"); | |
326 end; | |
327 end if; | |
328 | |
329 if Float'Machine_Overflows = True then | |
330 begin | |
331 The_Result := EF.Arctanh(-1.0); | |
332 Report.Failed("Constraint_Error not raised by Function Arctanh " & | |
333 "when provided a parameter value of -1.0"); | |
334 Dont_Optimize_Float(The_Result, 13); | |
335 exception | |
336 when Constraint_Error => null; -- OK, expected exception. | |
337 when others => | |
338 Report.Failed("Unexpected exception raised by Function Arctanh " | |
339 & "when provided a parameter value of -1.0"); | |
340 end; | |
341 end if; | |
342 | |
343 -- Check that Function Arctanh raises Argument_Error when the absolute | |
344 -- value of the parameter X exceeds one. | |
345 | |
346 begin | |
347 New_Float_Result := GEF.Arctanh(New_Float(FXA5A00.One_Plus_Delta)); | |
348 Report.Failed("Argument_Error not raised by Function Arctanh " & | |
349 "when provided a parameter value greater than 1.0"); | |
350 Dont_Optimize_New_Float(New_Float_Result, 14); | |
351 exception | |
352 when Argument_Error => null; -- OK, expected exception. | |
353 when others => | |
354 Report.Failed("Unexpected exception raised by Function Arctanh " & | |
355 "when provided a parameter value greater than 1.0"); | |
356 end; | |
357 | |
358 | |
359 begin | |
360 The_Result := EF.Arctanh(FXA5A00.Minus_One_Minus_Delta); | |
361 Report.Failed("Argument_Error not raised by Function Arctanh " & | |
362 "when provided a parameter value less than -1.0"); | |
363 Dont_Optimize_Float(The_Result, 15); | |
364 exception | |
365 when Argument_Error => null; -- OK, expected exception. | |
366 when others => | |
367 Report.Failed("Unexpected exception raised by Function Arctanh " & | |
368 "when provided a parameter value less than -1.0"); | |
369 end; | |
370 | |
371 | |
372 begin | |
373 New_Float_Result := GEF.Arctanh(New_Float(FXA5A00.Large)); | |
374 Report.Failed("Argument_Error not raised by Function Arctanh " & | |
375 "when provided a large positive parameter value"); | |
376 Dont_Optimize_New_Float(New_Float_Result, 16); | |
377 exception | |
378 when Argument_Error => null; -- OK, expected exception. | |
379 when others => | |
380 Report.Failed("Unexpected exception raised by Function Arctanh " & | |
381 "when provided a large positive parameter value"); | |
382 end; | |
383 | |
384 | |
385 begin | |
386 The_Result := EF.Arctanh(FXA5A00.Minus_Large); | |
387 Report.Failed("Argument_Error not raised by Function Arctanh " & | |
388 "when provided a large negative parameter value"); | |
389 Dont_Optimize_Float(The_Result, 17); | |
390 exception | |
391 when Argument_Error => null; -- OK, expected exception. | |
392 when others => | |
393 Report.Failed("Unexpected exception raised by Function Arctanh " & | |
394 "when provided a large negative parameter value"); | |
395 end; | |
396 | |
397 | |
398 -- Prescribed results for Function Arctanh with zero input value. | |
399 | |
400 if GEF.Arctanh(0.0) /= 0.0 or | |
401 EF.Arctanh(0.0) /= 0.0 | |
402 then | |
403 Report.Failed("Incorrect result from Function Arctanh with a " & | |
404 "parameter value of zero"); | |
405 end if; | |
406 | |
407 | |
408 -- Check the results of the Arctanh function with various input | |
409 -- parameters. | |
410 | |
411 if not (Result_Within_Range(GEF.Arctanh(0.15), 0.151, 0.001) and | |
412 Result_Within_Range( EF.Arctanh(0.44), 0.472, 0.001) and | |
413 Result_Within_Range(GEF.Arctanh(0.81), 1.127, 0.001) and | |
414 Result_Within_Range( EF.Arctanh(0.99), 2.647, 0.001)) | |
415 then | |
416 Report.Failed("Incorrect result from Arctanh function with " & | |
417 "various input parameters"); | |
418 end if; | |
419 | |
420 exception | |
421 when others => Report.Failed ("Exception raised in Test_Block"); | |
422 end Test_Block; | |
423 | |
424 Report.Result; | |
425 | |
426 end CXA5A03; |