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