annotate gcc/testsuite/ada/acats/tests/cxb/cxb4003.a @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 -- CXB4003.A
kono
parents:
diff changeset
2 --
kono
parents:
diff changeset
3 -- Grant of Unlimited Rights
kono
parents:
diff changeset
4 --
kono
parents:
diff changeset
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
kono
parents:
diff changeset
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
kono
parents:
diff changeset
7 -- unlimited rights in the software and documentation contained herein.
kono
parents:
diff changeset
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
kono
parents:
diff changeset
9 -- this public release, the Government intends to confer upon all
kono
parents:
diff changeset
10 -- recipients unlimited rights equal to those held by the Government.
kono
parents:
diff changeset
11 -- These rights include rights to use, duplicate, release or disclose the
kono
parents:
diff changeset
12 -- released technical data and computer software in whole or in part, in
kono
parents:
diff changeset
13 -- any manner and for any purpose whatsoever, and to have or permit others
kono
parents:
diff changeset
14 -- to do so.
kono
parents:
diff changeset
15 --
kono
parents:
diff changeset
16 -- DISCLAIMER
kono
parents:
diff changeset
17 --
kono
parents:
diff changeset
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
kono
parents:
diff changeset
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
kono
parents:
diff changeset
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
kono
parents:
diff changeset
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
kono
parents:
diff changeset
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
kono
parents:
diff changeset
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
kono
parents:
diff changeset
24 --*
kono
parents:
diff changeset
25 --
kono
parents:
diff changeset
26 -- OBJECTIVE:
kono
parents:
diff changeset
27 -- Check that function Valid, with the Display_Format parameter
kono
parents:
diff changeset
28 -- set to Unsigned, will return True if Numeric parameter Item
kono
parents:
diff changeset
29 -- comprises one or more decimal digit characters; check that it
kono
parents:
diff changeset
30 -- returns False if the parameter Item is otherwise comprised.
kono
parents:
diff changeset
31 --
kono
parents:
diff changeset
32 -- Check that function Valid, with Display_Format parameter set to
kono
parents:
diff changeset
33 -- Leading_Separate, will return True if Numeric parameter Item
kono
parents:
diff changeset
34 -- comprises a single occurrence of a Plus_Sign or Minus_Sign
kono
parents:
diff changeset
35 -- character, and then by one or more decimal digit characters;
kono
parents:
diff changeset
36 -- check that it returns False if the parameter Item is otherwise
kono
parents:
diff changeset
37 -- comprised.
kono
parents:
diff changeset
38 --
kono
parents:
diff changeset
39 -- Check that function Valid, with Display_Format parameter set to
kono
parents:
diff changeset
40 -- Trailing_Separate, will return True if Numeric parameter Item
kono
parents:
diff changeset
41 -- comprises one or more decimal digit characters, and then by a
kono
parents:
diff changeset
42 -- single occurrence of the Plus_Sign or Minus_Sign character;
kono
parents:
diff changeset
43 -- check that it returns False if the parameter Item is otherwise
kono
parents:
diff changeset
44 -- comprised.
kono
parents:
diff changeset
45 --
kono
parents:
diff changeset
46 -- TEST DESCRIPTION:
kono
parents:
diff changeset
47 -- This test checks that a version of function Valid, from an instance
kono
parents:
diff changeset
48 -- of the generic package Decimal_Conversions, will produce correct
kono
parents:
diff changeset
49 -- results based on the particular Numeric and Display_Format
kono
parents:
diff changeset
50 -- parameters provided. Arrays of both valid and invalid Numeric
kono
parents:
diff changeset
51 -- data items have been created to correspond to a particular
kono
parents:
diff changeset
52 -- value of Display_Format. The result of the function is compared
kono
parents:
diff changeset
53 -- against the expected result for each appropriate combination of
kono
parents:
diff changeset
54 -- Numeric and Display_Format parameter.
kono
parents:
diff changeset
55 -- This test assumes that the following characters are all included
kono
parents:
diff changeset
56 -- in the implementation defined type Interfaces.COBOL.COBOL_Character:
kono
parents:
diff changeset
57 -- ' ', 'A'..'Z', '+', '-', '.', '$'.
kono
parents:
diff changeset
58 --
kono
parents:
diff changeset
59 -- APPLICABILITY CRITERIA:
kono
parents:
diff changeset
60 -- This test is applicable to all implementations that provide
kono
parents:
diff changeset
61 -- package Interfaces.COBOL. If an implementation provides
kono
parents:
diff changeset
62 -- package Interfaces.COBOL, this test must compile, execute, and
kono
parents:
diff changeset
63 -- report "PASSED".
kono
parents:
diff changeset
64 --
kono
parents:
diff changeset
65 --
kono
parents:
diff changeset
66 --
kono
parents:
diff changeset
67 -- CHANGE HISTORY:
kono
parents:
diff changeset
68 -- 18 Jan 96 SAIC Initial version for 2.1.
kono
parents:
diff changeset
69 -- 30 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
kono
parents:
diff changeset
70 -- 27 Oct 96 SAIC Incorporated reviewer comments.
kono
parents:
diff changeset
71 --
kono
parents:
diff changeset
72 --!
kono
parents:
diff changeset
73
kono
parents:
diff changeset
74 with Report;
kono
parents:
diff changeset
75 with Ada.Exceptions;
kono
parents:
diff changeset
76 with Interfaces.COBOL; -- N/A => ERROR
kono
parents:
diff changeset
77
kono
parents:
diff changeset
78 procedure CXB4003 is
kono
parents:
diff changeset
79 begin
kono
parents:
diff changeset
80
kono
parents:
diff changeset
81 Report.Test ("CXB4003", "Check that function Valid, with various " &
kono
parents:
diff changeset
82 "Display_Format parameters, produces correct " &
kono
parents:
diff changeset
83 "results");
kono
parents:
diff changeset
84
kono
parents:
diff changeset
85 Test_Block:
kono
parents:
diff changeset
86 declare
kono
parents:
diff changeset
87
kono
parents:
diff changeset
88 use Interfaces;
kono
parents:
diff changeset
89 use Ada.Exceptions;
kono
parents:
diff changeset
90
kono
parents:
diff changeset
91 type A_Numeric_Type is delta 0.01 digits 16;
kono
parents:
diff changeset
92 type Numeric_Access is access COBOL.Numeric;
kono
parents:
diff changeset
93 type Numeric_Items_Type is array(Integer range <>) of Numeric_Access;
kono
parents:
diff changeset
94
kono
parents:
diff changeset
95 package Display_Format is
kono
parents:
diff changeset
96 new COBOL.Decimal_Conversions(Num => A_Numeric_Type);
kono
parents:
diff changeset
97
kono
parents:
diff changeset
98
kono
parents:
diff changeset
99 Number_Of_Valid_Unsigned_Items : constant := 5;
kono
parents:
diff changeset
100 Number_Of_Invalid_Unsigned_Items : constant := 21;
kono
parents:
diff changeset
101 Number_Of_Valid_Leading_Separate_Items : constant := 5;
kono
parents:
diff changeset
102 Number_Of_Invalid_Leading_Separate_Items : constant := 23;
kono
parents:
diff changeset
103 Number_Of_Valid_Trailing_Separate_Items : constant := 5;
kono
parents:
diff changeset
104 Number_Of_Invalid_Trailing_Separate_Items : constant := 22;
kono
parents:
diff changeset
105
kono
parents:
diff changeset
106 Valid_Unsigned_Items :
kono
parents:
diff changeset
107 Numeric_Items_Type(1..Number_Of_Valid_Unsigned_Items) :=
kono
parents:
diff changeset
108 (new COBOL.Numeric'("0"),
kono
parents:
diff changeset
109 new COBOL.Numeric'("1"),
kono
parents:
diff changeset
110 new COBOL.Numeric'("0000000001"),
kono
parents:
diff changeset
111 new COBOL.Numeric'("1234567890123456"),
kono
parents:
diff changeset
112 new COBOL.Numeric'("0000"));
kono
parents:
diff changeset
113
kono
parents:
diff changeset
114 Invalid_Unsigned_Items :
kono
parents:
diff changeset
115 Numeric_Items_Type(1..Number_Of_Invalid_Unsigned_Items) :=
kono
parents:
diff changeset
116 (new COBOL.Numeric'(" 12345"),
kono
parents:
diff changeset
117 new COBOL.Numeric'(" 12345"),
kono
parents:
diff changeset
118 new COBOL.Numeric'("1234567890 "),
kono
parents:
diff changeset
119 new COBOL.Numeric'("1234567890 "),
kono
parents:
diff changeset
120 new COBOL.Numeric'("1.01"),
kono
parents:
diff changeset
121 new COBOL.Numeric'(".0000000001"),
kono
parents:
diff changeset
122 new COBOL.Numeric'("12345 6"),
kono
parents:
diff changeset
123 new COBOL.Numeric'("MCXVIII"),
kono
parents:
diff changeset
124 new COBOL.Numeric'("15F"),
kono
parents:
diff changeset
125 new COBOL.Numeric'("+12345"),
kono
parents:
diff changeset
126 new COBOL.Numeric'("$12.30"),
kono
parents:
diff changeset
127 new COBOL.Numeric'("1234-"),
kono
parents:
diff changeset
128 new COBOL.Numeric'("12--"),
kono
parents:
diff changeset
129 new COBOL.Numeric'("+12-"),
kono
parents:
diff changeset
130 new COBOL.Numeric'("++99--"),
kono
parents:
diff changeset
131 new COBOL.Numeric'("-1.01"),
kono
parents:
diff changeset
132 new COBOL.Numeric'("(1.01)"),
kono
parents:
diff changeset
133 new COBOL.Numeric'("123,456"),
kono
parents:
diff changeset
134 new COBOL.Numeric'("101."),
kono
parents:
diff changeset
135 new COBOL.Numeric'(""),
kono
parents:
diff changeset
136 new COBOL.Numeric'("1.0000"));
kono
parents:
diff changeset
137
kono
parents:
diff changeset
138 Valid_Leading_Separate_Items :
kono
parents:
diff changeset
139 Numeric_Items_Type(1..Number_Of_Valid_Leading_Separate_Items) :=
kono
parents:
diff changeset
140 (new COBOL.Numeric'("+1000"),
kono
parents:
diff changeset
141 new COBOL.Numeric'("-1"),
kono
parents:
diff changeset
142 new COBOL.Numeric'("-0000000001"),
kono
parents:
diff changeset
143 new COBOL.Numeric'("+1234567890123456"),
kono
parents:
diff changeset
144 new COBOL.Numeric'("-0000"));
kono
parents:
diff changeset
145
kono
parents:
diff changeset
146 Invalid_Leading_Separate_Items :
kono
parents:
diff changeset
147 Numeric_Items_Type(1..Number_Of_Invalid_Leading_Separate_Items) :=
kono
parents:
diff changeset
148 (new COBOL.Numeric'("123456"),
kono
parents:
diff changeset
149 new COBOL.Numeric'(" +12345"),
kono
parents:
diff changeset
150 new COBOL.Numeric'(" +12345"),
kono
parents:
diff changeset
151 new COBOL.Numeric'("- 0000000001"),
kono
parents:
diff changeset
152 new COBOL.Numeric'("1234567890- "),
kono
parents:
diff changeset
153 new COBOL.Numeric'("1234567890+ "),
kono
parents:
diff changeset
154 new COBOL.Numeric'("123-456"),
kono
parents:
diff changeset
155 new COBOL.Numeric'("+15F"),
kono
parents:
diff changeset
156 new COBOL.Numeric'("++123"),
kono
parents:
diff changeset
157 new COBOL.Numeric'("12--"),
kono
parents:
diff changeset
158 new COBOL.Numeric'("+12-"),
kono
parents:
diff changeset
159 new COBOL.Numeric'("+/-12"),
kono
parents:
diff changeset
160 new COBOL.Numeric'("++99--"),
kono
parents:
diff changeset
161 new COBOL.Numeric'("1.01"),
kono
parents:
diff changeset
162 new COBOL.Numeric'("(1.01)"),
kono
parents:
diff changeset
163 new COBOL.Numeric'("+123,456"),
kono
parents:
diff changeset
164 new COBOL.Numeric'("+15FF"),
kono
parents:
diff changeset
165 new COBOL.Numeric'("- 123"),
kono
parents:
diff changeset
166 new COBOL.Numeric'("+$123"),
kono
parents:
diff changeset
167 new COBOL.Numeric'(""),
kono
parents:
diff changeset
168 new COBOL.Numeric'("-"),
kono
parents:
diff changeset
169 new COBOL.Numeric'("-1.01"),
kono
parents:
diff changeset
170 new COBOL.Numeric'("1.0000+"));
kono
parents:
diff changeset
171
kono
parents:
diff changeset
172 Valid_Trailing_Separate_Items :
kono
parents:
diff changeset
173 Numeric_Items_Type(1..Number_Of_Valid_Trailing_Separate_Items) :=
kono
parents:
diff changeset
174 (new COBOL.Numeric'("1001-"),
kono
parents:
diff changeset
175 new COBOL.Numeric'("1+"),
kono
parents:
diff changeset
176 new COBOL.Numeric'("0000000001+"),
kono
parents:
diff changeset
177 new COBOL.Numeric'("1234567890123456-"),
kono
parents:
diff changeset
178 new COBOL.Numeric'("0000-"));
kono
parents:
diff changeset
179
kono
parents:
diff changeset
180 Invalid_Trailing_Separate_Items :
kono
parents:
diff changeset
181 Numeric_Items_Type(1..Number_Of_Invalid_Trailing_Separate_Items) :=
kono
parents:
diff changeset
182 (new COBOL.Numeric'("123456"),
kono
parents:
diff changeset
183 new COBOL.Numeric'("+12345"),
kono
parents:
diff changeset
184 new COBOL.Numeric'("12345 "),
kono
parents:
diff changeset
185 new COBOL.Numeric'("123- "),
kono
parents:
diff changeset
186 new COBOL.Numeric'("123- "),
kono
parents:
diff changeset
187 new COBOL.Numeric'("12345 +"),
kono
parents:
diff changeset
188 new COBOL.Numeric'("12345+ "),
kono
parents:
diff changeset
189 new COBOL.Numeric'("-0000000001"),
kono
parents:
diff changeset
190 new COBOL.Numeric'("123-456"),
kono
parents:
diff changeset
191 new COBOL.Numeric'("12--"),
kono
parents:
diff changeset
192 new COBOL.Numeric'("+12-"),
kono
parents:
diff changeset
193 new COBOL.Numeric'("99+-"),
kono
parents:
diff changeset
194 new COBOL.Numeric'("12+/-"),
kono
parents:
diff changeset
195 new COBOL.Numeric'("12.01-"),
kono
parents:
diff changeset
196 new COBOL.Numeric'("$12.01+"),
kono
parents:
diff changeset
197 new COBOL.Numeric'("(1.01)"),
kono
parents:
diff changeset
198 new COBOL.Numeric'("DM12-"),
kono
parents:
diff changeset
199 new COBOL.Numeric'("123,456+"),
kono
parents:
diff changeset
200 new COBOL.Numeric'(""),
kono
parents:
diff changeset
201 new COBOL.Numeric'("-"),
kono
parents:
diff changeset
202 new COBOL.Numeric'("1.01-"),
kono
parents:
diff changeset
203 new COBOL.Numeric'("+1.0000"));
kono
parents:
diff changeset
204
kono
parents:
diff changeset
205 begin
kono
parents:
diff changeset
206
kono
parents:
diff changeset
207 -- Check that function Valid, with the Display_Format parameter
kono
parents:
diff changeset
208 -- set to Unsigned, will return True if Numeric parameter Item
kono
parents:
diff changeset
209 -- comprises one or more decimal digit characters; check that it
kono
parents:
diff changeset
210 -- returns False if the parameter Item is otherwise comprised.
kono
parents:
diff changeset
211
kono
parents:
diff changeset
212 for i in 1..Number_of_Valid_Unsigned_Items loop
kono
parents:
diff changeset
213 -- Fail if the Item parameter is _NOT_ considered Valid.
kono
parents:
diff changeset
214 if not Display_Format.Valid(Item => Valid_Unsigned_Items(i).all,
kono
parents:
diff changeset
215 Format => COBOL.Unsigned)
kono
parents:
diff changeset
216 then
kono
parents:
diff changeset
217 Report.Failed("Incorrect result from function Valid, with " &
kono
parents:
diff changeset
218 "Format parameter set to Unsigned, for valid " &
kono
parents:
diff changeset
219 "format item number " & Integer'Image(i));
kono
parents:
diff changeset
220 end if;
kono
parents:
diff changeset
221 end loop;
kono
parents:
diff changeset
222
kono
parents:
diff changeset
223
kono
parents:
diff changeset
224 for i in 1..Number_of_Invalid_Unsigned_Items loop
kono
parents:
diff changeset
225 -- Fail if the Item parameter _IS_ considered Valid.
kono
parents:
diff changeset
226 if Display_Format.Valid(Item => Invalid_Unsigned_Items(i).all,
kono
parents:
diff changeset
227 Format => COBOL.Unsigned)
kono
parents:
diff changeset
228 then
kono
parents:
diff changeset
229 Report.Failed("Incorrect result from function Valid, with " &
kono
parents:
diff changeset
230 "Format parameter set to Unsigned, for invalid " &
kono
parents:
diff changeset
231 "format item number " & Integer'Image(i));
kono
parents:
diff changeset
232 end if;
kono
parents:
diff changeset
233 end loop;
kono
parents:
diff changeset
234
kono
parents:
diff changeset
235
kono
parents:
diff changeset
236
kono
parents:
diff changeset
237 -- Check that function Valid, with Display_Format parameter set to
kono
parents:
diff changeset
238 -- Leading_Separate, will return True if Numeric parameter Item
kono
parents:
diff changeset
239 -- comprises a single occurrence of a Plus_Sign or Minus_Sign
kono
parents:
diff changeset
240 -- character, and then by one or more decimal digit characters;
kono
parents:
diff changeset
241 -- check that it returns False if the parameter Item is otherwise
kono
parents:
diff changeset
242 -- comprised.
kono
parents:
diff changeset
243
kono
parents:
diff changeset
244 for i in 1..Number_of_Valid_Leading_Separate_Items loop
kono
parents:
diff changeset
245 -- Fail if the Item parameter is _NOT_ considered Valid.
kono
parents:
diff changeset
246 if not Display_Format.Valid(Valid_Leading_Separate_Items(i).all,
kono
parents:
diff changeset
247 Format => COBOL.Leading_Separate)
kono
parents:
diff changeset
248 then
kono
parents:
diff changeset
249 Report.Failed("Incorrect result from function Valid, with " &
kono
parents:
diff changeset
250 "Format parameter set to Leading_Separate, " &
kono
parents:
diff changeset
251 "for valid format item number " & Integer'Image(i));
kono
parents:
diff changeset
252 end if;
kono
parents:
diff changeset
253 end loop;
kono
parents:
diff changeset
254
kono
parents:
diff changeset
255
kono
parents:
diff changeset
256 for i in 1..Number_of_Invalid_Leading_Separate_Items loop
kono
parents:
diff changeset
257 -- Fail if the Item parameter _IS_ considered Valid.
kono
parents:
diff changeset
258 if Display_Format.Valid(Invalid_Leading_Separate_Items(i).all,
kono
parents:
diff changeset
259 Format => COBOL.Leading_Separate)
kono
parents:
diff changeset
260 then
kono
parents:
diff changeset
261 Report.Failed("Incorrect result from function Valid, with " &
kono
parents:
diff changeset
262 "Format parameter set to Leading_Separate, " &
kono
parents:
diff changeset
263 "for invalid format item number " &
kono
parents:
diff changeset
264 Integer'Image(i));
kono
parents:
diff changeset
265 end if;
kono
parents:
diff changeset
266 end loop;
kono
parents:
diff changeset
267
kono
parents:
diff changeset
268
kono
parents:
diff changeset
269
kono
parents:
diff changeset
270 -- Check that function Valid, with Display_Format parameter set to
kono
parents:
diff changeset
271 -- Trailing_Separate, will return True if Numeric parameter Item
kono
parents:
diff changeset
272 -- comprises one or more decimal digit characters, and then by a
kono
parents:
diff changeset
273 -- single occurrence of the Plus_Sign or Minus_Sign character;
kono
parents:
diff changeset
274 -- check that it returns False if the parameter Item is otherwise
kono
parents:
diff changeset
275 -- comprised.
kono
parents:
diff changeset
276
kono
parents:
diff changeset
277 for i in 1..Number_of_Valid_Trailing_Separate_Items loop
kono
parents:
diff changeset
278 -- Fail if the Item parameter is _NOT_ considered Valid.
kono
parents:
diff changeset
279 if not Display_Format.Valid(Valid_Trailing_Separate_Items(i).all,
kono
parents:
diff changeset
280 COBOL.Trailing_Separate)
kono
parents:
diff changeset
281 then
kono
parents:
diff changeset
282 Report.Failed("Incorrect result from function Valid, with " &
kono
parents:
diff changeset
283 "Format parameter set to Trailing_Separate, " &
kono
parents:
diff changeset
284 "for valid format item number " & Integer'Image(i));
kono
parents:
diff changeset
285 end if;
kono
parents:
diff changeset
286 end loop;
kono
parents:
diff changeset
287
kono
parents:
diff changeset
288
kono
parents:
diff changeset
289 for i in 1..Number_of_Invalid_Trailing_Separate_Items loop
kono
parents:
diff changeset
290 -- Fail if the Item parameter _IS_ considered Valid.
kono
parents:
diff changeset
291 if Display_Format.Valid(Invalid_Trailing_Separate_Items(i).all,
kono
parents:
diff changeset
292 COBOL.Trailing_Separate)
kono
parents:
diff changeset
293 then
kono
parents:
diff changeset
294 Report.Failed("Incorrect result from function Valid, with " &
kono
parents:
diff changeset
295 "Format parameter set to Trailing_Separate, " &
kono
parents:
diff changeset
296 "for invalid format item number " &
kono
parents:
diff changeset
297 Integer'Image(i));
kono
parents:
diff changeset
298 end if;
kono
parents:
diff changeset
299 end loop;
kono
parents:
diff changeset
300
kono
parents:
diff changeset
301
kono
parents:
diff changeset
302 exception
kono
parents:
diff changeset
303 when The_Error : others =>
kono
parents:
diff changeset
304 Report.Failed ("The following exception was raised in the " &
kono
parents:
diff changeset
305 "Test_Block: " & Exception_Name(The_Error));
kono
parents:
diff changeset
306 end Test_Block;
kono
parents:
diff changeset
307
kono
parents:
diff changeset
308 Report.Result;
kono
parents:
diff changeset
309
kono
parents:
diff changeset
310 end CXB4003;