Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxg/cxg1004.a @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 -- CXG1004.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 specified exceptions are raised by the subprograms
28 -- defined in package Ada.Numerics.Generic_Complex_Elementary_Functions
29 -- given the prescribed input parameter values.
30 --
31 -- TEST DESCRIPTION:
32 -- This test checks that specific subprograms defined in the
33 -- package Ada.Numerics.Generic_Complex_Elementary_Functions raise the
34 -- exceptions Argument_Error and Constraint_Error when their input
35 -- parameter value are those specified as causing each exception.
36 -- In the case of Constraint_Error, the exception will be raised in
37 -- each test case, provided that the value of the attribute
38 -- 'Machine_Overflows (for the actual type of package
39 -- Generic_Complex_Type) is True.
40 --
41 -- APPLICABILITY CRITERIA:
42 -- This test only applies to implementations supporting the
43 -- numerics annex.
44 --
45 --
46 -- CHANGE HISTORY:
47 -- 06 Dec 94 SAIC ACVC 2.0
48 -- 16 Nov 95 SAIC Corrected visibility problems for ACVC 2.0.1.
49 -- 29 Sep 96 SAIC Incorporated reviewer comments.
50 -- 02 Jun 98 EDS Replace "_i" with "_One".
51 --!
52
53 with Ada.Numerics.Generic_Complex_Types;
54 with Ada.Numerics.Generic_Complex_Elementary_Functions;
55 with Report;
56
57 procedure CXG1004 is
58 begin
59
60 Report.Test ("CXG1004", "Check that the specified exceptions are " &
61 "raised by the subprograms defined in package " &
62 "Ada.Numerics.Generic_Complex_Elementary_" &
63 "Functions given the prescribed input " &
64 "parameter values");
65
66 Test_Block:
67 declare
68
69 type Real_Type is new Float;
70
71 TC_Overflows : Boolean := Real_Type'Machine_Overflows;
72
73 package Complex_Pack is
74 new Ada.Numerics.Generic_Complex_Types(Real_Type);
75
76 package CEF is
77 new Ada.Numerics.Generic_Complex_Elementary_Functions(Complex_Pack);
78
79 use Ada.Numerics, Complex_Pack, CEF;
80
81 Complex_Zero : constant Complex := Compose_From_Cartesian(0.0, 0.0);
82 Plus_One : constant Complex := Compose_From_Cartesian(1.0, 0.0);
83 Minus_One : constant Complex := Compose_From_Cartesian(-1.0, 0.0);
84 Plus_i : constant Complex := Compose_From_Cartesian(i);
85 Minus_i : constant Complex := Compose_From_Cartesian(-i);
86
87 Complex_Negative_Real : constant Complex :=
88 Compose_From_Cartesian(-4.0, 2.0);
89 Complex_Negative_Imaginary : constant Complex :=
90 Compose_From_Cartesian(3.0, -5.0);
91
92 TC_Complex : Complex;
93
94
95 -- This procedure is used in "Exception Raising" calls below in an
96 -- attempt to avoid elimination of the subtest through optimization.
97
98 procedure No_Optimize (The_Complex_Number : Complex) is
99 begin
100 Report.Comment("No Optimize: Should never be printed " &
101 Integer'Image(Integer(The_Complex_Number.Im)));
102 end No_Optimize;
103
104
105 begin
106
107 -- Check that the exception Numerics.Argument_Error is raised by the
108 -- exponentiation operator when the value of the left operand is zero,
109 -- and the real component of the exponent (or the exponent itself) is
110 -- zero.
111
112 begin
113 TC_Complex := "**"(Left => Complex_Zero, Right => Complex_Zero);
114 Report.Failed("Argument_Error not raised by exponentiation " &
115 "operator, left operand = complex zero, right " &
116 "operand = complex zero");
117 No_Optimize(TC_Complex);
118 exception
119 when Argument_Error => null; -- OK, expected exception.
120 when others =>
121 Report.Failed("Incorrect exception raised by exponentiation " &
122 "operator, left operand = complex zero, right " &
123 "operand = complex zero");
124 end;
125
126 begin
127 TC_Complex := Complex_Zero**0.0;
128 Report.Failed("Argument_Error not raised by exponentiation " &
129 "operator, left operand = complex zero, right " &
130 "operand = real zero");
131 No_Optimize(TC_Complex);
132 exception
133 when Argument_Error => null; -- OK, expected exception.
134 when others =>
135 Report.Failed("Incorrect exception raised by exponentiation " &
136 "operator, left operand = complex zero, right " &
137 "operand = real zero");
138 end;
139
140
141 begin
142 TC_Complex := "**"(Left => 0.0, Right => Complex_Zero);
143 Report.Failed("Argument_Error not raised by exponentiation " &
144 "operator, left operand = real zero, right " &
145 "operand = complex zero");
146 No_Optimize(TC_Complex);
147 exception
148 when Argument_Error => null; -- OK, expected exception.
149 when others =>
150 Report.Failed("Incorrect exception raised by exponentiation " &
151 "operator, left operand = real zero, right " &
152 "operand = complex zero");
153 end;
154
155
156 -- Check that the exception Constraint_Error is raised under the
157 -- specified circumstances, provided that
158 -- Complex_Types.Real'Machine_Overflows is True.
159
160 if TC_Overflows then
161
162 -- Raised by Log, when the value of the parameter X is zero.
163 begin
164 TC_Complex := Log (X => Complex_Zero);
165 Report.Failed("Constraint_Error not raised when Function " &
166 "Log given parameter value of complex zero");
167 No_Optimize(TC_Complex);
168 exception
169 when Constraint_Error => null; -- OK, expected exception.
170 when others =>
171 Report.Failed("Incorrect exception raised when Function " &
172 "Log given parameter value of complex zero");
173 end;
174
175 -- Raised by Cot, when the value of the parameter X is zero.
176 begin
177 TC_Complex := Cot (X => Complex_Zero);
178 Report.Failed("Constraint_Error not raised when Function " &
179 "Cot given parameter value of complex zero");
180 No_Optimize(TC_Complex);
181 exception
182 when Constraint_Error => null; -- OK, expected exception.
183 when others =>
184 Report.Failed("Incorrect exception raised when Function " &
185 "Cot given parameter value of complex zero");
186 end;
187
188 -- Raised by Coth, when the value of the parameter X is zero.
189 begin
190 TC_Complex := Coth (Complex_Zero);
191 Report.Failed("Constraint_Error not raised when Function " &
192 "Coth given parameter value of complex zero");
193 No_Optimize(TC_Complex);
194 exception
195 when Constraint_Error => null; -- OK, expected exception.
196 when others =>
197 Report.Failed("Incorrect exception raised when Function " &
198 "Coth given parameter value of complex zero");
199 end;
200
201 -- Raised by the exponentiation operator, when the value of the
202 -- left operand is zero and the real component of the exponent
203 -- is negative.
204 begin
205 TC_Complex := Complex_Zero**Complex_Negative_Real;
206 Report.Failed("Constraint_Error not raised when the " &
207 "exponentiation operator left operand is " &
208 "complex zero, and the real component of " &
209 "the exponent is negative");
210 No_Optimize(TC_Complex);
211 exception
212 when Constraint_Error => null; -- OK, expected exception.
213 when others =>
214 Report.Failed("Incorrect exception raised when the " &
215 "exponentiation operator left operand is " &
216 "complex zero, and the real component of " &
217 "the exponent is negative");
218 end;
219
220 -- Raised by the exponentiation operator, when the value of the
221 -- left operand is zero and the exponent itself (when it is of
222 -- type real) is negative.
223 declare
224 Negative_Exponent : constant Real_Type := -4.0;
225 begin
226 TC_Complex := Complex_Zero**Negative_Exponent;
227 Report.Failed("Constraint_Error not raised when the " &
228 "exponentiation operator left operand is " &
229 "complex zero, and the real exponent is " &
230 "negative");
231 No_Optimize(TC_Complex);
232 exception
233 when Constraint_Error => null; -- OK, expected exception.
234 when others =>
235 Report.Failed("Incorrect exception raised when the " &
236 "exponentiation operator left operand is " &
237 "complex zero, and the real exponent is " &
238 "negative");
239 end;
240
241 -- Raised by Arctan, when the value of the parameter is +i.
242 begin
243 TC_Complex := Arctan (Plus_i);
244 Report.Failed("Constraint_Error not raised when Function " &
245 "Arctan is given parameter value +i");
246 No_Optimize(TC_Complex);
247 exception
248 when Constraint_Error => null; -- OK, expected exception.
249 when others =>
250 Report.Failed("Incorrect exception raised when Function " &
251 "Arctan is given parameter value +i");
252 end;
253
254 -- Raised by Arctan, when the value of the parameter is -i.
255 begin
256 TC_Complex := Arctan (Minus_i);
257 Report.Failed("Constraint_Error not raised when Function " &
258 "Arctan is given parameter value -i");
259 No_Optimize(TC_Complex);
260 exception
261 when Constraint_Error => null; -- OK, expected exception.
262 when others =>
263 Report.Failed("Incorrect exception raised when Function " &
264 "Arctan is given parameter value -i");
265 end;
266
267 -- Raised by Arccot, when the value of the parameter is +i.
268 begin
269 TC_Complex := Arccot (Plus_i);
270 Report.Failed("Constraint_Error not raised when Function " &
271 "Arccot is given parameter value +i");
272 No_Optimize(TC_Complex);
273 exception
274 when Constraint_Error => null; -- OK, expected exception.
275 when others =>
276 Report.Failed("Incorrect exception raised when Function " &
277 "Arccot is given parameter value +i");
278 end;
279
280 -- Raised by Arccot, when the value of the parameter is -i.
281 begin
282 TC_Complex := Arccot (Minus_i);
283 Report.Failed("Constraint_Error not raised when Function " &
284 "Arccot is given parameter value -i");
285 No_Optimize(TC_Complex);
286 exception
287 when Constraint_Error => null; -- OK, expected exception.
288 when others =>
289 Report.Failed("Incorrect exception raised when Function " &
290 "Arccot is given parameter value -i");
291 end;
292
293 -- Raised by Arctanh, when the value of the parameter is +1.
294 begin
295 TC_Complex := Arctanh (Plus_One);
296 Report.Failed("Constraint_Error not raised when Function " &
297 "Arctanh is given parameter value +1");
298 No_Optimize(TC_Complex);
299 exception
300 when Constraint_Error => null; -- OK, expected exception.
301 when others =>
302 Report.Failed("Incorrect exception raised when Function " &
303 "Arctanh is given parameter value +1");
304 end;
305
306 -- Raised by Arctanh, when the value of the parameter is -1.
307 begin
308 TC_Complex := Arctanh (Minus_One);
309 Report.Failed("Constraint_Error not raised when Function " &
310 "Arctanh is given parameter value -1");
311 No_Optimize(TC_Complex);
312 exception
313 when Constraint_Error => null; -- OK, expected exception.
314 when others =>
315 Report.Failed("Incorrect exception raised when Function " &
316 "Arctanh is given parameter value -1");
317 end;
318
319 -- Raised by Arccoth, when the value of the parameter is +1.
320 begin
321 TC_Complex := Arccoth (Plus_One);
322 Report.Failed("Constraint_Error not raised when Function " &
323 "Arccoth is given parameter value +1");
324 No_Optimize(TC_Complex);
325 exception
326 when Constraint_Error => null; -- OK, expected exception.
327 when others =>
328 Report.Failed("Incorrect exception raised when Function " &
329 "Arccoth is given parameter value +1");
330 end;
331
332 -- Raised by Arccoth, when the value of the parameter is -1.
333 begin
334 TC_Complex := Arccoth (Minus_One);
335 Report.Failed("Constraint_Error not raised when Function " &
336 "Arccoth is given parameter value -1");
337 No_Optimize(TC_Complex);
338 exception
339 when Constraint_Error => null; -- OK, expected exception.
340 when others =>
341 Report.Failed("Incorrect exception raised when Function " &
342 "Arccoth is given parameter value -1");
343 end;
344
345 else
346 Report.Comment
347 ("Attribute Complex_Pack.Real'Machine_Overflows is False; " &
348 "evaluation of the complex elementary functions under " &
349 "specified circumstances was not performed");
350 end if;
351
352
353 exception
354 when others =>
355 Report.Failed ("Unexpected exception raised in Test_Block");
356 end Test_Block;
357
358 Report.Result;
359
360 end CXG1004;