|
111
|
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;
|
