|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- P A R . T C H K --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
11 -- GNAT is free software; you can redistribute it and/or modify it under --
|
|
|
12 -- terms of the GNU General Public License as published by the Free Soft- --
|
|
|
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
|
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
|
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
|
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
|
|
17 -- for more details. You should have received a copy of the GNU General --
|
|
|
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
|
|
|
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
|
|
|
20 -- --
|
|
|
21 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
23 -- --
|
|
|
24 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
26 -- Token scan routines
|
|
|
27
|
|
|
28 -- Error recovery: none of the T_xxx or TF_xxx routines raise Error_Resync
|
|
|
29
|
|
|
30 separate (Par)
|
|
|
31 package body Tchk is
|
|
|
32
|
|
|
33 type Position is (SC, BC, AP);
|
|
|
34 -- Specify position of error message (see Error_Msg_SC/BC/AP)
|
|
|
35
|
|
|
36 -----------------------
|
|
|
37 -- Local Subprograms --
|
|
|
38 -----------------------
|
|
|
39
|
|
|
40 procedure Check_Token (T : Token_Type; P : Position);
|
|
|
41 pragma Inline (Check_Token);
|
|
|
42 -- Called by T_xx routines to check for reserved keyword token. P is the
|
|
|
43 -- position of the error message if the token is missing (see Wrong_Token)
|
|
|
44
|
|
|
45 procedure Wrong_Token (T : Token_Type; P : Position);
|
|
|
46 -- Called when scanning a reserved keyword when the keyword is not present.
|
|
|
47 -- T is the token type for the keyword, and P indicates the position to be
|
|
|
48 -- used to place a message relative to the current token if the keyword is
|
|
|
49 -- not located nearby.
|
|
|
50
|
|
|
51 -----------------
|
|
|
52 -- Check_Token --
|
|
|
53 -----------------
|
|
|
54
|
|
|
55 procedure Check_Token (T : Token_Type; P : Position) is
|
|
|
56 begin
|
|
|
57 if Token = T then
|
|
|
58 Scan;
|
|
|
59 return;
|
|
|
60 else
|
|
|
61 Wrong_Token (T, P);
|
|
|
62 end if;
|
|
|
63 end Check_Token;
|
|
|
64
|
|
|
65 -------------
|
|
|
66 -- T_Abort --
|
|
|
67 -------------
|
|
|
68
|
|
|
69 procedure T_Abort is
|
|
|
70 begin
|
|
|
71 Check_Token (Tok_Abort, SC);
|
|
|
72 end T_Abort;
|
|
|
73
|
|
|
74 -------------
|
|
|
75 -- T_Arrow --
|
|
|
76 -------------
|
|
|
77
|
|
|
78 procedure T_Arrow is
|
|
|
79 begin
|
|
|
80 if Token = Tok_Arrow then
|
|
|
81 Scan;
|
|
|
82
|
|
|
83 -- A little recovery helper, accept then in place of =>
|
|
|
84
|
|
|
85 elsif Token = Tok_Then then
|
|
|
86 Error_Msg_BC -- CODEFIX
|
|
|
87 ("|THEN should be ""='>""");
|
|
|
88 Scan; -- past THEN used in place of =>
|
|
|
89
|
|
|
90 elsif Token = Tok_Colon_Equal then
|
|
|
91 Error_Msg_SC -- CODEFIX
|
|
|
92 ("|"":="" should be ""='>""");
|
|
|
93 Scan; -- past := used in place of =>
|
|
|
94
|
|
|
95 else
|
|
|
96 Error_Msg_AP -- CODEFIX
|
|
|
97 ("missing ""='>""");
|
|
|
98 end if;
|
|
|
99 end T_Arrow;
|
|
|
100
|
|
|
101 ----------
|
|
|
102 -- T_At --
|
|
|
103 ----------
|
|
|
104
|
|
|
105 procedure T_At is
|
|
|
106 begin
|
|
|
107 Check_Token (Tok_At, SC);
|
|
|
108 end T_At;
|
|
|
109
|
|
|
110 ------------
|
|
|
111 -- T_Body --
|
|
|
112 ------------
|
|
|
113
|
|
|
114 procedure T_Body is
|
|
|
115 begin
|
|
|
116 Check_Token (Tok_Body, BC);
|
|
|
117 end T_Body;
|
|
|
118
|
|
|
119 -----------
|
|
|
120 -- T_Box --
|
|
|
121 -----------
|
|
|
122
|
|
|
123 procedure T_Box is
|
|
|
124 begin
|
|
|
125 if Token = Tok_Box then
|
|
|
126 Scan;
|
|
|
127 else
|
|
|
128 Error_Msg_AP -- CODEFIX
|
|
|
129 ("missing ""'<'>""");
|
|
|
130 end if;
|
|
|
131 end T_Box;
|
|
|
132
|
|
|
133 -------------
|
|
|
134 -- T_Colon --
|
|
|
135 -------------
|
|
|
136
|
|
|
137 procedure T_Colon is
|
|
|
138 begin
|
|
|
139 if Token = Tok_Colon then
|
|
|
140 Scan;
|
|
|
141 else
|
|
|
142 Error_Msg_AP -- CODEFIX
|
|
|
143 ("missing "":""");
|
|
|
144 end if;
|
|
|
145 end T_Colon;
|
|
|
146
|
|
|
147 -------------------
|
|
|
148 -- T_Colon_Equal --
|
|
|
149 -------------------
|
|
|
150
|
|
|
151 procedure T_Colon_Equal is
|
|
|
152 begin
|
|
|
153 if Token = Tok_Colon_Equal then
|
|
|
154 Scan;
|
|
|
155
|
|
|
156 elsif Token = Tok_Equal then
|
|
|
157 Error_Msg_SC -- CODEFIX
|
|
|
158 ("|""="" should be "":=""");
|
|
|
159 Scan;
|
|
|
160
|
|
|
161 elsif Token = Tok_Colon then
|
|
|
162 Error_Msg_SC -- CODEFIX
|
|
|
163 ("|"":"" should be "":=""");
|
|
|
164 Scan;
|
|
|
165
|
|
|
166 elsif Token = Tok_Is then
|
|
|
167 Error_Msg_SC -- CODEFIX
|
|
|
168 ("|IS should be "":=""");
|
|
|
169 Scan;
|
|
|
170
|
|
|
171 else
|
|
|
172 Error_Msg_AP -- CODEFIX
|
|
|
173 ("missing "":=""");
|
|
|
174 end if;
|
|
|
175 end T_Colon_Equal;
|
|
|
176
|
|
|
177 -------------
|
|
|
178 -- T_Comma --
|
|
|
179 -------------
|
|
|
180
|
|
|
181 procedure T_Comma is
|
|
|
182 begin
|
|
|
183 if Token = Tok_Comma then
|
|
|
184 Scan;
|
|
|
185
|
|
|
186 else
|
|
|
187 if Token = Tok_Pragma then
|
|
|
188 P_Pragmas_Misplaced;
|
|
|
189 end if;
|
|
|
190
|
|
|
191 if Token = Tok_Comma then
|
|
|
192 Scan;
|
|
|
193 else
|
|
|
194 Error_Msg_AP -- CODEFIX
|
|
|
195 ("missing "",""");
|
|
|
196 end if;
|
|
|
197 end if;
|
|
|
198
|
|
|
199 if Token = Tok_Pragma then
|
|
|
200 P_Pragmas_Misplaced;
|
|
|
201 end if;
|
|
|
202 end T_Comma;
|
|
|
203
|
|
|
204 ---------------
|
|
|
205 -- T_Dot_Dot --
|
|
|
206 ---------------
|
|
|
207
|
|
|
208 procedure T_Dot_Dot is
|
|
|
209 begin
|
|
|
210 if Token = Tok_Dot_Dot then
|
|
|
211 Scan;
|
|
|
212 else
|
|
|
213 Error_Msg_AP -- CODEFIX
|
|
|
214 ("missing ""..""");
|
|
|
215 end if;
|
|
|
216 end T_Dot_Dot;
|
|
|
217
|
|
|
218 -----------
|
|
|
219 -- T_For --
|
|
|
220 -----------
|
|
|
221
|
|
|
222 procedure T_For is
|
|
|
223 begin
|
|
|
224 Check_Token (Tok_For, AP);
|
|
|
225 end T_For;
|
|
|
226
|
|
|
227 -----------------------
|
|
|
228 -- T_Greater_Greater --
|
|
|
229 -----------------------
|
|
|
230
|
|
|
231 procedure T_Greater_Greater is
|
|
|
232 begin
|
|
|
233 if Token = Tok_Greater_Greater then
|
|
|
234 Scan;
|
|
|
235 else
|
|
|
236 Error_Msg_AP -- CODEFIX
|
|
|
237 ("missing ""'>'>""");
|
|
|
238 end if;
|
|
|
239 end T_Greater_Greater;
|
|
|
240
|
|
|
241 ------------------
|
|
|
242 -- T_Identifier --
|
|
|
243 ------------------
|
|
|
244
|
|
|
245 procedure T_Identifier is
|
|
|
246 begin
|
|
|
247 if Token = Tok_Identifier then
|
|
|
248 Scan;
|
|
|
249 elsif Token in Token_Class_Literal then
|
|
|
250 Error_Msg_SC ("identifier expected");
|
|
|
251 Scan;
|
|
|
252 else
|
|
|
253 Error_Msg_AP ("identifier expected");
|
|
|
254 end if;
|
|
|
255 end T_Identifier;
|
|
|
256
|
|
|
257 ----------
|
|
|
258 -- T_In --
|
|
|
259 ----------
|
|
|
260
|
|
|
261 procedure T_In is
|
|
|
262 begin
|
|
|
263 Check_Token (Tok_In, AP);
|
|
|
264 end T_In;
|
|
|
265
|
|
|
266 ----------
|
|
|
267 -- T_Is --
|
|
|
268 ----------
|
|
|
269
|
|
|
270 procedure T_Is is
|
|
|
271 begin
|
|
|
272 Ignore (Tok_Semicolon);
|
|
|
273
|
|
|
274 -- If we have IS scan past it
|
|
|
275
|
|
|
276 if Token = Tok_Is then
|
|
|
277 Scan;
|
|
|
278
|
|
|
279 -- And ignore any following semicolons
|
|
|
280
|
|
|
281 Ignore (Tok_Semicolon);
|
|
|
282
|
|
|
283 -- Allow OF, => or = to substitute for IS with complaint
|
|
|
284
|
|
|
285 elsif Token = Tok_Arrow then
|
|
|
286 Error_Msg_SC -- CODEFIX
|
|
|
287 ("|""=>"" should be IS");
|
|
|
288 Scan; -- past =>
|
|
|
289
|
|
|
290 elsif Token = Tok_Of then
|
|
|
291 Error_Msg_SC -- CODEFIX
|
|
|
292 ("|OF should be IS");
|
|
|
293 Scan; -- past OF
|
|
|
294
|
|
|
295 elsif Token = Tok_Equal then
|
|
|
296 Error_Msg_SC -- CODEFIX
|
|
|
297 ("|""="" should be IS");
|
|
|
298 Scan; -- past =
|
|
|
299
|
|
|
300 else
|
|
|
301 Wrong_Token (Tok_Is, AP);
|
|
|
302 end if;
|
|
|
303
|
|
|
304 -- Ignore extra IS keywords
|
|
|
305
|
|
|
306 while Token = Tok_Is loop
|
|
|
307 Error_Msg_SC -- CODEFIX
|
|
|
308 ("|extra IS ignored");
|
|
|
309 Scan;
|
|
|
310 end loop;
|
|
|
311 end T_Is;
|
|
|
312
|
|
|
313 ------------------
|
|
|
314 -- T_Left_Paren --
|
|
|
315 ------------------
|
|
|
316
|
|
|
317 procedure T_Left_Paren is
|
|
|
318 begin
|
|
|
319 if Token = Tok_Left_Paren then
|
|
|
320 Scan;
|
|
|
321 else
|
|
|
322 Error_Msg_AP -- CODEFIX
|
|
|
323 ("missing ""(""");
|
|
|
324 end if;
|
|
|
325 end T_Left_Paren;
|
|
|
326
|
|
|
327 ------------
|
|
|
328 -- T_Loop --
|
|
|
329 ------------
|
|
|
330
|
|
|
331 procedure T_Loop is
|
|
|
332 begin
|
|
|
333 if Token = Tok_Do then
|
|
|
334 Error_Msg_SC -- CODEFIX
|
|
|
335 ("LOOP expected");
|
|
|
336 Scan;
|
|
|
337 else
|
|
|
338 Check_Token (Tok_Loop, AP);
|
|
|
339 end if;
|
|
|
340 end T_Loop;
|
|
|
341
|
|
|
342 -----------
|
|
|
343 -- T_Mod --
|
|
|
344 -----------
|
|
|
345
|
|
|
346 procedure T_Mod is
|
|
|
347 begin
|
|
|
348 Check_Token (Tok_Mod, AP);
|
|
|
349 end T_Mod;
|
|
|
350
|
|
|
351 -----------
|
|
|
352 -- T_New --
|
|
|
353 -----------
|
|
|
354
|
|
|
355 procedure T_New is
|
|
|
356 begin
|
|
|
357 Check_Token (Tok_New, AP);
|
|
|
358 end T_New;
|
|
|
359
|
|
|
360 ----------
|
|
|
361 -- T_Of --
|
|
|
362 ----------
|
|
|
363
|
|
|
364 procedure T_Of is
|
|
|
365 begin
|
|
|
366 Check_Token (Tok_Of, AP);
|
|
|
367 end T_Of;
|
|
|
368
|
|
|
369 ----------
|
|
|
370 -- T_Or --
|
|
|
371 ----------
|
|
|
372
|
|
|
373 procedure T_Or is
|
|
|
374 begin
|
|
|
375 Check_Token (Tok_Or, AP);
|
|
|
376 end T_Or;
|
|
|
377
|
|
|
378 ---------------
|
|
|
379 -- T_Private --
|
|
|
380 ---------------
|
|
|
381
|
|
|
382 procedure T_Private is
|
|
|
383 begin
|
|
|
384 Check_Token (Tok_Private, SC);
|
|
|
385 end T_Private;
|
|
|
386
|
|
|
387 -------------
|
|
|
388 -- T_Range --
|
|
|
389 -------------
|
|
|
390
|
|
|
391 procedure T_Range is
|
|
|
392 begin
|
|
|
393 Check_Token (Tok_Range, AP);
|
|
|
394 end T_Range;
|
|
|
395
|
|
|
396 --------------
|
|
|
397 -- T_Record --
|
|
|
398 --------------
|
|
|
399
|
|
|
400 procedure T_Record is
|
|
|
401 begin
|
|
|
402 Check_Token (Tok_Record, AP);
|
|
|
403 end T_Record;
|
|
|
404
|
|
|
405 -------------------
|
|
|
406 -- T_Right_Paren --
|
|
|
407 -------------------
|
|
|
408
|
|
|
409 procedure T_Right_Paren is
|
|
|
410 begin
|
|
|
411 if Token = Tok_Right_Paren then
|
|
|
412 Scan;
|
|
|
413 else
|
|
|
414 Error_Msg_AP -- CODEFIX
|
|
|
415 ("|missing "")""");
|
|
|
416 end if;
|
|
|
417 end T_Right_Paren;
|
|
|
418
|
|
|
419 -----------------
|
|
|
420 -- T_Semicolon --
|
|
|
421 -----------------
|
|
|
422
|
|
|
423 procedure T_Semicolon is
|
|
|
424 begin
|
|
|
425
|
|
|
426 if Token = Tok_Semicolon then
|
|
|
427 Scan;
|
|
|
428
|
|
|
429 if Token = Tok_Semicolon then
|
|
|
430 Error_Msg_SC -- CODEFIX
|
|
|
431 ("|extra "";"" ignored");
|
|
|
432 Scan;
|
|
|
433 end if;
|
|
|
434
|
|
|
435 return;
|
|
|
436
|
|
|
437 elsif Token = Tok_Colon then
|
|
|
438 Error_Msg_SC -- CODEFIX
|
|
|
439 ("|"":"" should be "";""");
|
|
|
440 Scan;
|
|
|
441 return;
|
|
|
442
|
|
|
443 elsif Token = Tok_Comma then
|
|
|
444 Error_Msg_SC -- CODEFIX
|
|
|
445 ("|"","" should be "";""");
|
|
|
446 Scan;
|
|
|
447 return;
|
|
|
448
|
|
|
449 elsif Token = Tok_Dot then
|
|
|
450 Error_Msg_SC -- CODEFIX
|
|
|
451 ("|""."" should be "";""");
|
|
|
452 Scan;
|
|
|
453 return;
|
|
|
454
|
|
|
455 -- An interesting little case. If the previous token is a semicolon,
|
|
|
456 -- then there is no way that we can legitimately need another semicolon.
|
|
|
457 -- This could only arise in an situation where an error has already been
|
|
|
458 -- signalled. By simply ignoring the request for a semicolon in this
|
|
|
459 -- case, we avoid some spurious missing semicolon messages.
|
|
|
460
|
|
|
461 elsif Prev_Token = Tok_Semicolon then
|
|
|
462 return;
|
|
|
463
|
|
|
464 -- If the current token is | then this is a reasonable place to suggest
|
|
|
465 -- the possibility of a "C" confusion.
|
|
|
466
|
|
|
467 elsif Token = Tok_Vertical_Bar then
|
|
|
468 Error_Msg_SC -- CODEFIX
|
|
|
469 ("unexpected occurrence of ""'|"", did you mean OR'?");
|
|
|
470 Resync_Past_Semicolon;
|
|
|
471 return;
|
|
|
472
|
|
|
473 -- Deal with pragma. If pragma is not at start of line, it is considered
|
|
|
474 -- misplaced otherwise we treat it as a normal missing semicolon case.
|
|
|
475
|
|
|
476 elsif Token = Tok_Pragma and then not Token_Is_At_Start_Of_Line then
|
|
|
477 P_Pragmas_Misplaced;
|
|
|
478
|
|
|
479 if Token = Tok_Semicolon then
|
|
|
480 Scan;
|
|
|
481 return;
|
|
|
482 end if;
|
|
|
483 end if;
|
|
|
484
|
|
|
485 -- If none of those tests return, we really have a missing semicolon
|
|
|
486
|
|
|
487 Error_Msg_AP -- CODEFIX
|
|
|
488 ("|missing "";""");
|
|
|
489 return;
|
|
|
490 end T_Semicolon;
|
|
|
491
|
|
|
492 ------------
|
|
|
493 -- T_Then --
|
|
|
494 ------------
|
|
|
495
|
|
|
496 procedure T_Then is
|
|
|
497 begin
|
|
|
498 Check_Token (Tok_Then, AP);
|
|
|
499 end T_Then;
|
|
|
500
|
|
|
501 ------------
|
|
|
502 -- T_Type --
|
|
|
503 ------------
|
|
|
504
|
|
|
505 procedure T_Type is
|
|
|
506 begin
|
|
|
507 Check_Token (Tok_Type, BC);
|
|
|
508 end T_Type;
|
|
|
509
|
|
|
510 -----------
|
|
|
511 -- T_Use --
|
|
|
512 -----------
|
|
|
513
|
|
|
514 procedure T_Use is
|
|
|
515 begin
|
|
|
516 Check_Token (Tok_Use, SC);
|
|
|
517 end T_Use;
|
|
|
518
|
|
|
519 ------------
|
|
|
520 -- T_When --
|
|
|
521 ------------
|
|
|
522
|
|
|
523 procedure T_When is
|
|
|
524 begin
|
|
|
525 Check_Token (Tok_When, SC);
|
|
|
526 end T_When;
|
|
|
527
|
|
|
528 ------------
|
|
|
529 -- T_With --
|
|
|
530 ------------
|
|
|
531
|
|
|
532 procedure T_With is
|
|
|
533 begin
|
|
|
534 Check_Token (Tok_With, BC);
|
|
|
535 end T_With;
|
|
|
536
|
|
|
537 --------------
|
|
|
538 -- TF_Arrow --
|
|
|
539 --------------
|
|
|
540
|
|
|
541 procedure TF_Arrow is
|
|
|
542 Scan_State : Saved_Scan_State;
|
|
|
543
|
|
|
544 begin
|
|
|
545 if Token = Tok_Arrow then
|
|
|
546 Scan; -- skip arrow and we are done
|
|
|
547
|
|
|
548 elsif Token = Tok_Colon_Equal then
|
|
|
549 T_Arrow; -- Let T_Arrow give the message
|
|
|
550
|
|
|
551 else
|
|
|
552 T_Arrow; -- give missing arrow message
|
|
|
553 Save_Scan_State (Scan_State); -- at start of junk tokens
|
|
|
554
|
|
|
555 loop
|
|
|
556 if Prev_Token_Ptr < Current_Line_Start
|
|
|
557 or else Token = Tok_Semicolon
|
|
|
558 or else Token = Tok_EOF
|
|
|
559 then
|
|
|
560 Restore_Scan_State (Scan_State); -- to where we were
|
|
|
561 return;
|
|
|
562 end if;
|
|
|
563
|
|
|
564 Scan; -- continue search
|
|
|
565
|
|
|
566 if Token = Tok_Arrow then
|
|
|
567 Scan; -- past arrow
|
|
|
568 return;
|
|
|
569 end if;
|
|
|
570 end loop;
|
|
|
571 end if;
|
|
|
572 end TF_Arrow;
|
|
|
573
|
|
|
574 -----------
|
|
|
575 -- TF_Is --
|
|
|
576 -----------
|
|
|
577
|
|
|
578 procedure TF_Is is
|
|
|
579 Scan_State : Saved_Scan_State;
|
|
|
580
|
|
|
581 begin
|
|
|
582 if Token = Tok_Is then
|
|
|
583 T_Is; -- past IS and we are done
|
|
|
584
|
|
|
585 -- Allow OF or => or = in place of IS (with error message)
|
|
|
586
|
|
|
587 elsif Token = Tok_Of
|
|
|
588 or else Token = Tok_Arrow
|
|
|
589 or else Token = Tok_Equal
|
|
|
590 then
|
|
|
591 T_Is; -- give missing IS message and skip bad token
|
|
|
592
|
|
|
593 else
|
|
|
594 T_Is; -- give missing IS message
|
|
|
595 Save_Scan_State (Scan_State); -- at start of junk tokens
|
|
|
596
|
|
|
597 loop
|
|
|
598 if Prev_Token_Ptr < Current_Line_Start
|
|
|
599 or else Token = Tok_Semicolon
|
|
|
600 or else Token = Tok_EOF
|
|
|
601 then
|
|
|
602 Restore_Scan_State (Scan_State); -- to where we were
|
|
|
603 return;
|
|
|
604 end if;
|
|
|
605
|
|
|
606 Scan; -- continue search
|
|
|
607
|
|
|
608 if Token = Tok_Is
|
|
|
609 or else Token = Tok_Of
|
|
|
610 or else Token = Tok_Arrow
|
|
|
611 then
|
|
|
612 Scan; -- past IS or OF or =>
|
|
|
613 return;
|
|
|
614 end if;
|
|
|
615 end loop;
|
|
|
616 end if;
|
|
|
617 end TF_Is;
|
|
|
618
|
|
|
619 -------------
|
|
|
620 -- TF_Loop --
|
|
|
621 -------------
|
|
|
622
|
|
|
623 procedure TF_Loop is
|
|
|
624 Scan_State : Saved_Scan_State;
|
|
|
625
|
|
|
626 begin
|
|
|
627 if Token = Tok_Loop then
|
|
|
628 Scan; -- past LOOP and we are done
|
|
|
629
|
|
|
630 -- Allow DO or THEN in place of LOOP
|
|
|
631
|
|
|
632 elsif Token = Tok_Then or else Token = Tok_Do then
|
|
|
633 T_Loop; -- give missing LOOP message
|
|
|
634
|
|
|
635 else
|
|
|
636 T_Loop; -- give missing LOOP message
|
|
|
637 Save_Scan_State (Scan_State); -- at start of junk tokens
|
|
|
638
|
|
|
639 loop
|
|
|
640 if Prev_Token_Ptr < Current_Line_Start
|
|
|
641 or else Token = Tok_Semicolon
|
|
|
642 or else Token = Tok_EOF
|
|
|
643 then
|
|
|
644 Restore_Scan_State (Scan_State); -- to where we were
|
|
|
645 return;
|
|
|
646 end if;
|
|
|
647
|
|
|
648 Scan; -- continue search
|
|
|
649
|
|
|
650 if Token = Tok_Loop or else Token = Tok_Then then
|
|
|
651 Scan; -- past loop or then (message already generated)
|
|
|
652 return;
|
|
|
653 end if;
|
|
|
654 end loop;
|
|
|
655 end if;
|
|
|
656 end TF_Loop;
|
|
|
657
|
|
|
658 --------------
|
|
|
659 -- TF_Return--
|
|
|
660 --------------
|
|
|
661
|
|
|
662 procedure TF_Return is
|
|
|
663 Scan_State : Saved_Scan_State;
|
|
|
664
|
|
|
665 begin
|
|
|
666 if Token = Tok_Return then
|
|
|
667 Scan; -- skip RETURN and we are done
|
|
|
668
|
|
|
669 else
|
|
|
670 Error_Msg_SC -- CODEFIX
|
|
|
671 ("missing RETURN");
|
|
|
672 Save_Scan_State (Scan_State); -- at start of junk tokens
|
|
|
673
|
|
|
674 loop
|
|
|
675 if Prev_Token_Ptr < Current_Line_Start
|
|
|
676 or else Token = Tok_Semicolon
|
|
|
677 or else Token = Tok_EOF
|
|
|
678 then
|
|
|
679 Restore_Scan_State (Scan_State); -- to where we were
|
|
|
680 return;
|
|
|
681 end if;
|
|
|
682
|
|
|
683 Scan; -- continue search
|
|
|
684
|
|
|
685 if Token = Tok_Return then
|
|
|
686 Scan; -- past RETURN
|
|
|
687 return;
|
|
|
688 end if;
|
|
|
689 end loop;
|
|
|
690 end if;
|
|
|
691 end TF_Return;
|
|
|
692
|
|
|
693 ------------------
|
|
|
694 -- TF_Semicolon --
|
|
|
695 ------------------
|
|
|
696
|
|
|
697 procedure TF_Semicolon is
|
|
|
698 Scan_State : Saved_Scan_State;
|
|
|
699
|
|
|
700 begin
|
|
|
701 if Token = Tok_Semicolon then
|
|
|
702 T_Semicolon;
|
|
|
703 return;
|
|
|
704
|
|
|
705 -- An interesting little test here. If the previous token is a
|
|
|
706 -- semicolon, then there is no way that we can legitimately need
|
|
|
707 -- another semicolon. This could only arise in an error situation
|
|
|
708 -- where an error has already been signalled. By simply ignoring
|
|
|
709 -- the request for a semicolon in this case, we avoid some spurious
|
|
|
710 -- missing semicolon messages.
|
|
|
711
|
|
|
712 elsif Prev_Token = Tok_Semicolon then
|
|
|
713 return;
|
|
|
714
|
|
|
715 else
|
|
|
716 -- Deal with pragma. If pragma is not at start of line, it is
|
|
|
717 -- considered misplaced otherwise we treat it as a normal
|
|
|
718 -- missing semicolon case.
|
|
|
719
|
|
|
720 if Token = Tok_Pragma
|
|
|
721 and then not Token_Is_At_Start_Of_Line
|
|
|
722 then
|
|
|
723 P_Pragmas_Misplaced;
|
|
|
724
|
|
|
725 if Token = Tok_Semicolon then
|
|
|
726 T_Semicolon;
|
|
|
727 return;
|
|
|
728 end if;
|
|
|
729 end if;
|
|
|
730
|
|
|
731 -- Here we definitely have a missing semicolon, so give message
|
|
|
732
|
|
|
733 T_Semicolon;
|
|
|
734
|
|
|
735 -- Scan out junk on rest of line. Scan stops on END keyword, since
|
|
|
736 -- that seems to help avoid cascaded errors.
|
|
|
737
|
|
|
738 Save_Scan_State (Scan_State); -- at start of junk tokens
|
|
|
739
|
|
|
740 loop
|
|
|
741 if Prev_Token_Ptr < Current_Line_Start
|
|
|
742 or else Token = Tok_EOF
|
|
|
743 or else Token = Tok_End
|
|
|
744 then
|
|
|
745 Restore_Scan_State (Scan_State); -- to where we were
|
|
|
746 return;
|
|
|
747 end if;
|
|
|
748
|
|
|
749 Scan; -- continue search
|
|
|
750
|
|
|
751 if Token = Tok_Semicolon then
|
|
|
752 T_Semicolon;
|
|
|
753 return;
|
|
|
754
|
|
|
755 elsif Token in Token_Class_After_SM then
|
|
|
756 return;
|
|
|
757 end if;
|
|
|
758 end loop;
|
|
|
759 end if;
|
|
|
760 end TF_Semicolon;
|
|
|
761
|
|
|
762 -------------
|
|
|
763 -- TF_Then --
|
|
|
764 -------------
|
|
|
765
|
|
|
766 procedure TF_Then is
|
|
|
767 Scan_State : Saved_Scan_State;
|
|
|
768
|
|
|
769 begin
|
|
|
770 if Token = Tok_Then then
|
|
|
771 Scan; -- past THEN and we are done
|
|
|
772
|
|
|
773 else
|
|
|
774 T_Then; -- give missing THEN message
|
|
|
775 Save_Scan_State (Scan_State); -- at start of junk tokens
|
|
|
776
|
|
|
777 loop
|
|
|
778 if Prev_Token_Ptr < Current_Line_Start
|
|
|
779 or else Token = Tok_Semicolon
|
|
|
780 or else Token = Tok_EOF
|
|
|
781 then
|
|
|
782 Restore_Scan_State (Scan_State); -- to where we were
|
|
|
783 return;
|
|
|
784 end if;
|
|
|
785
|
|
|
786 Scan; -- continue search
|
|
|
787
|
|
|
788 if Token = Tok_Then then
|
|
|
789 Scan; -- past THEN
|
|
|
790 return;
|
|
|
791 end if;
|
|
|
792 end loop;
|
|
|
793 end if;
|
|
|
794 end TF_Then;
|
|
|
795
|
|
|
796 ------------
|
|
|
797 -- TF_Use --
|
|
|
798 ------------
|
|
|
799
|
|
|
800 procedure TF_Use is
|
|
|
801 Scan_State : Saved_Scan_State;
|
|
|
802
|
|
|
803 begin
|
|
|
804 if Token = Tok_Use then
|
|
|
805 Scan; -- past USE and we are done
|
|
|
806
|
|
|
807 else
|
|
|
808 T_Use; -- give USE expected message
|
|
|
809 Save_Scan_State (Scan_State); -- at start of junk tokens
|
|
|
810
|
|
|
811 loop
|
|
|
812 if Prev_Token_Ptr < Current_Line_Start
|
|
|
813 or else Token = Tok_Semicolon
|
|
|
814 or else Token = Tok_EOF
|
|
|
815 then
|
|
|
816 Restore_Scan_State (Scan_State); -- to where we were
|
|
|
817 return;
|
|
|
818 end if;
|
|
|
819
|
|
|
820 Scan; -- continue search
|
|
|
821
|
|
|
822 if Token = Tok_Use then
|
|
|
823 Scan; -- past use
|
|
|
824 return;
|
|
|
825 end if;
|
|
|
826 end loop;
|
|
|
827 end if;
|
|
|
828 end TF_Use;
|
|
|
829
|
|
|
830 ------------------
|
|
|
831 -- U_Left_Paren --
|
|
|
832 ------------------
|
|
|
833
|
|
|
834 procedure U_Left_Paren is
|
|
|
835 begin
|
|
|
836 if Token = Tok_Left_Paren then
|
|
|
837 Scan;
|
|
|
838 else
|
|
|
839 Error_Msg_AP -- CODEFIX
|
|
|
840 ("missing ""(""!");
|
|
|
841 end if;
|
|
|
842 end U_Left_Paren;
|
|
|
843
|
|
|
844 -------------------
|
|
|
845 -- U_Right_Paren --
|
|
|
846 -------------------
|
|
|
847
|
|
|
848 procedure U_Right_Paren is
|
|
|
849 begin
|
|
|
850 if Token = Tok_Right_Paren then
|
|
|
851 Scan;
|
|
|
852 else
|
|
|
853 Error_Msg_AP -- CODEFIX
|
|
|
854 ("|missing "")""!");
|
|
|
855 end if;
|
|
|
856 end U_Right_Paren;
|
|
|
857
|
|
|
858 -----------------
|
|
|
859 -- Wrong_Token --
|
|
|
860 -----------------
|
|
|
861
|
|
|
862 procedure Wrong_Token (T : Token_Type; P : Position) is
|
|
|
863 Missing : constant String := "missing ";
|
|
|
864 Image : constant String := Token_Type'Image (T);
|
|
|
865 Tok_Name : constant String := Image (5 .. Image'Length);
|
|
|
866 M : constant String := Missing & Tok_Name;
|
|
|
867
|
|
|
868 begin
|
|
|
869 if Token = Tok_Semicolon then
|
|
|
870 Scan;
|
|
|
871
|
|
|
872 if Token = T then
|
|
|
873 Error_Msg_SP -- CODEFIX
|
|
|
874 ("|extra "";"" ignored");
|
|
|
875 Scan;
|
|
|
876 else
|
|
|
877 Error_Msg_SP (M);
|
|
|
878 end if;
|
|
|
879
|
|
|
880 elsif Token = Tok_Comma then
|
|
|
881 Scan;
|
|
|
882
|
|
|
883 if Token = T then
|
|
|
884 Error_Msg_SP -- CODEFIX
|
|
|
885 ("|extra "","" ignored");
|
|
|
886 Scan;
|
|
|
887
|
|
|
888 else
|
|
|
889 Error_Msg_SP (M);
|
|
|
890 end if;
|
|
|
891
|
|
|
892 else
|
|
|
893 case P is
|
|
|
894 when SC => Error_Msg_SC (M);
|
|
|
895 when BC => Error_Msg_BC (M);
|
|
|
896 when AP => Error_Msg_AP (M);
|
|
|
897 end case;
|
|
|
898 end if;
|
|
|
899 end Wrong_Token;
|
|
|
900
|
|
|
901 end Tchk;
|
