Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxf/cxf2005.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 -- 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;