3 -- Grant of Unlimited Rights
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
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.
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.
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 -- Check that if the attribute 'Round is applied to the mathematical
34 -- result, however, the result is rounded to the nearest multiple of
35 -- the small (away from zero if the result is midway between two
36 -- multiples of the small).
39 -- Two decimal fixed point types are declared, one with a Machine_Radix
40 -- value of 2, and one with a value of 10. For each type, checks are
41 -- performed on the following operations, where the operand and result
42 -- types are the same:
45 -- - Multiplication, where the attribute 'Round is applied to the
48 -- - Division, where the attribute 'Round is applied to the result.
50 -- Each operation is performed within a loop, where one operand is
51 -- always the same variable. After the loop completes, the cumulative
52 -- total contained in this variable is compared with the expected
55 -- APPLICABILITY CRITERIA:
56 -- This test is only applicable for a compiler attempting validation
57 -- for the Information Systems Annex.
61 -- 27 Mar 96 SAIC Prerelease version for ACVC 2.1.
66 type Decimal_Fixed
is delta <> digits <>;
69 procedure Multiply_And_Truncate
(Balance
: in out Decimal_Fixed
;
70 Factor
: in Decimal_Fixed
);
72 procedure Divide_And_Truncate
(Balance
: in out Decimal_Fixed
;
73 Divisor
: in Decimal_Fixed
);
75 procedure Multiply_And_Round
(Balance
: in out Decimal_Fixed
;
76 Factor
: in Decimal_Fixed
);
78 procedure Divide_And_Round
(Balance
: in out Decimal_Fixed
;
79 Divisor
: in Decimal_Fixed
);
84 --==================================================================--
87 package body CXF2002_0
is
89 procedure Multiply_And_Truncate
(Balance
: in out Decimal_Fixed
;
90 Factor
: in Decimal_Fixed
) is
91 Interest
: Decimal_Fixed
;
93 Interest
:= Factor
* Balance
; -- Fixed-fixed multiplication.
94 Balance
:= Balance
+ Interest
;
95 end Multiply_And_Truncate
;
98 procedure Divide_And_Truncate
(Balance
: in out Decimal_Fixed
;
99 Divisor
: in Decimal_Fixed
) is
100 Interest
: Decimal_Fixed
;
102 Interest
:= Balance
/ Divisor
; -- Fixed-fixed division.
103 Balance
:= Balance
+ Interest
;
104 end Divide_And_Truncate
;
107 procedure Multiply_And_Round
(Balance
: in out Decimal_Fixed
;
108 Factor
: in Decimal_Fixed
) is
109 Interest
: Decimal_Fixed
;
111 -- Fixed-fixed multiplication.
112 Interest
:= Decimal_Fixed
'Round ( Factor
* Balance
);
113 Balance
:= Balance
+ Interest
;
114 end Multiply_And_Round
;
117 procedure Divide_And_Round
(Balance
: in out Decimal_Fixed
;
118 Divisor
: in Decimal_Fixed
) is
119 Interest
: Decimal_Fixed
;
121 -- Fixed-fixed division.
122 Interest
:= Decimal_Fixed
'Round ( Balance
/ Divisor
);
123 Balance
:= Balance
+ Interest
;
124 end Divide_And_Round
;
129 --==================================================================--
134 type Money_Radix2
is delta 0.01 digits 11; -- range -999,999,999.99 ..
135 for Money_Radix2
'Machine_Radix use 2; -- +999,999,999.99
138 type Money_Radix10
is delta 0.01 digits 11; -- range -999,999,999.99 ..
139 for Money_Radix10
'Machine_Radix use 10; -- +999,999,999.99
144 --==================================================================--
153 Loop_Count
: constant := 300;
154 type Loop_Range
is range 1 .. Loop_Count
;
158 Report
.Test
("CXF2002", "Check decimal multiplication and division, and " &
159 "'Round, where the operand and result types are " &
163 ---=---=---=---=---=---=---=---=---=---=---
168 package Radix_2
is new CXF2002_0
(CXF2002_1
.Money_Radix2
);
169 use type CXF2002_1
.Money_Radix2
;
172 RADIX_2_MULTIPLICATION
:
174 Rate
: constant CXF2002_1
.Money_Radix2
:= 0.12;
175 Period
: constant Integer := 12;
176 Factor
: CXF2002_1
.Money_Radix2
:= Rate
/ Period
;
178 Initial
: constant CXF2002_1
.Money_Radix2
:= 100_000
.00
;
179 Trunc_Expected
: constant CXF2002_1
.Money_Radix2
:= 1_978_837
.50
;
180 Round_Expected
: constant CXF2002_1
.Money_Radix2
:= 1_978_846
.75
;
182 Balance
: CXF2002_1
.Money_Radix2
;
184 ---=---=---=---=---=---=---
188 for I
in Loop_Range
loop
189 Radix_2
.Multiply_And_Truncate
(Balance
, Factor
);
192 if Balance
/= Trunc_Expected
then
193 Report
.Failed
("Wrong result: Radix 2 multiply and truncate");
196 ---=---=---=---=---=---=---
200 for I
in Loop_Range
loop
201 Radix_2
.Multiply_And_Round
(Balance
, Factor
);
204 if Balance
/= Round_Expected
then
205 Report
.Failed
("Wrong result: Radix 2 multiply and round");
208 ---=---=---=---=---=---=---
209 end RADIX_2_MULTIPLICATION
;
214 Rate
: constant CXF2002_1
.Money_Radix2
:= 0.25;
215 Period
: constant Integer := 12;
216 Factor
: CXF2002_1
.Money_Radix2
:= Rate
/ Period
;
217 Divisor
: constant CXF2002_1
.Money_Radix2
:= 1.0 / Factor
;
219 Initial
: constant CXF2002_1
.Money_Radix2
:= 5_500
.36
;
220 Trunc_Expected
: constant CXF2002_1
.Money_Radix2
:= 2_091_332
.87
;
221 Round_Expected
: constant CXF2002_1
.Money_Radix2
:= 2_091_436
.88
;
223 Balance
: CXF2002_1
.Money_Radix2
;
225 ---=---=---=---=---=---=---
229 for I
in Loop_Range
loop
230 Radix_2
.Divide_And_Truncate
(Balance
, Divisor
);
233 if Balance
/= Trunc_Expected
then
234 Report
.Failed
("Wrong result: Radix 2 divide and truncate");
237 ---=---=---=---=---=---=---
241 for I
in Loop_Range
loop
242 Radix_2
.Divide_And_Round
(Balance
, Divisor
);
245 if Balance
/= Round_Expected
then
246 Report
.Failed
("Wrong result: Radix 2 divide and round");
249 ---=---=---=---=---=---=---
250 end RADIX_2_DIVISION
;
252 end RADIX_2_SUBTESTS
;
255 ---=---=---=---=---=---=---=---=---=---=---
260 package Radix_10
is new CXF2002_0
(CXF2002_1
.Money_Radix10
);
261 use type CXF2002_1
.Money_Radix10
;
264 RADIX_10_MULTIPLICATION
:
266 Rate
: constant CXF2002_1
.Money_Radix10
:= 0.37;
267 Period
: constant Integer := 12;
268 Factor
: CXF2002_1
.Money_Radix10
:= Rate
/ Period
;
270 Initial
: constant CXF2002_1
.Money_Radix10
:= 459.33;
271 Trunc_Expected
: constant CXF2002_1
.Money_Radix10
:= 3_259_305
.54
;
272 Round_Expected
: constant CXF2002_1
.Money_Radix10
:= 3_260_544
.11
;
274 Balance
: CXF2002_1
.Money_Radix10
;
276 ---=---=---=---=---=---=---
280 for I
in Loop_Range
loop
281 Radix_10
.Multiply_And_Truncate
(Balance
, Factor
);
284 if Balance
/= Trunc_Expected
then
285 Report
.Failed
("Wrong result: Radix 10 multiply and truncate");
288 ---=---=---=---=---=---=---
292 for I
in Loop_Range
loop
293 Radix_10
.Multiply_And_Round
(Balance
, Factor
);
296 if Balance
/= Round_Expected
then
297 Report
.Failed
("Wrong result: Radix 10 multiply and round");
300 ---=---=---=---=---=---=---
301 end RADIX_10_MULTIPLICATION
;
306 Rate
: constant CXF2002_1
.Money_Radix10
:= 0.15;
307 Period
: constant Integer := 12;
308 Factor
: CXF2002_1
.Money_Radix10
:= Rate
/ Period
;
309 Divisor
: constant CXF2002_1
.Money_Radix10
:= 1.0 / Factor
;
311 Initial
: constant CXF2002_1
.Money_Radix10
:= 29_842
.08
;
312 Trunc_Expected
: constant CXF2002_1
.Money_Radix10
:= 590_519
.47
;
313 Round_Expected
: constant CXF2002_1
.Money_Radix10
:= 590_528
.98
;
315 Balance
: CXF2002_1
.Money_Radix10
;
317 ---=---=---=---=---=---=---
321 for I
in Loop_Range
loop
322 Radix_10
.Divide_And_Truncate
(Balance
, Divisor
);
325 if Balance
/= Trunc_Expected
then
326 Report
.Failed
("Wrong result: Radix 10 divide and truncate");
329 ---=---=---=---=---=---=---
333 for I
in Loop_Range
loop
334 Radix_10
.Divide_And_Round
(Balance
, Divisor
);
337 if Balance
/= Round_Expected
then
338 Report
.Failed
("Wrong result: Radix 10 divide and round");
341 ---=---=---=---=---=---=---
342 end RADIX_10_DIVISION
;
344 end RADIX_10_SUBTESTS
;
347 ---=---=---=---=---=---=---=---=---=---=---