OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [par-tchk.adb] - Blame information for rev 414

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.