Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/par-endh.adb @ 145:1830386684a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
4 -- -- 4 -- --
5 -- P A R . E N D H -- 5 -- P A R . E N D H --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- 9 -- Copyright (C) 1992-2019, 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- --
178 -- following line. 178 -- following line.
179 179
180 Name_Scan_State : Saved_Scan_State; 180 Name_Scan_State : Saved_Scan_State;
181 -- Save state at start of name if Name_On_Separate_Line is TRUE 181 -- Save state at start of name if Name_On_Separate_Line is TRUE
182 182
183 Span_Node : constant Node_Id := Scope.Table (Scope.Last).Node; 183 Span_Node : constant Node_Id := Scopes (Scope.Last).Node;
184 184
185 begin 185 begin
186 End_Labl_Present := False; 186 End_Labl_Present := False;
187 End_Labl := Empty; 187 End_Labl := Empty;
188 188
282 -- apparent name is on a separate line, we accept it only if 282 -- apparent name is on a separate line, we accept it only if
283 -- it matches the label and is followed by a semicolon. 283 -- it matches the label and is followed by a semicolon.
284 284
285 if Name_On_Separate_Line then 285 if Name_On_Separate_Line then
286 if Token /= Tok_Semicolon or else 286 if Token /= Tok_Semicolon or else
287 not Same_Label (End_Labl, Scope.Table (Scope.Last).Labl) 287 not Same_Label (End_Labl, Scopes (Scope.Last).Labl)
288 then 288 then
289 Restore_Scan_State (Name_Scan_State); 289 Restore_Scan_State (Name_Scan_State);
290 End_Labl := Empty; 290 End_Labl := Empty;
291 End_Labl_Present := False; 291 End_Labl_Present := False;
292 end if; 292 end if;
295 -- Here for case of name allowed, but no name present. We will 295 -- Here for case of name allowed, but no name present. We will
296 -- supply an implicit matching name, with source location set 296 -- supply an implicit matching name, with source location set
297 -- to the scan location past the END token. 297 -- to the scan location past the END token.
298 298
299 else 299 else
300 End_Labl := Scope.Table (Scope.Last).Labl; 300 End_Labl := Scopes (Scope.Last).Labl;
301 301
302 if End_Labl > Empty_Or_Error then 302 if End_Labl > Empty_Or_Error then
303 303
304 -- The task here is to construct a designator from the 304 -- The task here is to construct a designator from the
305 -- opening label, with the components all marked as not 305 -- opening label, with the components all marked as not
380 -- independently. 380 -- independently.
381 381
382 if Style_Check 382 if Style_Check
383 and then End_Type = E_Name 383 and then End_Type = E_Name
384 and then Explicit_Start_Label (Scope.Last) 384 and then Explicit_Start_Label (Scope.Last)
385 and then Nkind (Parent (Scope.Table (Scope.Last).Labl)) 385 and then Nkind (Parent (Scopes (Scope.Last).Labl))
386 /= N_Block_Statement 386 /= N_Block_Statement
387 then 387 then
388 Style.No_End_Name (Scope.Table (Scope.Last).Labl); 388 Style.No_End_Name (Scopes (Scope.Last).Labl);
389 end if; 389 end if;
390 end if; 390 end if;
391 end if; 391 end if;
392 end if; 392 end if;
393 393
708 ------------------------ 708 ------------------------
709 -- Evaluate End Entry -- 709 -- Evaluate End Entry --
710 ------------------------ 710 ------------------------
711 711
712 procedure Evaluate_End_Entry (SS_Index : Nat) is 712 procedure Evaluate_End_Entry (SS_Index : Nat) is
713 STE : Scope_Table_Entry renames Scope.Table (SS_Index); 713 STE : Scope_Table_Entry renames Scopes (SS_Index).all;
714 714
715 begin 715 begin
716 Column_OK := (End_Column = STE.Ecol); 716 Column_OK := (End_Column = STE.Ecol);
717 717
718 Token_OK := (End_Type = STE.Etyp 718 Token_OK := (End_Type = STE.Etyp
739 -- My_Label on the end line, and the generated name for the scope). Also 739 -- My_Label on the end line, and the generated name for the scope). Also
740 -- End_Labl_Present will be True. 740 -- End_Labl_Present will be True.
741 741
742 if not Label_OK 742 if not Label_OK
743 and then End_Labl_Present 743 and then End_Labl_Present
744 and then not Comes_From_Source (Scope.Table (SS_Index).Labl) 744 and then not Comes_From_Source (Scopes (SS_Index).Labl)
745 then 745 then
746 -- Here is where we will search the suspicious labels table 746 -- Here is where we will search the suspicious labels table
747 747
748 for J in 1 .. Suspicious_Labels.Last loop 748 for J in 1 .. Suspicious_Labels.Last loop
749 declare 749 declare
790 elsif End_Labl_Present then 790 elsif End_Labl_Present then
791 791
792 -- If probably misspelling, then complain, and pretend it is OK 792 -- If probably misspelling, then complain, and pretend it is OK
793 793
794 declare 794 declare
795 Nam : constant Node_Or_Entity_Id := Scope.Table (SS_Index).Labl; 795 Nam : constant Node_Or_Entity_Id := Scopes (SS_Index).Labl;
796 796
797 begin 797 begin
798 if Nkind (End_Labl) in N_Has_Chars 798 if Nkind (End_Labl) in N_Has_Chars
799 and then Comes_From_Source (Nam) 799 and then Comes_From_Source (Nam)
800 and then Nkind (Nam) in N_Has_Chars 800 and then Nkind (Nam) in N_Has_Chars
826 -- Cases where a label is definitely allowed on the END line 826 -- Cases where a label is definitely allowed on the END line
827 827
828 elsif End_Type = E_Name then 828 elsif End_Type = E_Name then
829 Syntax_OK := (not Explicit_Start_Label (SS_Index)) 829 Syntax_OK := (not Explicit_Start_Label (SS_Index))
830 or else 830 or else
831 (not Scope.Table (SS_Index).Lreq); 831 (not Scopes (SS_Index).Lreq);
832 832
833 -- Otherwise we have cases which don't allow labels anyway, so we 833 -- Otherwise we have cases which don't allow labels anyway, so we
834 -- certainly accept an END which does not have a label. 834 -- certainly accept an END which does not have a label.
835 835
836 else 836 else
841 -------------------------- 841 --------------------------
842 -- Explicit_Start_Label -- 842 -- Explicit_Start_Label --
843 -------------------------- 843 --------------------------
844 844
845 function Explicit_Start_Label (SS_Index : Nat) return Boolean is 845 function Explicit_Start_Label (SS_Index : Nat) return Boolean is
846 L : constant Node_Id := Scope.Table (SS_Index).Labl; 846 L : constant Node_Id := Scopes (SS_Index).Labl;
847 Etyp : constant SS_End_Type := Scope.Table (SS_Index).Etyp; 847 Etyp : constant SS_End_Type := Scopes (SS_Index).Etyp;
848 848
849 begin 849 begin
850 if No (L) then 850 if No (L) then
851 return False; 851 return False;
852 852
904 904
905 begin 905 begin
906 -- Suppress message if this was a potentially junk entry (e.g. a record 906 -- Suppress message if this was a potentially junk entry (e.g. a record
907 -- entry where no record keyword was present). 907 -- entry where no record keyword was present).
908 908
909 if Scope.Table (Scope.Last).Junk then 909 if Scopes (Scope.Last).Junk then
910 return; 910 return;
911 end if; 911 end if;
912 912
913 End_Type := Scope.Table (Scope.Last).Etyp; 913 End_Type := Scopes (Scope.Last).Etyp;
914 Error_Msg_Col := Scope.Table (Scope.Last).Ecol; 914 Error_Msg_Col := Scopes (Scope.Last).Ecol;
915 Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc; 915 Error_Msg_Sloc := Scopes (Scope.Last).Sloc;
916 916
917 if Explicit_Start_Label (Scope.Last) then 917 if Explicit_Start_Label (Scope.Last) then
918 Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl; 918 Error_Msg_Node_1 := Scopes (Scope.Last).Labl;
919 else 919 else
920 Error_Msg_Node_1 := Empty; 920 Error_Msg_Node_1 := Empty;
921 end if; 921 end if;
922 922
923 -- Suppress message if error was posted on opening label 923 -- Suppress message if error was posted on opening label
973 -- The other possibility is a missing END for a subprogram with a 973 -- The other possibility is a missing END for a subprogram with a
974 -- suspicious IS (that probably should have been a semicolon). The 974 -- suspicious IS (that probably should have been a semicolon). The
975 -- missing IS confirms the suspicion. 975 -- missing IS confirms the suspicion.
976 976
977 else -- End_Type = E_Suspicious_Is or E_Bad_Is 977 else -- End_Type = E_Suspicious_Is or E_Bad_Is
978 Scope.Table (Scope.Last).Etyp := E_Bad_Is; 978 Scopes (Scope.Last).Etyp := E_Bad_Is;
979 end if; 979 end if;
980 end Output_End_Expected; 980 end Output_End_Expected;
981 981
982 ------------------------ 982 ------------------------
983 -- Output_End_Missing -- 983 -- Output_End_Missing --
988 988
989 begin 989 begin
990 -- Suppress message if this was a potentially junk entry (e.g. a record 990 -- Suppress message if this was a potentially junk entry (e.g. a record
991 -- entry where no record keyword was present). 991 -- entry where no record keyword was present).
992 992
993 if Scope.Table (Scope.Last).Junk then 993 if Scopes (Scope.Last).Junk then
994 return; 994 return;
995 end if; 995 end if;
996 996
997 End_Type := Scope.Table (Scope.Last).Etyp; 997 End_Type := Scopes (Scope.Last).Etyp;
998 Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc; 998 Error_Msg_Sloc := Scopes (Scope.Last).Sloc;
999 999
1000 if Explicit_Start_Label (Scope.Last) then 1000 if Explicit_Start_Label (Scope.Last) then
1001 Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl; 1001 Error_Msg_Node_1 := Scopes (Scope.Last).Labl;
1002 else 1002 else
1003 Error_Msg_Node_1 := Empty; 1003 Error_Msg_Node_1 := Empty;
1004 end if; 1004 end if;
1005 1005
1006 if End_Type = E_Case then 1006 if End_Type = E_Case then
1034 else 1034 else
1035 Error_Msg_BC ("missing `END &;`!"); 1035 Error_Msg_BC ("missing `END &;`!");
1036 end if; 1036 end if;
1037 1037
1038 else -- End_Type = E_Suspicious_Is or E_Bad_Is 1038 else -- End_Type = E_Suspicious_Is or E_Bad_Is
1039 Scope.Table (Scope.Last).Etyp := E_Bad_Is; 1039 Scopes (Scope.Last).Etyp := E_Bad_Is;
1040 end if; 1040 end if;
1041 end Output_End_Missing; 1041 end Output_End_Missing;
1042 1042
1043 --------------------- 1043 ---------------------
1044 -- Pop_End_Context -- 1044 -- Pop_End_Context --
1098 if (Token = Tok_EOF or else 1098 if (Token = Tok_EOF or else
1099 Token = Tok_With or else 1099 Token = Tok_With or else
1100 Token = Tok_Separate) 1100 Token = Tok_Separate)
1101 and then End_Type >= E_Name 1101 and then End_Type >= E_Name
1102 and then (not End_Labl_Present 1102 and then (not End_Labl_Present
1103 or else Same_Label (End_Labl, Scope.Table (1).Labl)) 1103 or else Same_Label (End_Labl, Scopes (1).Labl))
1104 and then Scope.Last > 1 1104 and then Scope.Last > 1
1105 then 1105 then
1106 Restore_Scan_State (Scan_State); -- to END 1106 Restore_Scan_State (Scan_State); -- to END
1107 Output_End_Expected (Ins => True); 1107 Output_End_Expected (Ins => True);
1108 Pop_Scope_Stack; 1108 Pop_Scope_Stack;
1123 -- Complain if checking columns and END is not in right column. 1123 -- Complain if checking columns and END is not in right column.
1124 -- Right in this context means exactly right, or on the same 1124 -- Right in this context means exactly right, or on the same
1125 -- line as the opener. 1125 -- line as the opener.
1126 1126
1127 if RM_Column_Check then 1127 if RM_Column_Check then
1128 if End_Column /= Scope.Table (Scope.Last).Ecol 1128 if End_Column /= Scopes (Scope.Last).Ecol
1129 and then Current_Line_Start > Scope.Table (Scope.Last).Sloc 1129 and then Current_Line_Start > Scopes (Scope.Last).Sloc
1130 1130
1131 -- A special case, for END RECORD, we are also allowed to 1131 -- A special case, for END RECORD, we are also allowed to
1132 -- line up with the TYPE keyword opening the declaration. 1132 -- line up with the TYPE keyword opening the declaration.
1133 1133
1134 and then (Scope.Table (Scope.Last).Etyp /= E_Record 1134 and then (Scopes (Scope.Last).Etyp /= E_Record
1135 or else Get_Column_Number (End_Sloc) /= 1135 or else Get_Column_Number (End_Sloc) /=
1136 Get_Column_Number (Type_Token_Location)) 1136 Get_Column_Number (Type_Token_Location))
1137 then 1137 then
1138 Error_Msg_Col := Scope.Table (Scope.Last).Ecol; 1138 Error_Msg_Col := Scopes (Scope.Last).Ecol;
1139 Error_Msg 1139 Error_Msg
1140 ("(style) END in wrong column, should be@", End_Sloc); 1140 ("(style) END in wrong column, should be@", End_Sloc);
1141 end if; 1141 end if;
1142 end if; 1142 end if;
1143 1143
1174 or else 1174 or else
1175 (not Explicit_Start_Label (Scope.Last - 1)) 1175 (not Explicit_Start_Label (Scope.Last - 1))
1176 or else 1176 or else
1177 (not Same_Label 1177 (not Same_Label
1178 (End_Labl, 1178 (End_Labl,
1179 Scope.Table (Scope.Last - 1).Labl))) 1179 Scopes (Scope.Last - 1).Labl)))
1180 then 1180 then
1181 T_Semicolon; 1181 T_Semicolon;
1182 Error_Msg ("duplicate end line ignored", End_Loc); 1182 Error_Msg ("duplicate end line ignored", End_Loc);
1183 Dup_Found := True; 1183 Dup_Found := True;
1184 end if; 1184 end if;
1227 -- always considered to be pretty good in the record case. This is 1227 -- always considered to be pretty good in the record case. This is
1228 -- because not only does a record disallow a nested structure, but 1228 -- because not only does a record disallow a nested structure, but
1229 -- also it is unlikely that such nesting could occur by accident. 1229 -- also it is unlikely that such nesting could occur by accident.
1230 1230
1231 Pretty_Good := (Token_OK and (Column_OK or Label_OK)) 1231 Pretty_Good := (Token_OK and (Column_OK or Label_OK))
1232 or else Scope.Table (Scope.Last).Etyp = E_Record; 1232 or else Scopes (Scope.Last).Etyp = E_Record;
1233 1233
1234 -- Next check, if there is a deeper entry in the stack which 1234 -- Next check, if there is a deeper entry in the stack which
1235 -- has a very high probability of being acceptable, then insert 1235 -- has a very high probability of being acceptable, then insert
1236 -- the END entry we want, leaving the higher level entry for later 1236 -- the END entry we want, leaving the higher level entry for later
1237 1237
1287 -- Here the column lines up with Lbl, so END LOOP is to the right, 1287 -- Here the column lines up with Lbl, so END LOOP is to the right,
1288 -- but it is still acceptable. LOOP is the one case where alignment 1288 -- but it is still acceptable. LOOP is the one case where alignment
1289 -- practices vary substantially in practice. 1289 -- practices vary substantially in practice.
1290 1290
1291 if Pretty_Good 1291 if Pretty_Good
1292 or else End_Column <= Scope.Table (Scope.Last).Ecol 1292 or else End_Column <= Scopes (Scope.Last).Ecol
1293 or else (End_Type = Scope.Table (Scope.Last).Etyp 1293 or else (End_Type = Scopes (Scope.Last).Etyp
1294 and then End_Type = E_Loop) 1294 and then End_Type = E_Loop)
1295 then 1295 then
1296 Output_End_Expected (Ins => False); 1296 Output_End_Expected (Ins => False);
1297 Pop_Scope_Stack; 1297 Pop_Scope_Stack;
1298 End_Action := Skip_And_Accept; 1298 End_Action := Skip_And_Accept;