File : par-tchk.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P A R . T C H K --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
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;