Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxb/cxb4004.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 -- CXB4004.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 function Length, with Display_Format parameter, will
28 -- return the minimal length of a Numeric value that will be required
29 -- to hold the largest value of type Num represented as Format.
30 --
31 -- Check that function To_Decimal will produce a decimal type Num
32 -- result that corresponds to parameter Item as represented by
33 -- parameter Format.
34 --
35 -- Check that function To_Decimal propagates Conversion_Error when
36 -- the value represented by parameter Item is outside the range of
37 -- the Decimal_Type Num used to instantiate the package
38 -- Decimal_Conversions
39 --
40 -- Check that function To_Display returns a Numeric type result that
41 -- represents Item under the specific Display_Format.
42 --
43 -- Check that function To_Display propagates Conversion_Error when
44 -- parameter Item is negative and the specified Display_Format
45 -- parameter is Unsigned.
46 --
47 -- TEST DESCRIPTION:
48 -- This test checks the results from instantiated versions of three
49 -- functions within generic package Interfaces.COBOL.Decimal_Conversions.
50 -- This generic package is instantiated twice, with decimal types having
51 -- four and ten digits representation.
52 -- The function Length is validated with the Unsigned, Leading_Separate,
53 -- and Trailing_Separate Display_Format specifiers.
54 -- The results of function To_Decimal are verified in cases where it
55 -- is given a variety of Numeric and Display_Format type parameters.
56 -- Function To_Decimal is also checked to propagate Conversion_Error
57 -- when the value represented by parameter Item is outside the range
58 -- of the type used to instantiate the package.
59 -- The results of function To_Display are verified in cases where it
60 -- is given a variety of Num and Display_Format parameters. It is also
61 -- checked to ensure that it propagates Conversion_Error if parameter
62 -- Num is negative and the Format parameter is Unsigned.
63 --
64 -- This test assumes that the following characters are all included
65 -- in the implementation defined type Interfaces.COBOL.COBOL_Character:
66 -- ' ', '0'..'9', '+', '-', and '.'.
67 --
68 -- APPLICABILITY CRITERIA:
69 -- This test is applicable to all implementations that provide
70 -- package Interfaces.COBOL. If an implementation provides
71 -- package Interfaces.COBOL, this test must compile, execute, and
72 -- report "PASSED".
73 --
74 --
75 -- CHANGE HISTORY:
76 -- 06 Feb 96 SAIC Initial release for 2.1.
77 -- 30 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
78 -- 27 Oct 96 SAIC Incorporated reviewer comments.
79 --
80 --!
81
82 with Report;
83 with Interfaces.COBOL; -- N/A => ERROR
84 with Ada.Exceptions;
85
86 procedure CXB4004 is
87 begin
88
89 Report.Test ("CXB4004", "Check that the functions Length, To_Decimal, " &
90 "and To_Display produce correct results");
91
92 Test_Block:
93 declare
94
95 use Interfaces;
96 use Ada.Exceptions;
97 use type Interfaces.COBOL.Numeric;
98
99 Number_Of_Unsigned_Items : constant := 6;
100 Number_Of_Leading_Separate_Items : constant := 6;
101 Number_Of_Trailing_Separate_Items : constant := 6;
102 Number_Of_Decimal_Items : constant := 9;
103
104 type Decimal_Type_1 is delta 0.01 digits 4;
105 type Decimal_Type_2 is delta 1.0 digits 10;
106 type Numeric_Access is access COBOL.Numeric;
107 type Numeric_Items_Type is array(Integer range <>) of Numeric_Access;
108
109 Correct_Result : Boolean := False;
110 TC_Num_1 : Decimal_Type_1 := 0.0;
111 TC_Num_2 : Decimal_Type_2 := 0.0;
112
113 package Package_1 is new COBOL.Decimal_Conversions(Decimal_Type_1);
114 package Package_2 is new COBOL.Decimal_Conversions(Decimal_Type_2);
115
116
117 Package_1_Numeric_Items :
118 Numeric_Items_Type(1..Number_Of_Decimal_Items) :=
119 (new COBOL.Numeric'("0"),
120 new COBOL.Numeric'("591"),
121 new COBOL.Numeric'("6342"),
122 new COBOL.Numeric'("+0"),
123 new COBOL.Numeric'("-1539"),
124 new COBOL.Numeric'("+9199"),
125 new COBOL.Numeric'("0-"),
126 new COBOL.Numeric'("8934+"),
127 new COBOL.Numeric'("9949-"));
128
129 Package_2_Numeric_Items :
130 Numeric_Items_Type(1..Number_Of_Decimal_Items) :=
131 (new COBOL.Numeric'("3"),
132 new COBOL.Numeric'("105"),
133 new COBOL.Numeric'("1234567899"),
134 new COBOL.Numeric'("+8"),
135 new COBOL.Numeric'("-12345601"),
136 new COBOL.Numeric'("+9123459999"),
137 new COBOL.Numeric'("1-"),
138 new COBOL.Numeric'("123456781+"),
139 new COBOL.Numeric'("9499999999-"));
140
141
142 Decimal_Type_1_Items : array (1..Number_Of_Decimal_Items)
143 of Decimal_Type_1 :=
144 (0.0, 5.91, 63.42, 0.0, -15.39, 91.99, 0.0, 89.34, -99.49);
145
146 Decimal_Type_2_Items : array (1..Number_Of_Decimal_Items)
147 of Decimal_Type_2 :=
148 ( 3.0, 105.0, 1234567899.0,
149 8.0, -12345601.0, 9123459999.0,
150 -1.0, 123456781.0, -9499999999.0);
151
152 begin
153
154 -- Check that function Length with Display_Format parameter will
155 -- return the minimal length of a Numeric value (number of
156 -- COBOL_Characters) that will be required to hold the largest
157 -- value of type Num.
158
159 if Package_1.Length(COBOL.Unsigned) /= 4 or
160 Package_2.Length(COBOL.Unsigned) /= 10
161 then
162 Report.Failed("Incorrect results from function Length when " &
163 "used with Display_Format parameter Unsigned");
164 end if;
165
166 if Package_1.Length(Format => COBOL.Leading_Separate) /= 5 or
167 Package_2.Length(Format => COBOL.Leading_Separate) /= 11
168 then
169 Report.Failed("Incorrect results from function Length when " &
170 "used with Display_Format parameter " &
171 "Leading_Separate");
172 end if;
173
174 if Package_1.Length(COBOL.Trailing_Separate) /= 5 or
175 Package_2.Length(COBOL.Trailing_Separate) /= 11
176 then
177 Report.Failed("Incorrect results from function Length when " &
178 "used with Display_Format parameter " &
179 "Trailing_Separate");
180 end if;
181
182
183 -- Check that function To_Decimal with Numeric and Display_Format
184 -- parameters will produce a decimal type Num result that corresponds
185 -- to parameter Item as represented by parameter Format.
186
187 for i in 1..Number_Of_Decimal_Items loop
188 case i is
189 when 1..3 => -- Unsigned Display_Format parameter.
190
191 if Package_1.To_Decimal(Package_1_Numeric_Items(i).all,
192 Format => COBOL.Unsigned) /=
193 Decimal_Type_1_Items(i)
194 then
195 Report.Failed
196 ("Incorrect result from function To_Decimal " &
197 "from an instantiation of Decimal_Conversions " &
198 "using a four-digit Decimal type, with Format " &
199 "parameter Unsigned, subtest index: " &
200 Integer'Image(i));
201 end if;
202
203 if Package_2.To_Decimal(Package_2_Numeric_Items(i).all,
204 Format => COBOL.Unsigned) /=
205 Decimal_Type_2_Items(i)
206 then
207 Report.Failed
208 ("Incorrect result from function To_Decimal " &
209 "from an instantiation of Decimal_Conversions " &
210 "using a ten-digit Decimal type, with Format " &
211 "parameter Unsigned, subtest index: " &
212 Integer'Image(i));
213 end if;
214
215 when 4..6 => -- Leading_Separate Display_Format parameter.
216
217 if Package_1.To_Decimal(Package_1_Numeric_Items(i).all,
218 Format => COBOL.Leading_Separate) /=
219 Decimal_Type_1_Items(i)
220 then
221 Report.Failed
222 ("Incorrect result from function To_Decimal " &
223 "from an instantiation of Decimal_Conversions " &
224 "using a four-digit Decimal type, with Format " &
225 "parameter Leading_Separate, subtest index: " &
226 Integer'Image(i));
227 end if;
228
229 if Package_2.To_Decimal(Package_2_Numeric_Items(i).all,
230 Format => COBOL.Leading_Separate) /=
231 Decimal_Type_2_Items(i)
232 then
233 Report.Failed
234 ("Incorrect result from function To_Decimal " &
235 "from an instantiation of Decimal_Conversions " &
236 "using a ten-digit Decimal type, with Format " &
237 "parameter Leading_Separate, subtest index: " &
238 Integer'Image(i));
239 end if;
240
241 when 7..9 => -- Trailing_Separate Display_Format parameter.
242
243 if Package_1.To_Decimal(Package_1_Numeric_Items(i).all,
244 COBOL.Trailing_Separate) /=
245 Decimal_Type_1_Items(i)
246 then
247 Report.Failed
248 ("Incorrect result from function To_Decimal " &
249 "from an instantiation of Decimal_Conversions " &
250 "using a four-digit Decimal type, with Format " &
251 "parameter Trailing_Separate, subtest index: " &
252 Integer'Image(i));
253 end if;
254
255 if Package_2.To_Decimal(Package_2_Numeric_Items(i).all,
256 COBOL.Trailing_Separate) /=
257 Decimal_Type_2_Items(i)
258 then
259 Report.Failed
260 ("Incorrect result from function To_Decimal " &
261 "from an instantiation of Decimal_Conversions " &
262 "using a ten-digit Decimal type, with Format " &
263 "parameter Trailing_Separate, subtest index: " &
264 Integer'Image(i));
265 end if;
266
267 end case;
268 end loop;
269
270
271 -- Check that function To_Decimal propagates Conversion_Error when
272 -- the value represented by Numeric type parameter Item is outside
273 -- the range of the Decimal_Type Num used to instantiate the package
274 -- Decimal_Conversions.
275
276 declare
277 TC_Numeric_1 : Decimal_Type_1 := Decimal_Type_1_Items(1);
278 begin
279 -- The COBOL.Numeric type used as parameter Item represents a
280 -- Decimal value that is outside the range of the Decimal type
281 -- used to instantiate Package_1.
282 TC_Numeric_1 :=
283 Package_1.To_Decimal(Item => Package_2_Numeric_Items(8).all,
284 Format => COBOL.Trailing_Separate);
285 Report.Failed("Conversion_Error not raised by To_Decimal " &
286 "when the value represented by parameter " &
287 "Item is outside the range of the Decimal_Type " &
288 "used to instantiate the package " &
289 "Decimal_Conversions");
290 if TC_Numeric_1 = Decimal_Type_1_Items(1) then
291 Report.Comment("To Guard Against Dead Assignment Elimination " &
292 "-- Should never be printed");
293 end if;
294 exception
295 when COBOL.Conversion_Error => null; -- OK, expected exception.
296 when others =>
297 Report.Failed("Incorrect exception raised by To_Decimal " &
298 "when the value represented by parameter " &
299 "Item is outside the range of the Decimal_Type " &
300 "used to instantiate the package " &
301 "Decimal_Conversions");
302 end;
303
304
305 -- Check that function To_Display with decimal type Num and
306 -- Display_Format parameters returns a Numeric type result that
307 -- represents Item under the specific Display_Format.
308
309 -- Unsigned Display_Format parameter.
310 TC_Num_1 := 13.04;
311 Correct_Result := (Package_1.To_Display(TC_Num_1, COBOL.Unsigned) =
312 "1304") AND
313 (Package_1.To_Display(TC_Num_1, COBOL.Unsigned) /=
314 "13.04");
315 if not Correct_Result then
316 Report.Failed("Incorrect result from function To_Display with " &
317 "Unsigned Display_Format parameter - 1");
318 end if;
319
320 TC_Num_2 := 1234567890.0;
321 Correct_Result := Package_2.To_Display(TC_Num_2,
322 COBOL.Unsigned) = "1234567890";
323 if not Correct_Result then
324 Report.Failed("Incorrect result from function To_Display with " &
325 "Unsigned Display_Format parameter - 2");
326 end if;
327
328 -- Leading_Separate Display_Format parameter.
329 TC_Num_1 := -34.29;
330 Correct_Result := (Package_1.To_Display(TC_Num_1,
331 COBOL.Leading_Separate) =
332 "-3429") AND
333 (Package_1.To_Display(TC_Num_1,
334 COBOL.Leading_Separate) /=
335 "-34.29");
336 if not Correct_Result then
337 Report.Failed("Incorrect result from function To_Display with " &
338 "Leading_Separate Display_Format parameter - 1");
339 end if;
340
341 TC_Num_1 := 19.01;
342 Correct_Result := Package_1.To_Display(TC_Num_1,
343 COBOL.Leading_Separate) =
344 "+1901";
345 if not Correct_Result then
346 Report.Failed("Incorrect result from function To_Display with " &
347 "Leading_Separate Display_Format parameter - 2");
348 end if;
349
350 TC_Num_2 := 1234567890.0;
351 Correct_Result := Package_2.To_Display(TC_Num_2,
352 COBOL.Leading_Separate) =
353 "+1234567890";
354 if not Correct_Result then
355 Report.Failed("Incorrect result from function To_Display with " &
356 "Leading_Separate Display_Format parameter - 3");
357 end if;
358
359 TC_Num_2 := -1234567890.0;
360 Correct_Result := Package_2.To_Display(TC_Num_2,
361 COBOL.Leading_Separate) =
362 "-1234567890";
363 if not Correct_Result then
364 Report.Failed("Incorrect result from function To_Display with " &
365 "Leading_Separate Display_Format parameter - 4");
366 end if;
367
368 -- Trailing_Separate Display_Format parameter.
369 TC_Num_1 := -99.91;
370 Correct_Result := (Package_1.To_Display(TC_Num_1,
371 COBOL.Trailing_Separate) =
372 "9991-") AND
373 (Package_1.To_Display(TC_Num_1,
374 COBOL.Trailing_Separate) /=
375 "99.91-");
376 if not Correct_Result then
377 Report.Failed("Incorrect result from function To_Display with " &
378 "Trailing_Separate Display_Format parameter - 1");
379 end if;
380
381 TC_Num_1 := 51.99;
382 Correct_Result := Package_1.To_Display(TC_Num_1,
383 COBOL.Trailing_Separate) =
384 "5199+";
385 if not Correct_Result then
386 Report.Failed("Incorrect result from function To_Display with " &
387 "Trailing_Separate Display_Format parameter - 2");
388 end if;
389
390 TC_Num_2 := 1234567890.0;
391 Correct_Result := Package_2.To_Display(TC_Num_2,
392 COBOL.Trailing_Separate) =
393 "1234567890+";
394 if not Correct_Result then
395 Report.Failed("Incorrect result from function To_Display with " &
396 "Trailing_Separate Display_Format parameter - 3");
397 end if;
398
399 TC_Num_2 := -1234567890.0;
400 Correct_Result := Package_2.To_Display(TC_Num_2,
401 COBOL.Trailing_Separate) =
402 "1234567890-";
403 if not Correct_Result then
404 Report.Failed("Incorrect result from function To_Display with " &
405 "Trailing_Separate Display_Format parameter - 4");
406 end if;
407
408
409 -- Check that function To_Display propagates Conversion_Error when
410 -- parameter Item is negative and the specified Display_Format
411 -- parameter is Unsigned.
412
413 begin
414 if Package_2.To_Display(Item => Decimal_Type_2_Items(9),
415 Format => COBOL.Unsigned) =
416 Package_2_Numeric_Items(2).all
417 then
418 Report.Comment("To Guard Against Dead Assignment Elimination " &
419 "-- Should never be printed");
420 end if;
421 Report.Failed("Conversion_Error not raised by To_Display " &
422 "when the value represented by parameter " &
423 "Item is negative and the Display_Format " &
424 "parameter is Unsigned");
425 exception
426 when COBOL.Conversion_Error => null; -- OK, expected exception.
427 when others =>
428 Report.Failed("Incorrect exception raised by To_Display " &
429 "when the value represented by parameter " &
430 "Item is negative and the Display_Format " &
431 "parameter is Unsigned");
432 end;
433
434
435 exception
436 when The_Error : others =>
437 Report.Failed ("The following exception was raised in the " &
438 "Test_Block: " & Exception_Name(The_Error));
439 end Test_Block;
440
441 Report.Result;
442
443 end CXB4004;