Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxg/cxg1001.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 -- CXG1001.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 subprograms defined in the package
28 -- Ada.Numerics.Generic_Complex_Types provide correct results.
29 -- Specifically, check the functions Re, Im (both versions), procedures
30 -- Set_Re, Set_Im (both versions), functions Compose_From_Cartesian (all
31 -- versions), Compose_From_Polar, Modulus, Argument, and "abs".
32 --
33 -- TEST DESCRIPTION:
34 -- The generic package Generic_Complex_Types
35 -- is instantiated with a real type (new Float), and the results
36 -- produced by the specified subprograms are verified.
37 --
38 -- APPLICABILITY CRITERIA:
39 -- This test applies only to implementations supporting the
40 -- Numerics Annex.
41 --
42 --
43 -- CHANGE HISTORY:
44 -- 06 Dec 94 SAIC ACVC 2.0
45 -- 15 Nov 95 SAIC Corrected visibility problems for ACVC 2.0.1.
46 -- Modified subtest for Compose_From_Polar.
47 -- 29 Sep 96 SAIC Incorporated reviewer comments.
48 --
49 --!
50
51 with Ada.Numerics.Generic_Complex_Types;
52 with Report;
53
54 procedure CXG1001 is
55
56 begin
57
58 Report.Test ("CXG1001", "Check that the subprograms defined in " &
59 "the package Ada.Numerics.Generic_Complex_Types " &
60 "provide correct results");
61
62 Test_Block:
63 declare
64
65 type Real_Type is new Float;
66
67 package Complex_Pack is new
68 Ada.Numerics.Generic_Complex_Types(Real_Type);
69
70 use type Complex_Pack.Complex;
71
72 -- Declare a zero valued complex number.
73 Complex_Zero : constant Complex_Pack.Complex := (0.0, 0.0);
74
75 TC_Complex : Complex_Pack.Complex := Complex_Zero;
76 TC_Imaginary : Complex_Pack.Imaginary;
77
78 begin
79
80 -- Check that the procedures Set_Re and Set_Im (both versions) provide
81 -- correct results.
82
83 declare
84 TC_Complex_Real_Field : Complex_Pack.Complex := (5.0, 0.0);
85 TC_Complex_Both_Fields : Complex_Pack.Complex := (5.0, 7.0);
86 begin
87
88 Complex_Pack.Set_Re(X => TC_Complex, Re => 5.0);
89
90 if TC_Complex /= TC_Complex_Real_Field then
91 Report.Failed("Incorrect results from Procedure Set_Re");
92 end if;
93
94 Complex_Pack.Set_Im(X => TC_Complex, Im => 7.0);
95
96 if TC_Complex.Re /= 5.0 or
97 TC_Complex.Im /= 7.0 or
98 TC_Complex /= TC_Complex_Both_Fields
99 then
100 Report.Failed("Incorrect results from Procedure Set_Im " &
101 "with Complex argument");
102 end if;
103
104 Complex_Pack.Set_Im(X => TC_Imaginary, Im => 3.0);
105
106
107 if Complex_Pack.Im(TC_Imaginary) /= 3.0 then
108 Report.Failed("Incorrect results returned following the use " &
109 "of Procedure Set_Im with Imaginary argument");
110 end if;
111
112 end;
113
114
115 -- Check that the functions Re and Im (both versions) provide
116 -- correct results.
117
118 declare
119 TC_Complex_1 : Complex_Pack.Complex := (1.0, 0.0);
120 TC_Complex_2 : Complex_Pack.Complex := (0.0, 2.0);
121 TC_Complex_3 : Complex_Pack.Complex := (4.0, 3.0);
122 begin
123
124 -- Function Re.
125
126 if Complex_Pack.Re(X => TC_Complex_1) /= 1.0 or
127 Complex_Pack.Re(X => TC_Complex_2) /= 0.0 or
128 Complex_Pack.Re(X => TC_Complex_3) /= 4.0
129 then
130 Report.Failed("Incorrect results from Function Re");
131 end if;
132
133 -- Function Im; version with Complex argument.
134
135 if Complex_Pack.Im(X => TC_Complex_1) /= 0.0 or
136 Complex_Pack.Im(X => TC_Complex_2) /= 2.0 or
137 Complex_Pack.Im(X => TC_Complex_3) /= 3.0
138 then
139 Report.Failed("Incorrect results from Function Im " &
140 "with Complex argument");
141 end if;
142
143
144 -- Function Im; version with Imaginary argument.
145
146 if Complex_Pack.Im(Complex_Pack.i) /= 1.0 or
147 Complex_Pack.Im(Complex_Pack.j) /= 1.0
148 then
149 Report.Failed("Incorrect results from use of Function Im " &
150 "when used with an Imaginary argument");
151 end if;
152
153 end;
154
155
156 -- Verify the results of the three versions of Function
157 -- Compose_From_Cartesian
158
159 declare
160
161 Zero : constant Real_Type := 0.0;
162 Six : constant Real_Type := 6.0;
163
164 TC_Complex_1 : Complex_Pack.Complex := (3.0, 8.0);
165 TC_Complex_2 : Complex_Pack.Complex := (Six, Zero);
166 TC_Complex_3 : Complex_Pack.Complex := (Zero, 1.0);
167
168 begin
169
170 TC_Complex := Complex_Pack.Compose_From_Cartesian(3.0, 8.0);
171
172 if TC_Complex /= TC_Complex_1 then
173 Report.Failed("Incorrect results from Function " &
174 "Compose_From_Cartesian - 1");
175 end if;
176
177 -- If only one component is given, the other component is
178 -- implicitly zero (Both components are set by the following two
179 -- function calls).
180
181 TC_Complex := Complex_Pack.Compose_From_Cartesian(Re => 6.0);
182
183 if TC_Complex /= TC_Complex_2 then
184 Report.Failed("Incorrect results from Function " &
185 "Compose_From_Cartesian - 2");
186 end if;
187
188 TC_Complex :=
189 Complex_Pack.Compose_From_Cartesian(Im => Complex_Pack.i);
190
191 if TC_Complex /= TC_Complex_3 then
192 Report.Failed("Incorrect results from Function " &
193 "Compose_From_Cartesian - 3");
194 end if;
195
196 end;
197
198
199 -- Verify the results of Function Compose_From_Polar, Modulus, "abs",
200 -- and Argument.
201
202 declare
203
204 use Complex_Pack;
205
206 TC_Modulus,
207 TC_Argument : Real_Type := 0.0;
208
209
210 Angle_0 : constant Real_Type := 0.0;
211 Angle_90 : constant Real_Type := 90.0;
212 Angle_180 : constant Real_Type := 180.0;
213 Angle_270 : constant Real_Type := 270.0;
214 Angle_360 : constant Real_Type := 360.0;
215
216 begin
217
218 -- Verify the result of Function Compose_From_Polar.
219 -- When the value of the parameter Modulus is zero, the
220 -- Compose_From_Polar function yields a result of zero.
221
222 if Compose_From_Polar(0.0, 30.0, 360.0) /= Complex_Zero
223 then
224 Report.Failed("Incorrect result from Function " &
225 "Compose_From_Polar - 1");
226 end if;
227
228 -- When the value of the parameter Argument is equal to a multiple
229 -- of the quarter cycle, the result of the Compose_From_Polar
230 -- function with specified cycle lies on one of the axes.
231
232 if Compose_From_Polar( 5.0, Angle_0, Angle_360) /= (5.0, 0.0) or
233 Compose_From_Polar( 5.0, Angle_90, Angle_360) /= (0.0, 5.0) or
234 Compose_From_Polar(-5.0, Angle_180, Angle_360) /= (5.0, 0.0) or
235 Compose_From_Polar(-5.0, Angle_270, Angle_360) /= (0.0, 5.0) or
236 Compose_From_Polar(-5.0, Angle_90, Angle_360) /= (0.0, -5.0) or
237 Compose_From_Polar( 5.0, Angle_270, Angle_360) /= (0.0, -5.0)
238 then
239 Report.Failed("Incorrect result from Function " &
240 "Compose_From_Polar - 2");
241 end if;
242
243 -- When the parameter to Function Argument represents a point on
244 -- the non-negative real axis, the function yields a zero result.
245
246 if Argument(Complex_Zero, Angle_360) /= 0.0 then
247 Report.Failed("Incorrect result from Function Argument");
248 end if;
249
250 -- Function Modulus
251
252 if Modulus(Complex_Zero) /= 0.0 or
253 Modulus(Compose_From_Polar( 5.0, Angle_90, Angle_360)) /= 5.0 or
254 Modulus(Compose_From_Polar(-5.0, Angle_180, Angle_360)) /= 5.0
255 then
256 Report.Failed("Incorrect results from Function Modulus");
257 end if;
258
259 -- Function "abs", a rename of Function Modulus.
260
261 if "abs"(Complex_Zero) /= 0.0 or
262 "abs"(Compose_From_Polar( 5.0, Angle_90, Angle_360)) /= 5.0 or
263 "abs"(Compose_From_Polar(-5.0, Angle_180, Angle_360)) /= 5.0
264 then
265 Report.Failed("Incorrect results from Function abs");
266 end if;
267
268 end;
269
270 exception
271 when others => Report.Failed ("Exception raised in Test_Block");
272 end Test_Block;
273
274 Report.Result;
275
276 end CXG1001;