Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/ce/ce3704f.ada @ 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 -- CE3704F.ADA
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 -- OBJECTIVE:
26 -- CHECK THAT INTEGER_IO GET DOES NOT ALLOW EMBEDDED BLANKS OR
27 -- CONSECUTIVE UNDERSCORES TO BE INPUT.
28
29 -- APPLICABILITY CRITERIA:
30 -- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
31 -- SUPPORT TEXT FILES.
32
33 -- HISTORY:
34 -- SPS 10/04/82
35 -- VKG 01/14/83
36 -- CPP 07/30/84
37 -- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE
38 -- RESULT WHEN FILES ARE NOT SUPPORTED.
39 -- DWC 09/10/87 REMOVED UNNECESSARY CODE, CORRECTED EXCEPTION
40 -- HANDLING, AND ADDED MORE CHECKS OF THE VALUES
41 -- OF CHARACTERS READ.
42
43 WITH REPORT; USE REPORT;
44 WITH TEXT_IO; USE TEXT_IO;
45
46 PROCEDURE CE3704F IS
47 INCOMPLETE : EXCEPTION;
48
49 BEGIN
50
51 TEST ("CE3704F", "INTEGER_IO GET DOES NOT ALLOW EMBEDDED " &
52 "BLANKS OR CONSECUTIVE UNDERSCORES");
53
54 DECLARE
55 FT : FILE_TYPE;
56 X : INTEGER;
57 PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
58 USE IIO;
59 CH : CHARACTER;
60 P : POSITIVE;
61 BEGIN
62
63 -- CREATE AND INITIALIZE FILE
64
65 BEGIN
66 CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
67 EXCEPTION
68 WHEN USE_ERROR =>
69 NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
70 "WITH OUT_FILE MODE");
71 RAISE INCOMPLETE;
72 WHEN NAME_ERROR =>
73 NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
74 "WITH OUT_FILE MODE");
75 RAISE INCOMPLETE;
76 END;
77
78 PUT (FT, "12_345");
79 NEW_LINE (FT);
80 PUT (FT, "12 345");
81 NEW_LINE (FT);
82 PUT (FT, "1__345");
83 NEW_LINE (FT);
84 PUT (FT, "-56");
85 NEW_LINE (FT);
86 PUT (FT, "10E0");
87 NEW_LINE (FT);
88 PUT (FT, "10E-2X");
89 NEW_LINE (FT);
90 PUT (FT, "4E1__2");
91 NEW_LINE (FT);
92 PUT (FT, "1 0#99#");
93 NEW_LINE (FT);
94 PUT (FT, "1__0#99#");
95 NEW_LINE (FT);
96 PUT (FT, "10#9_9#");
97 NEW_LINE (FT);
98 PUT (FT, "10#9__9#");
99 NEW_LINE (FT);
100 PUT (FT, "10#9 9#");
101 NEW_LINE (FT);
102 PUT (FT, "16#E#E1");
103 NEW_LINE (FT);
104 PUT (FT, "2#110#E1_1");
105 NEW_LINE (FT);
106 PUT (FT, "2#110#E1__1");
107 CLOSE(FT);
108
109 -- BEGIN TEST
110
111 BEGIN
112 OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
113 EXCEPTION
114 WHEN USE_ERROR =>
115 NOT_APPLICABLE ("USE_ERROR RAISED; " &
116 "TEXT OPEN WITH IN_FILE " &
117 "MODE");
118 RAISE INCOMPLETE;
119 END;
120
121 GET (FT, X);
122 IF X /= 12345 THEN
123 FAILED ("GET WITH UNDERSCORE INCORRECT - (1)");
124 END IF;
125
126 SKIP_LINE (FT);
127
128 BEGIN
129 GET (FT, X, 6);
130 FAILED ("DATA_ERROR NOT RAISED - (2)");
131 EXCEPTION
132 WHEN DATA_ERROR =>
133 NULL;
134 WHEN OTHERS =>
135 FAILED ("WRONG EXCEPTION RAISED - (2)");
136 END;
137
138 SKIP_LINE (FT);
139
140 BEGIN
141 GET (FT, X);
142 FAILED ("DATA_ERROR NOT RAISED - (3)");
143 EXCEPTION
144 WHEN DATA_ERROR =>
145 NULL;
146 WHEN OTHERS =>
147 FAILED ("WRONG EXCEPTION RAISED - (3)");
148 END;
149
150 IF END_OF_LINE (FT) THEN
151 FAILED ("GET STOPPED AT END OF LINE - (3)");
152 ELSE
153 GET (FT, CH);
154 IF CH /= '_' THEN
155 FAILED ("GET STOPPED AT WRONG POSITION - " &
156 "(3): CHAR IS " & CH);
157 END IF;
158 GET (FT, CH);
159 IF CH /= '3' THEN
160 FAILED ("GET STOPPED AT WRONG POSITION - " &
161 "(3.5): CHAR IS " & CH);
162 END IF;
163 END IF;
164
165 SKIP_LINE (FT);
166 GET (FT, X);
167 IF X /= (-56) THEN
168 FAILED ("GET WITH GOOD CASE INCORRECT - (4)");
169 END IF;
170
171 SKIP_LINE (FT);
172 GET (FT, X, 4);
173 IF X /= 10 THEN
174 FAILED ("GET WITH ZERO EXPONENT INCORRECT - (5)");
175 END IF;
176
177 SKIP_LINE (FT);
178
179 BEGIN
180 GET (FT, X);
181 FAILED ("DATA_ERROR NOT RAISED - (6)");
182 EXCEPTION
183 WHEN DATA_ERROR =>
184 NULL;
185 WHEN OTHERS =>
186 FAILED ("WRONG EXCEPTION RAISED - (6)");
187 END;
188
189 IF END_OF_LINE (FT) THEN
190 FAILED ("GET STOPPED AT END OF LINE - (6)");
191 ELSE
192 GET (FT, CH);
193 IF CH /= 'X' THEN
194 FAILED ("GET STOPPED AT WRONG POSITION - " &
195 "(6): CHAR IS " & CH);
196 END IF;
197 END IF;
198
199 SKIP_LINE (FT);
200
201 BEGIN
202 GET (FT, X);
203 FAILED ("DATA_ERROR NOT RAISED - (7)");
204 EXCEPTION
205 WHEN DATA_ERROR =>
206 NULL;
207 WHEN OTHERS =>
208 FAILED ("WRONG EXCEPTION RAISED - (7)");
209 END;
210
211 IF END_OF_LINE (FT) THEN
212 FAILED ("GET STOPPED AT END OF LINE - (7)");
213 ELSE
214 GET (FT, CH);
215 IF CH /= '_' THEN
216 FAILED ("GET STOPPED AT WRONG POSITION - " &
217 "(7): CHAR IS " & CH);
218 END IF;
219 GET (FT, CH);
220 IF CH /= '2' THEN
221 FAILED ("GET STOPPED AT WRONG POSITION - " &
222 "(7.5): CHAR IS " & CH);
223 END IF;
224 END IF;
225
226 SKIP_LINE (FT);
227
228 BEGIN
229 GET (FT, X, 7);
230 FAILED ("DATA_ERROR NOT RAISED - (8)");
231 EXCEPTION
232 WHEN DATA_ERROR =>
233 NULL;
234 WHEN OTHERS =>
235 FAILED ("WRONG EXCEPTION RAISED - (8)");
236 END;
237
238 SKIP_LINE (FT);
239
240 BEGIN
241 GET (FT, X);
242 FAILED ("DATA_ERROR NOT RAISED - (9)");
243 EXCEPTION
244 WHEN DATA_ERROR =>
245 NULL;
246 WHEN OTHERS =>
247 FAILED ("WRONG EXCEPTION RAISED - (9)");
248 END;
249
250 IF END_OF_LINE (FT) THEN
251 FAILED ("GET STOPPED AT END OF LINE - (9)");
252 ELSE
253 GET (FT, CH);
254 IF CH /= '_' THEN
255 FAILED ("GET STOPPED AT WRONG POSITION " &
256 "- (9): CHAR IS " & CH);
257 END IF;
258 GET (FT, CH);
259 IF CH /= '0' THEN
260 FAILED ("GET STOPPED AT WRONG POSITION " &
261 "- (9.5): CHAR IS " & CH);
262 END IF;
263 END IF;
264
265 SKIP_LINE (FT);
266 GET (FT, X);
267 IF X /= 99 THEN
268 FAILED ("GET WITH UNDERSCORE IN " &
269 "BASED LITERAL INCORRECT - (10)");
270 END IF;
271
272 SKIP_LINE (FT);
273
274 BEGIN
275 GET (FT, X);
276 FAILED ("DATA_ERROR NOT RAISED - (11)");
277 EXCEPTION
278 WHEN DATA_ERROR =>
279 NULL;
280 WHEN OTHERS =>
281 FAILED ("WRONG EXCEPTION RAISED - (11)");
282 END;
283
284 IF END_OF_LINE (FT) THEN
285 FAILED ("GET STOPPED AT END OF LINE - (11)");
286 ELSE
287 GET (FT, CH);
288 IF CH /= '_' THEN
289 FAILED ("GET STOPPED AT WRONG POSITION - " &
290 "(11): CHAR IS " & CH);
291 END IF;
292 GET (FT, CH);
293 IF CH /= '9' THEN
294 FAILED ("GET STOPPED AT WRONG POSITION - " &
295 "(11.5): CHAR IS " & CH);
296 END IF;
297 END IF;
298
299 SKIP_LINE (FT);
300
301 BEGIN
302 GET (FT, X, 6);
303 FAILED ("DATA_ERROR NOT RAISED - (12)");
304 EXCEPTION
305 WHEN DATA_ERROR =>
306 NULL;
307 WHEN OTHERS =>
308 FAILED ("WRONG EXCEPTION RAISED - (12)");
309 END;
310
311 SKIP_LINE (FT);
312 GET (FT, X, 7);
313 IF X /= 224 THEN
314 FAILED ("GET WITH GOOD CASE OF " &
315 "BASED LITERAL INCORRECT - (13)");
316 END IF;
317
318 SKIP_LINE (FT);
319 GET (FT, X, 10);
320 IF X /= (6 * 2 ** 11) THEN
321 FAILED ("GET WITH UNDERSCORE IN EXPONENT" &
322 "OF BASED LITERAL INCORRECT - (14)");
323 END IF;
324
325 SKIP_LINE (FT);
326
327 BEGIN
328 GET (FT, X);
329 FAILED ("DATA_ERROR NOT RAISED - (15)");
330 EXCEPTION
331 WHEN DATA_ERROR =>
332 NULL;
333 WHEN OTHERS =>
334 FAILED ("WRONG EXCEPTION RAISED - (15)");
335 END;
336
337 IF END_OF_LINE (FT) THEN
338 FAILED ("GET STOPPED AT END OF LINE - (15)");
339 ELSE
340 GET (FT, CH);
341 IF CH /= '_' THEN
342 FAILED ("GET STOPPED AT WRONG POSITION - " &
343 "(15): CHAR IS " & CH);
344 END IF;
345 GET (FT, CH);
346 IF CH /= '1' THEN
347 FAILED ("GET STOPPED AT WRONG POSITION - " &
348 "(15.5): CHAR IS " & CH);
349 END IF;
350 END IF;
351
352 BEGIN
353 DELETE (FT);
354 EXCEPTION
355 WHEN USE_ERROR =>
356 NULL;
357 END;
358 EXCEPTION
359 WHEN INCOMPLETE =>
360 NULL;
361 END;
362
363 RESULT;
364
365 END CE3704F;