Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/par-ch9.adb @ 132:d34655255c78

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
update gcc-8.2
author mir3636
date Thu, 25 Oct 2018 10:21:07 +0900
parents 84e7813d76e9
children 1830386684a0
comparison
equal deleted inserted replaced
130:e108057fa461 132:d34655255c78
4 -- -- 4 -- --
5 -- P A R . C H 9 -- 5 -- P A R . C H 9 --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- 9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 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- -- 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- -- 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- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
99 99
100 if Token = Tok_Body then 100 if Token = Tok_Body then
101 Scan; -- past BODY 101 Scan; -- past BODY
102 Name_Node := P_Defining_Identifier (C_Is); 102 Name_Node := P_Defining_Identifier (C_Is);
103 Scope.Table (Scope.Last).Labl := Name_Node; 103 Scope.Table (Scope.Last).Labl := Name_Node;
104 Current_Node := Name_Node;
104 105
105 if Token = Tok_Left_Paren then 106 if Token = Tok_Left_Paren then
106 Error_Msg_SC ("discriminant part not allowed in task body"); 107 Error_Msg_SC ("discriminant part not allowed in task body");
107 Discard_Junk_List (P_Known_Discriminant_Part_Opt); 108 Discard_Junk_List (P_Known_Discriminant_Part_Opt);
108 end if; 109 end if;
166 Scan; -- past TYPE 167 Scan; -- past TYPE
167 Task_Node := New_Node (N_Task_Type_Declaration, Task_Sloc); 168 Task_Node := New_Node (N_Task_Type_Declaration, Task_Sloc);
168 Name_Node := P_Defining_Identifier; 169 Name_Node := P_Defining_Identifier;
169 Set_Defining_Identifier (Task_Node, Name_Node); 170 Set_Defining_Identifier (Task_Node, Name_Node);
170 Scope.Table (Scope.Last).Labl := Name_Node; 171 Scope.Table (Scope.Last).Labl := Name_Node;
172 Current_Node := Name_Node;
171 Set_Discriminant_Specifications 173 Set_Discriminant_Specifications
172 (Task_Node, P_Known_Discriminant_Part_Opt); 174 (Task_Node, P_Known_Discriminant_Part_Opt);
173 175
174 else 176 else
175 Task_Node := New_Node (N_Single_Task_Declaration, Task_Sloc); 177 Task_Node := New_Node (N_Single_Task_Declaration, Task_Sloc);
176 Name_Node := P_Defining_Identifier (C_Is); 178 Name_Node := P_Defining_Identifier (C_Is);
177 Set_Defining_Identifier (Task_Node, Name_Node); 179 Set_Defining_Identifier (Task_Node, Name_Node);
178 Scope.Table (Scope.Last).Labl := Name_Node; 180 Scope.Table (Scope.Last).Labl := Name_Node;
181 Current_Node := Name_Node;
179 182
180 if Token = Tok_Left_Paren then 183 if Token = Tok_Left_Paren then
181 Error_Msg_SC ("discriminant part not allowed for single task"); 184 Error_Msg_SC ("discriminant part not allowed for single task");
182 Discard_Junk_List (P_Known_Discriminant_Part_Opt); 185 Discard_Junk_List (P_Known_Discriminant_Part_Opt);
183 end if; 186 end if;
445 448
446 if Token = Tok_Body then 449 if Token = Tok_Body then
447 Scan; -- past BODY 450 Scan; -- past BODY
448 Name_Node := P_Defining_Identifier (C_Is); 451 Name_Node := P_Defining_Identifier (C_Is);
449 Scope.Table (Scope.Last).Labl := Name_Node; 452 Scope.Table (Scope.Last).Labl := Name_Node;
453 Current_Node := Name_Node;
450 454
451 if Token = Tok_Left_Paren then 455 if Token = Tok_Left_Paren then
452 Error_Msg_SC ("discriminant part not allowed in protected body"); 456 Error_Msg_SC ("discriminant part not allowed in protected body");
453 Discard_Junk_List (P_Known_Discriminant_Part_Opt); 457 Discard_Junk_List (P_Known_Discriminant_Part_Opt);
454 end if; 458 end if;
499 Protected_Node := 503 Protected_Node :=
500 New_Node (N_Protected_Type_Declaration, Protected_Sloc); 504 New_Node (N_Protected_Type_Declaration, Protected_Sloc);
501 Name_Node := P_Defining_Identifier (C_Is); 505 Name_Node := P_Defining_Identifier (C_Is);
502 Set_Defining_Identifier (Protected_Node, Name_Node); 506 Set_Defining_Identifier (Protected_Node, Name_Node);
503 Scope.Table (Scope.Last).Labl := Name_Node; 507 Scope.Table (Scope.Last).Labl := Name_Node;
508 Current_Node := Name_Node;
504 Set_Discriminant_Specifications 509 Set_Discriminant_Specifications
505 (Protected_Node, P_Known_Discriminant_Part_Opt); 510 (Protected_Node, P_Known_Discriminant_Part_Opt);
506 511
507 else 512 else
508 Protected_Node := 513 Protected_Node :=
515 ("discriminant part not allowed for single protected"); 520 ("discriminant part not allowed for single protected");
516 Discard_Junk_List (P_Known_Discriminant_Part_Opt); 521 Discard_Junk_List (P_Known_Discriminant_Part_Opt);
517 end if; 522 end if;
518 523
519 Scope.Table (Scope.Last).Labl := Name_Node; 524 Scope.Table (Scope.Last).Labl := Name_Node;
525 Current_Node := Name_Node;
520 end if; 526 end if;
521 527
522 P_Aspect_Specifications (Protected_Node, Semicolon => False); 528 P_Aspect_Specifications (Protected_Node, Semicolon => False);
523 529
524 -- Check for semicolon not followed by IS, this is something like 530 -- Check for semicolon not followed by IS, this is something like
774 end if; 780 end if;
775 781
776 return Decl; 782 return Decl;
777 end P_Entry_Or_Subprogram_With_Indicator; 783 end P_Entry_Or_Subprogram_With_Indicator;
778 784
785 Result : Node_Id := Empty;
786
779 -- Start of processing for P_Protected_Operation_Declaration_Opt 787 -- Start of processing for P_Protected_Operation_Declaration_Opt
780 788
781 begin 789 begin
782 -- This loop runs more than once only when a junk declaration 790 -- This loop runs more than once only when a junk declaration is skipped
783 -- is skipped.
784 791
785 loop 792 loop
786 if Token = Tok_Pragma then 793 case Token is
787 return P_Pragma; 794 when Tok_Pragma =>
788 795 Result := P_Pragma;
789 elsif Token = Tok_Not or else Token = Tok_Overriding then 796 exit;
790 return P_Entry_Or_Subprogram_With_Indicator; 797
791 798 when Tok_Not
792 elsif Token = Tok_Entry then 799 | Tok_Overriding
793 return P_Entry_Declaration; 800 =>
794 801 Result := P_Entry_Or_Subprogram_With_Indicator;
795 elsif Token = Tok_Function or else Token = Tok_Procedure then 802 exit;
796 return P_Subprogram (Pf_Decl_Pexp); 803
797 804 when Tok_Entry =>
798 elsif Token = Tok_Identifier then 805 Result := P_Entry_Declaration;
799 L := New_List; 806 exit;
800 P := Token_Ptr; 807
801 Skip_Declaration (L); 808 when Tok_Function
802 809 | Tok_Procedure
803 if Nkind (First (L)) = N_Object_Declaration then 810 =>
804 Error_Msg 811 Result := P_Subprogram (Pf_Decl_Pexp);
805 ("component must be declared in private part of " & 812 exit;
806 "protected type", P); 813
807 else 814 when Tok_Identifier =>
808 Error_Msg 815 L := New_List;
809 ("illegal declaration in protected definition", P); 816 P := Token_Ptr;
810 end if; 817 Skip_Declaration (L);
811 818
812 elsif Token in Token_Class_Declk then 819 if Nkind (First (L)) = N_Object_Declaration then
813 Error_Msg_SC ("illegal declaration in protected definition"); 820 Error_Msg
814 Resync_Past_Semicolon; 821 ("component must be declared in private part of " &
815 822 "protected type", P);
816 -- Return now to avoid cascaded messages if next declaration 823 else
817 -- is a valid component declaration. 824 Error_Msg
818 825 ("illegal declaration in protected definition", P);
819 return Error; 826 end if;
820 827 -- Continue looping
821 elsif Token = Tok_For then 828
822 Error_Msg_SC 829 when Tok_For =>
823 ("representation clause not allowed in protected definition"); 830 Error_Msg_SC
824 Resync_Past_Semicolon; 831 ("representation clause not allowed in protected definition");
825 832 Resync_Past_Semicolon;
826 else 833 -- Continue looping
827 return Empty; 834
828 end if; 835 when others =>
836 if Token in Token_Class_Declk then
837 Error_Msg_SC ("illegal declaration in protected definition");
838 Resync_Past_Semicolon;
839
840 -- Return now to avoid cascaded messages if next declaration
841 -- is a valid component declaration.
842
843 Result := Error;
844 end if;
845
846 exit;
847 end case;
829 end loop; 848 end loop;
849
850 if Nkind (Result) = N_Subprogram_Declaration
851 and then Nkind (Specification (Result)) =
852 N_Procedure_Specification
853 and then Null_Present (Specification (Result))
854 then
855 Error_Msg_N
856 ("protected operation cannot be a null procedure",
857 Null_Statement (Specification (Result)));
858 end if;
859
860 return Result;
830 end P_Protected_Operation_Declaration_Opt; 861 end P_Protected_Operation_Declaration_Opt;
831 862
832 ----------------------------------- 863 -----------------------------------
833 -- 9.4 Protected Operation Item -- 864 -- 9.4 Protected Operation Item --
834 ----------------------------------- 865 -----------------------------------
1047 Scope.Table (Scope.Last).Ecol := Start_Column; 1078 Scope.Table (Scope.Last).Ecol := Start_Column;
1048 1079
1049 Accept_Node := New_Node (N_Accept_Statement, Token_Ptr); 1080 Accept_Node := New_Node (N_Accept_Statement, Token_Ptr);
1050 Scan; -- past ACCEPT 1081 Scan; -- past ACCEPT
1051 Scope.Table (Scope.Last).Labl := Token_Node; 1082 Scope.Table (Scope.Last).Labl := Token_Node;
1083 Current_Node := Token_Node;
1052 1084
1053 Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do)); 1085 Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do));
1054 1086
1055 -- Left paren could be (Entry_Index) or Formal_Part, determine which 1087 -- Left paren could be (Entry_Index) or Formal_Part, determine which
1056 1088
1195 Scope.Table (Scope.Last).Sloc := Token_Ptr; 1227 Scope.Table (Scope.Last).Sloc := Token_Ptr;
1196 1228
1197 Name_Node := P_Defining_Identifier; 1229 Name_Node := P_Defining_Identifier;
1198 Set_Defining_Identifier (Entry_Node, Name_Node); 1230 Set_Defining_Identifier (Entry_Node, Name_Node);
1199 Scope.Table (Scope.Last).Labl := Name_Node; 1231 Scope.Table (Scope.Last).Labl := Name_Node;
1232 Current_Node := Name_Node;
1200 1233
1201 Formal_Part_Node := P_Entry_Body_Formal_Part; 1234 Formal_Part_Node := P_Entry_Body_Formal_Part;
1202 Set_Entry_Body_Formal_Part (Entry_Node, Formal_Part_Node); 1235 Set_Entry_Body_Formal_Part (Entry_Node, Formal_Part_Node);
1203 1236
1204 -- Ada 2012 (AI12-0169): Aspect specifications may appear on an entry 1237 -- Ada 2012 (AI12-0169): Aspect specifications may appear on an entry