111
|
1 -- CXF2005.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 one operand is of the predefined type Integer.
|
|
30 --
|
|
31 -- TEST DESCRIPTION:
|
|
32 -- Two decimal fixed point types A and B are declared, one with a
|
|
33 -- Machine_Radix value of 2, and one with a value of 10. A variable of
|
|
34 -- each type is multiplied repeatedly by a series of different Integer
|
|
35 -- values. A cumulative result is kept and compared to an expected
|
|
36 -- final result. Similar checks are performed for division.
|
|
37 --
|
|
38 -- APPLICABILITY CRITERIA:
|
|
39 -- This test is only applicable for a compiler attempting validation
|
|
40 -- for the Information Systems Annex.
|
|
41 --
|
|
42 --
|
|
43 -- CHANGE HISTORY:
|
|
44 -- 28 Mar 96 SAIC Prerelease version for ACVC 2.1.
|
|
45 --
|
|
46 --!
|
|
47
|
|
48 generic
|
|
49 type Decimal_Fixed is delta <> digits <>;
|
|
50 package CXF2005_0 is
|
|
51
|
|
52 function Multiply (Operand : Decimal_Fixed;
|
|
53 Interval : Integer) return Decimal_Fixed;
|
|
54
|
|
55 function Divide (Operand : Decimal_Fixed;
|
|
56 Interval : Integer) return Decimal_Fixed;
|
|
57
|
|
58 end CXF2005_0;
|
|
59
|
|
60
|
|
61 --==================================================================--
|
|
62
|
|
63
|
|
64 package body CXF2005_0 is
|
|
65
|
|
66 function Multiply (Operand : Decimal_Fixed;
|
|
67 Interval : Integer) return Decimal_Fixed is
|
|
68 begin
|
|
69 return Operand * Interval; -- Fixed-Integer multiplication.
|
|
70 end Multiply;
|
|
71
|
|
72
|
|
73 function Divide (Operand : Decimal_Fixed;
|
|
74 Interval : Integer) return Decimal_Fixed is
|
|
75 begin
|
|
76 return Operand / Interval; -- Fixed-Integer division.
|
|
77 end Divide;
|
|
78
|
|
79 end CXF2005_0;
|
|
80
|
|
81
|
|
82 --==================================================================--
|
|
83
|
|
84
|
|
85 package CXF2005_1 is
|
|
86
|
|
87 ---=---=---=---=---=---=---=---=---=---=---
|
|
88
|
|
89 type Interest_Rate is delta 0.001 range 0.0 .. 1_000.0;
|
|
90 for Interest_Rate'Small use 0.001; -- Power of 10.
|
|
91
|
|
92 ---=---=---=---=---=---=---=---=---=---=---
|
|
93
|
|
94 type Money_Radix2 is delta 0.01 digits 11; -- range -999,999,999.99 ..
|
|
95 for Money_Radix2'Machine_Radix use 2; -- +999,999,999.99
|
|
96
|
|
97 function Factor (Rate : Interest_Rate;
|
|
98 Interval : Integer) return Money_Radix2;
|
|
99
|
|
100 ---=---=---=---=---=---=---=---=---=---=---
|
|
101
|
|
102 type Money_Radix10 is delta 0.01 digits 11; -- range -999,999,999.99 ..
|
|
103 for Money_Radix10'Machine_Radix use 10; -- +999,999,999.99
|
|
104
|
|
105 function Factor (Rate : Interest_Rate;
|
|
106 Interval : Integer) return Money_Radix10;
|
|
107
|
|
108 ---=---=---=---=---=---=---=---=---=---=---
|
|
109
|
|
110 end CXF2005_1;
|
|
111
|
|
112
|
|
113 --==================================================================--
|
|
114
|
|
115
|
|
116 package body CXF2005_1 is
|
|
117
|
|
118 ---=---=---=---=---=---=---=---=---=---=---
|
|
119
|
|
120 function Factor (Rate : Interest_Rate;
|
|
121 Interval : Integer) return Money_Radix2 is
|
|
122 begin
|
|
123 return Money_Radix2( Rate / Interval );
|
|
124 end Factor;
|
|
125
|
|
126 ---=---=---=---=---=---=---=---=---=---=---
|
|
127
|
|
128 function Factor (Rate : Interest_Rate;
|
|
129 Interval : Integer) return Money_Radix10 is
|
|
130 begin
|
|
131 return Money_Radix10( Rate / Interval );
|
|
132 end Factor;
|
|
133
|
|
134 ---=---=---=---=---=---=---=---=---=---=---
|
|
135
|
|
136 end CXF2005_1;
|
|
137
|
|
138
|
|
139 --==================================================================--
|
|
140
|
|
141
|
|
142 with CXF2005_0;
|
|
143 with CXF2005_1;
|
|
144
|
|
145 with Report;
|
|
146 procedure CXF2005 is
|
|
147
|
|
148 Loop_Count : constant := 25_000;
|
|
149 type Loop_Range is range 1 .. Loop_Count;
|
|
150
|
|
151 begin
|
|
152
|
|
153 Report.Test ("CXF2005", "Check decimal multiplication and division, " &
|
|
154 "where one operand type is Integer");
|
|
155
|
|
156
|
|
157 ---=---=---=---=---=---=---=---=---=---=---
|
|
158
|
|
159
|
|
160 RADIX_2_SUBTESTS:
|
|
161 declare
|
|
162 package Radix_2 is new CXF2005_0 (CXF2005_1.Money_Radix2);
|
|
163 use type CXF2005_1.Money_Radix2;
|
|
164 begin
|
|
165
|
|
166 RADIX_2_MULTIPLICATION:
|
|
167 declare
|
|
168 Rate : constant CXF2005_1.Interest_Rate := 0.127;
|
|
169 Period : constant Integer := 12;
|
|
170
|
|
171 Expected : constant CXF2005_1.Money_Radix2 := 2_624.88;
|
|
172 Balance : CXF2005_1.Money_Radix2 := 1_000.00;
|
|
173
|
|
174 Operand : CXF2005_1.Money_Radix2;
|
|
175 Increment : CXF2005_1.Money_Radix2;
|
|
176 Interval : Integer;
|
|
177 begin
|
|
178
|
|
179 for I in Loop_Range loop
|
|
180 Interval := (Integer(I) mod Period) + 1; -- Range from 1 to 12.
|
|
181 Operand := CXF2005_1.Factor (Rate, Period);
|
|
182 Increment := Radix_2.Multiply (Operand, Interval);
|
|
183 Balance := Balance + Increment;
|
|
184 end loop;
|
|
185
|
|
186 if Balance /= Expected then
|
|
187 Report.Failed ("Error: Radix 2 multiply");
|
|
188 end if;
|
|
189
|
|
190 end RADIX_2_MULTIPLICATION;
|
|
191
|
|
192
|
|
193
|
|
194 RADIX_2_DIVISION:
|
|
195 declare
|
|
196 Rate : constant CXF2005_1.Interest_Rate := 0.377;
|
|
197 Period : constant Integer := 12;
|
|
198
|
|
199 Expected : constant CXF2005_1.Money_Radix2 := 36_215.58;
|
|
200 Balance : CXF2005_1.Money_Radix2 := 456_985.01;
|
|
201
|
|
202 Operand : CXF2005_1.Money_Radix2;
|
|
203 Increment : CXF2005_1.Money_Radix2;
|
|
204 Interval : Integer;
|
|
205 begin
|
|
206
|
|
207 for I in Loop_Range loop
|
|
208 Interval := (Integer(I+1000) mod (200*Period)) + 1; -- 1 .. 2400.
|
|
209 Operand := CXF2005_1.Factor (Rate, Period);
|
|
210 Increment := Radix_2.Divide (Balance, Interval);
|
|
211 Balance := Balance - (Operand * Increment);
|
|
212 end loop;
|
|
213
|
|
214 if Balance /= Expected then
|
|
215 Report.Failed ("Error: Radix 2 divide");
|
|
216 end if;
|
|
217
|
|
218 end RADIX_2_DIVISION;
|
|
219
|
|
220 end RADIX_2_SUBTESTS;
|
|
221
|
|
222
|
|
223 ---=---=---=---=---=---=---=---=---=---=---
|
|
224
|
|
225
|
|
226 RADIX_10_SUBTESTS:
|
|
227 declare
|
|
228 package Radix_10 is new CXF2005_0 (CXF2005_1.Money_Radix10);
|
|
229 use type CXF2005_1.Money_Radix10;
|
|
230 begin
|
|
231
|
|
232 RADIX_10_MULTIPLICATION:
|
|
233 declare
|
|
234 Rate : constant CXF2005_1.Interest_Rate := 0.721;
|
|
235 Period : constant Integer := 12;
|
|
236
|
|
237 Expected : constant CXF2005_1.Money_Radix10 := 9_875.62;
|
|
238 Balance : CXF2005_1.Money_Radix10 := 126.34;
|
|
239
|
|
240 Operand : CXF2005_1.Money_Radix10;
|
|
241 Increment : CXF2005_1.Money_Radix10;
|
|
242 Interval : Integer;
|
|
243 begin
|
|
244
|
|
245 for I in Loop_Range loop
|
|
246 Interval := (Integer(I) mod Period) + 1; -- Range from 1 to 12.
|
|
247 Operand := CXF2005_1.Factor (Rate, Period);
|
|
248 Increment := Radix_10.Multiply (Operand, Interval);
|
|
249 Balance := Balance + Increment;
|
|
250 end loop;
|
|
251
|
|
252 if Balance /= Expected then
|
|
253 Report.Failed ("Error: Radix 10 multiply");
|
|
254 end if;
|
|
255
|
|
256 end RADIX_10_MULTIPLICATION;
|
|
257
|
|
258
|
|
259 RADIX_10_DIVISION:
|
|
260 declare
|
|
261 Rate : constant CXF2005_1.Interest_Rate := 0.547;
|
|
262 Period : constant Integer := 12;
|
|
263
|
|
264 Expected : constant CXF2005_1.Money_Radix10 := 26_116.37;
|
|
265 Balance : CXF2005_1.Money_Radix10 := 770_082.46;
|
|
266
|
|
267 Operand : CXF2005_1.Money_Radix10;
|
|
268 Increment : CXF2005_1.Money_Radix10;
|
|
269 Interval : Integer;
|
|
270 begin
|
|
271
|
|
272 for I in Loop_Range loop
|
|
273 Interval := (Integer(I+1000) mod (200*Period)) + 1; -- 1 .. 2400.
|
|
274 Operand := CXF2005_1.Factor (Rate, Period);
|
|
275 Increment := Radix_10.Divide (Balance, Interval);
|
|
276 Balance := Balance - (Operand * Increment);
|
|
277 end loop;
|
|
278
|
|
279 if Balance /= Expected then
|
|
280 Report.Failed ("Error: Radix 10 divide");
|
|
281 end if;
|
|
282
|
|
283 end RADIX_10_DIVISION;
|
|
284
|
|
285 end RADIX_10_SUBTESTS;
|
|
286
|
|
287
|
|
288 ---=---=---=---=---=---=---=---=---=---=---
|
|
289
|
|
290
|
|
291 Report.Result;
|
|
292
|
|
293 end CXF2005;
|