Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxf/cxf2a02.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 -- CXF2A02.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 multiplying operators for a decimal fixed point type
28 -- return values that are integral multiples of the small of the type.
29 -- Check the case where the operand and result types are the same.
30 --
31 -- Check that if the mathematical result is between multiples of the
32 -- small of the result type, the result is truncated toward zero.
33 --
34 -- TEST DESCRIPTION:
35 -- The test verifies that decimal multiplication and division behave as
36 -- expected for types with various digits, delta, and Machine_Radix
37 -- values.
38 --
39 -- The iteration, operation, and operand counts in the foundation, and
40 -- the operations and operand tables in the test, are given values such
41 -- that, when the operations loop is complete, truncation of inexact
42 -- results should cause the result returned by the operations loop to be
43 -- the same as that used to initialize the loop's cumulator variable (in
44 -- this test, one).
45 --
46 -- TEST FILES:
47 -- This test consists of the following files:
48 --
49 -- FXF2A00.A
50 -- -> CXF2A02.A
51 --
52 -- APPLICABILITY CRITERIA:
53 -- This test is only applicable for a compiler attempting validation
54 -- for the Information Systems Annex.
55 --
56 --
57 -- CHANGE HISTORY:
58 -- 13 Mar 96 SAIC Prerelease version for ACVC 2.1.
59 -- 04 Aug 96 SAIC Updated prologue.
60 --
61 --!
62
63 package CXF2A02_0 is
64
65 ---=---=---=---=---=---=---=---=---=---=---
66
67 type Micro is delta 10.0**(-5) digits 6; -- range -9.99999 ..
68 for Micro'Machine_Radix use 2; -- +9.99999
69
70 function Multiply (Left, Right : Micro) return Micro;
71 function Divide (Left, Right : Micro) return Micro;
72
73
74 type Micro_Optr_Ptr is access function (Left, Right : Micro) return Micro;
75
76 Micro_Mult : Micro_Optr_Ptr := Multiply'Access;
77 Micro_Div : Micro_Optr_Ptr := Divide'Access;
78
79 ---=---=---=---=---=---=---=---=---=---=---
80
81 type Basic is delta 0.01 digits 11; -- range -999,999,999.99 ..
82 for Basic'Machine_Radix use 10; -- +999,999,999.99
83
84 function Multiply (Left, Right : Basic) return Basic;
85 function Divide (Left, Right : Basic) return Basic;
86
87
88 type Basic_Optr_Ptr is access function (Left, Right : Basic) return Basic;
89
90 Basic_Mult : Basic_Optr_Ptr := Multiply'Access;
91 Basic_Div : Basic_Optr_Ptr := Divide'Access;
92
93 ---=---=---=---=---=---=---=---=---=---=---
94
95 type Broad is delta 10.0**(-3) digits 10; -- range -9,999,999.999 ..
96 for Broad'Machine_Radix use 2; -- +9,999,999.999
97
98 function Multiply (Left, Right : Broad) return Broad;
99 function Divide (Left, Right : Broad) return Broad;
100
101
102 type Broad_Optr_Ptr is access function (Left, Right : Broad) return Broad;
103
104 Broad_Mult : Broad_Optr_Ptr := Multiply'Access;
105 Broad_Div : Broad_Optr_Ptr := Divide'Access;
106
107 ---=---=---=---=---=---=---=---=---=---=---
108
109 end CXF2A02_0;
110
111
112 --==================================================================--
113
114
115 package body CXF2A02_0 is
116
117 ---=---=---=---=---=---=---=---=---=---=---
118
119 function Multiply (Left, Right : Micro) return Micro is
120 begin
121 return (Left * Right); -- Decimal fixed multiplication.
122 end Multiply;
123
124 function Divide (Left, Right : Micro) return Micro is
125 begin
126 return (Left / Right); -- Decimal fixed division.
127 end Divide;
128
129 ---=---=---=---=---=---=---=---=---=---=---
130
131 function Multiply (Left, Right : Basic) return Basic is
132 begin
133 return (Left * Right); -- Decimal fixed multiplication.
134 end Multiply;
135
136 function Divide (Left, Right : Basic) return Basic is
137 begin
138 return (Left / Right); -- Decimal fixed division.
139 end Divide;
140
141 ---=---=---=---=---=---=---=---=---=---=---
142
143 function Multiply (Left, Right : Broad) return Broad is
144 begin
145 return (Left * Right); -- Decimal fixed multiplication.
146 end Multiply;
147
148 function Divide (Left, Right : Broad) return Broad is
149 begin
150 return (Left / Right); -- Decimal fixed division.
151 end Divide;
152
153 ---=---=---=---=---=---=---=---=---=---=---
154
155 end CXF2A02_0;
156
157
158 --==================================================================--
159
160
161 with FXF2A00;
162 package CXF2A02_0.CXF2A02_1 is
163
164 ---=---=---=---=---=---=---=---=---=---=---
165
166 type Micro_Ops is array (FXF2A00.Optr_Range) of Micro_Optr_Ptr;
167 type Micro_Opnds is array (FXF2A00.Opnd_Range) of Micro;
168
169 Micro_Mult_Operator_Table : Micro_Ops := ( Micro_Mult, Micro_Mult,
170 Micro_Mult, Micro_Mult,
171 Micro_Mult, Micro_Mult );
172
173 Micro_Div_Operator_Table : Micro_Ops := ( Micro_Div, Micro_Div,
174 Micro_Div, Micro_Div,
175 Micro_Div, Micro_Div );
176
177 Micro_Mult_Operand_Table : Micro_Opnds := ( 2.35119,
178 0.05892,
179 9.58122,
180 0.80613,
181 0.93462 );
182
183 Micro_Div_Operand_Table : Micro_Opnds := ( 0.58739,
184 4.90012,
185 0.08765,
186 0.71577,
187 5.53768 );
188
189 function Test_Micro_Ops is new FXF2A00.Operations_Loop
190 (Decimal_Fixed => Micro,
191 Operator_Ptr => Micro_Optr_Ptr,
192 Operator_Table => Micro_Ops,
193 Operand_Table => Micro_Opnds);
194
195 ---=---=---=---=---=---=---=---=---=---=---
196
197 type Basic_Ops is array (FXF2A00.Optr_Range) of Basic_Optr_Ptr;
198 type Basic_Opnds is array (FXF2A00.Opnd_Range) of Basic;
199
200 Basic_Mult_Operator_Table : Basic_Ops := ( Basic_Mult, Basic_Mult,
201 Basic_Mult, Basic_Mult,
202 Basic_Mult, Basic_Mult );
203
204 Basic_Div_Operator_Table : Basic_Ops := ( Basic_Div, Basic_Div,
205 Basic_Div, Basic_Div,
206 Basic_Div, Basic_Div );
207
208 Basic_Mult_Operand_Table : Basic_Opnds := ( 127.10,
209 0.02,
210 0.87,
211 45.67,
212 0.01 );
213
214 Basic_Div_Operand_Table : Basic_Opnds := ( 0.03,
215 0.08,
216 23.57,
217 0.11,
218 159.11 );
219
220 function Test_Basic_Ops is new FXF2A00.Operations_Loop
221 (Decimal_Fixed => Basic,
222 Operator_Ptr => Basic_Optr_Ptr,
223 Operator_Table => Basic_Ops,
224 Operand_Table => Basic_Opnds);
225
226 ---=---=---=---=---=---=---=---=---=---=---
227
228 type Broad_Ops is array (FXF2A00.Optr_Range) of Broad_Optr_Ptr;
229 type Broad_Opnds is array (FXF2A00.Opnd_Range) of Broad;
230
231 Broad_Mult_Operator_Table : Broad_Ops := ( Broad_Mult, Broad_Mult,
232 Broad_Mult, Broad_Mult,
233 Broad_Mult, Broad_Mult );
234
235 Broad_Div_Operator_Table : Broad_Ops := ( Broad_Div, Broad_Div,
236 Broad_Div, Broad_Div,
237 Broad_Div, Broad_Div );
238
239 Broad_Mult_Operand_Table : Broad_Opnds := ( 589.720,
240 0.106,
241 21.018,
242 0.002,
243 0.381 );
244
245 Broad_Div_Operand_Table : Broad_Opnds := ( 0.008,
246 0.793,
247 9.092,
248 214.300,
249 0.080 );
250
251 function Test_Broad_Ops is new FXF2A00.Operations_Loop
252 (Decimal_Fixed => Broad,
253 Operator_Ptr => Broad_Optr_Ptr,
254 Operator_Table => Broad_Ops,
255 Operand_Table => Broad_Opnds);
256
257 ---=---=---=---=---=---=---=---=---=---=---
258
259 end CXF2A02_0.CXF2A02_1;
260
261
262 --==================================================================--
263
264
265 with CXF2A02_0.CXF2A02_1;
266
267 with Report;
268 procedure CXF2A02 is
269 package Data renames CXF2A02_0.CXF2A02_1;
270
271 use type CXF2A02_0.Micro;
272 use type CXF2A02_0.Basic;
273 use type CXF2A02_0.Broad;
274
275 Micro_Expected : constant CXF2A02_0.Micro := 1.0;
276 Basic_Expected : constant CXF2A02_0.Basic := 1.0;
277 Broad_Expected : constant CXF2A02_0.Broad := 1.0;
278
279 Micro_Actual : CXF2A02_0.Micro;
280 Basic_Actual : CXF2A02_0.Basic;
281 Broad_Actual : CXF2A02_0.Broad;
282 begin
283
284 Report.Test ("CXF2A02", "Check decimal multiplication and division, " &
285 "where the operand and result types are the same");
286
287 ---=---=---=---=---=---=---=---=---=---=---
288
289 Micro_Actual := 0.0;
290 Micro_Actual := Data.Test_Micro_Ops (1.0,
291 Data.Micro_Mult_Operator_Table,
292 Data.Micro_Mult_Operand_Table);
293
294 if Micro_Actual /= Micro_Expected then
295 Report.Failed ("Wrong result for type Micro multiplication");
296 end if;
297
298
299 Micro_Actual := 0.0;
300 Micro_Actual := Data.Test_Micro_Ops (1.0,
301 Data.Micro_Div_Operator_Table,
302 Data.Micro_Div_Operand_Table);
303
304 if Micro_Actual /= Micro_Expected then
305 Report.Failed ("Wrong result for type Micro division");
306 end if;
307
308 ---=---=---=---=---=---=---=---=---=---=---
309
310 Basic_Actual := 0.0;
311 Basic_Actual := Data.Test_Basic_Ops (1.0,
312 Data.Basic_Mult_Operator_Table,
313 Data.Basic_Mult_Operand_Table);
314
315 if Basic_Actual /= Basic_Expected then
316 Report.Failed ("Wrong result for type Basic multiplication");
317 end if;
318
319
320 Basic_Actual := 0.0;
321 Basic_Actual := Data.Test_Basic_Ops (1.0,
322 Data.Basic_Div_Operator_Table,
323 Data.Basic_Div_Operand_Table);
324
325 if Basic_Actual /= Basic_Expected then
326 Report.Failed ("Wrong result for type Basic division");
327 end if;
328
329 ---=---=---=---=---=---=---=---=---=---=---
330
331 Broad_Actual := 0.0;
332 Broad_Actual := Data.Test_Broad_Ops (1.0,
333 Data.Broad_Mult_Operator_Table,
334 Data.Broad_Mult_Operand_Table);
335
336 if Broad_Actual /= Broad_Expected then
337 Report.Failed ("Wrong result for type Broad multiplication");
338 end if;
339
340
341 Broad_Actual := 0.0;
342 Broad_Actual := Data.Test_Broad_Ops (1.0,
343 Data.Broad_Div_Operator_Table,
344 Data.Broad_Div_Operand_Table);
345
346 if Broad_Actual /= Broad_Expected then
347 Report.Failed ("Wrong result for type Broad division");
348 end if;
349
350 ---=---=---=---=---=---=---=---=---=---=---
351
352 Report.Result;
353
354 end CXF2A02;