From 0bba838d7f4e9b851416d463d077b28aff0b561f Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 16 Dec 2019 10:34:22 +0000 Subject: [PATCH] [Ada] Syntax error on improperly indented imported subprogram 2019-12-16 Bob Duff gcc/ada/ * par.adb: Add Scopes function to do range checking on the scope stack. Call Scopes all over the parser. Add SIS_Aspect_Import_Seen flag. * par-ch6.adb (P_Subprogram): Initialize SIS_Aspect_Import_Seen to False at the start, and check it at the end. * par-ch13.adb (Get_Aspect_Specifications): Set SIS_Aspect_Import_Seen to True when appropriate. * par-ch10.adb, par-ch12.adb, par-ch2.adb, par-ch3.adb, par-ch5.adb, par-ch7.adb, par-ch9.adb, par-endh.adb, par-util.adb: Call Scopes. From-SVN: r279428 --- gcc/ada/ChangeLog | 13 +++++ gcc/ada/par-ch10.adb | 8 +-- gcc/ada/par-ch12.adb | 2 +- gcc/ada/par-ch13.adb | 16 ++++-- gcc/ada/par-ch2.adb | 16 ++---- gcc/ada/par-ch3.adb | 28 +++++----- gcc/ada/par-ch5.adb | 119 ++++++++++++++++++++++--------------------- gcc/ada/par-ch6.adb | 44 +++++++++------- gcc/ada/par-ch7.adb | 16 +++--- gcc/ada/par-ch9.adb | 54 ++++++++++---------- gcc/ada/par-endh.adb | 62 +++++++++++----------- gcc/ada/par-util.adb | 10 ++-- gcc/ada/par.adb | 31 +++++++++-- 13 files changed, 232 insertions(+), 187 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d1af558033e..a4ab24a5d6f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2019-12-16 Bob Duff + + * par.adb: Add Scopes function to do range checking on the scope + stack. Call Scopes all over the parser. Add + SIS_Aspect_Import_Seen flag. + * par-ch6.adb (P_Subprogram): Initialize SIS_Aspect_Import_Seen + to False at the start, and check it at the end. + * par-ch13.adb (Get_Aspect_Specifications): Set + SIS_Aspect_Import_Seen to True when appropriate. + * par-ch10.adb, par-ch12.adb, par-ch2.adb, par-ch3.adb, + par-ch5.adb, par-ch7.adb, par-ch9.adb, par-endh.adb, + par-util.adb: Call Scopes. + 2019-12-16 Eric Botcazou * sem_prag.adb (Atomic_Components): Remove local variable and diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb index ba16cc70575..34323b8229c 100644 --- a/gcc/ada/par-ch10.adb +++ b/gcc/ada/par-ch10.adb @@ -397,10 +397,10 @@ package body Ch10 is or else Token in Token_Class_Deckn then Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Sloc := SIS_Sloc; - Scope.Table (Scope.Last).Ecol := SIS_Ecol; - Scope.Table (Scope.Last).Lreq := False; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Sloc := SIS_Sloc; + Scopes (Scope.Last).Ecol := SIS_Ecol; + Scopes (Scope.Last).Lreq := False; SIS_Entry_Active := False; -- If we had a missing semicolon in the declaration, then diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb index 0861c7f417c..3216927a9e6 100644 --- a/gcc/ada/par-ch12.adb +++ b/gcc/ada/par-ch12.adb @@ -302,7 +302,7 @@ package body Ch12 is elsif Token /= Tok_Left_Paren and then Token_Is_At_Start_Of_Line - and then Start_Column <= Scope.Table (Scope.Last).Ecol + and then Start_Column <= Scopes (Scope.Last).Ecol then return No_List; diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb index d7f5434136c..25a0df998fc 100644 --- a/gcc/ada/par-ch13.adb +++ b/gcc/ada/par-ch13.adb @@ -528,7 +528,15 @@ package body Ch13 is Inside_Depends := True; end if; - -- Parse the aspect definition depening on the expected + -- Note that we have seen an Import aspect specification. + -- This matters only while parsing a subprogram. + + if A_Id = Aspect_Import then + SIS_Aspect_Import_Seen := True; + -- Should do it only for subprograms + end if; + + -- Parse the aspect definition depending on the expected -- argument kind. if Aspect_Argument (A_Id) = Name @@ -826,9 +834,9 @@ package body Ch13 is Set_Identifier (Rep_Clause_Node, Identifier_Node); Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Record; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Etyp := E_Record; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; Scan; -- past RECORD Record_Items := P_Pragmas_Opt; diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb index 29248342d22..ae055aff01f 100644 --- a/gcc/ada/par-ch2.adb +++ b/gcc/ada/par-ch2.adb @@ -247,11 +247,8 @@ package body Ch2 is -- Local variables - Interface_Check_Required : Boolean := False; - -- Set True if check of pragma INTERFACE is required - Import_Check_Required : Boolean := False; - -- Set True if check of pragma IMPORT is required + -- Set True if check of pragma IMPORT or INTERFACE is required Arg_Count : Nat := 0; -- Number of argument associations processed @@ -295,11 +292,10 @@ package body Ch2 is -- See if special INTERFACE/IMPORT check is required if SIS_Entry_Active then - Interface_Check_Required := (Prag_Name = Name_Interface); - Import_Check_Required := (Prag_Name = Name_Import); + Import_Check_Required := + (Prag_Name = Name_Import) or else (Prag_Name = Name_Interface); else - Interface_Check_Required := False; - Import_Check_Required := False; + Import_Check_Required := False; end if; -- Set global to indicate if we are within a Depends pragma @@ -331,9 +327,7 @@ package body Ch2 is Nam_In (Prag_Name, Name_Restriction_Warnings, Name_Restrictions)); - if Arg_Count = 2 - and then (Interface_Check_Required or else Import_Check_Required) - then + if Arg_Count = 2 and then Import_Check_Required then -- Here is where we cancel the SIS active status if this pragma -- supplies a body for the currently active subprogram spec. diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index aff14ed18b5..2b054b21560 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -3338,11 +3338,11 @@ package body Ch3 is else Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Record; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Labl := Error; - Scope.Table (Scope.Last).Junk := (Token /= Tok_Record); + Scopes (Scope.Last).Etyp := E_Record; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Labl := Error; + Scopes (Scope.Last).Junk := (Token /= Tok_Record); T_Record; @@ -3419,7 +3419,7 @@ package body Ch3 is -- additional clue that confirms the incorrect spelling. if Token /= Tok_Identifier then - if Start_Column > Scope.Table (Scope.Last).Ecol + if Start_Column > Scopes (Scope.Last).Ecol and then Is_Reserved_Identifier then Save_Scan_State (Scan_State); -- at reserved id @@ -3661,9 +3661,9 @@ package body Ch3 is begin Variant_Part_Node := New_Node (N_Variant_Part, Token_Ptr); Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Case; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Etyp := E_Case; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Ecol := Start_Column; Scan; -- past CASE Case_Node := P_Expression; @@ -4514,11 +4514,11 @@ package body Ch3 is -- scan it out Push_Scope_Stack; - Scope.Table (Scope.Last).Sloc := SIS_Sloc; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Ecol := SIS_Ecol; - Scope.Table (Scope.Last).Labl := SIS_Labl; - Scope.Table (Scope.Last).Lreq := False; + Scopes (Scope.Last).Sloc := SIS_Sloc; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Ecol := SIS_Ecol; + Scopes (Scope.Last).Labl := SIS_Labl; + Scopes (Scope.Last).Lreq := False; SIS_Entry_Active := False; Scan; -- past BEGIN Set_Handled_Statement_Sequence (Body_Node, diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb index 4a2c369ac27..426bbd57292 100644 --- a/gcc/ada/par-ch5.adb +++ b/gcc/ada/par-ch5.adb @@ -358,7 +358,7 @@ package body Ch5 is -- of the expected column of the end for this sequence if SS_Flags.Eftm - or else Start_Column < Scope.Table (Scope.Last).Ecol + or else Start_Column < Scopes (Scope.Last).Ecol then Test_Statement_Required; exit; @@ -381,7 +381,7 @@ package body Ch5 is -- of the expected column of the end for this sequence if SS_Flags.Eltm - or else Start_Column < Scope.Table (Scope.Last).Ecol + or else Start_Column < Scopes (Scope.Last).Ecol then Test_Statement_Required; exit; @@ -405,7 +405,7 @@ package body Ch5 is -- is not permitted. if not SS_Flags.Extm and then - Start_Column >= Scope.Table (Scope.Last).Ecol + Start_Column >= Scopes (Scope.Last).Ecol then Error_Msg_SC ("exception handler not permitted here"); @@ -427,7 +427,7 @@ package body Ch5 is -- expected column of the end for this sequence. if SS_Flags.Ortm - or else Start_Column < Scope.Table (Scope.Last).Ecol + or else Start_Column < Scopes (Scope.Last).Ecol then Test_Statement_Required; exit; @@ -467,7 +467,7 @@ package body Ch5 is -- the expected column of the end for this sequence. if SS_Flags.Whtm - or else Start_Column < Scope.Table (Scope.Last).Ecol + or else Start_Column < Scopes (Scope.Last).Ecol then Test_Statement_Required; exit; @@ -1142,9 +1142,9 @@ package body Ch5 is procedure Check_If_Column is begin if RM_Column_Check and then Token_Is_At_Start_Of_Line - and then Start_Column /= Scope.Table (Scope.Last).Ecol + and then Start_Column /= Scopes (Scope.Last).Ecol then - Error_Msg_Col := Scope.Table (Scope.Last).Ecol; + Error_Msg_Col := Scopes (Scope.Last).Ecol; Error_Msg_SC ("(style) this token should be@"); end if; end Check_If_Column; @@ -1192,11 +1192,11 @@ package body Ch5 is If_Node := New_Node (N_If_Statement, Token_Ptr); Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_If; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Labl := Error; - Scope.Table (Scope.Last).Node := If_Node; + Scopes (Scope.Last).Etyp := E_If; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Labl := Error; + Scopes (Scope.Last).Node := If_Node; if Token = Tok_If then Loc := Token_Ptr; @@ -1350,11 +1350,11 @@ package body Ch5 is Case_Node := New_Node (N_Case_Statement, Token_Ptr); Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Case; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Labl := Error; - Scope.Table (Scope.Last).Node := Case_Node; + Scopes (Scope.Last).Etyp := E_Case; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Labl := Error; + Scopes (Scope.Last).Node := Case_Node; Scan; -- past CASE Set_Expression (Case_Node, P_Expression_No_Right_Paren); @@ -1392,7 +1392,7 @@ package body Ch5 is -- complain about the missing WHEN, and discard the junk statements. elsif not Token_Is_At_Start_Of_Line - or else Start_Column > Scope.Table (Scope.Last).Ecol + or else Start_Column > Scopes (Scope.Last).Ecol then Error_Msg_BC ("WHEN (case statement alternative) expected"); @@ -1490,10 +1490,10 @@ package body Ch5 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Labl := Loop_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Etyp := E_Loop; + Scopes (Scope.Last).Labl := Loop_Name; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Etyp := E_Loop; Loop_Node := New_Node (N_Loop_Statement, Token_Ptr); TF_Loop; @@ -1504,7 +1504,7 @@ package body Ch5 is Set_Comes_From_Source (Created_Name, False); Set_Has_Created_Identifier (Loop_Node, True); Set_Identifier (Loop_Node, Created_Name); - Scope.Table (Scope.Last).Labl := Created_Name; + Scopes (Scope.Last).Labl := Created_Name; else Set_Identifier (Loop_Node, Loop_Name); end if; @@ -1536,10 +1536,10 @@ package body Ch5 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Labl := Loop_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Etyp := E_Loop; + Scopes (Scope.Last).Labl := Loop_Name; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Etyp := E_Loop; Loop_For_Flag := (Prev_Token = Tok_Loop); Scan; -- past FOR @@ -1575,7 +1575,7 @@ package body Ch5 is Set_Comes_From_Source (Created_Name, False); Set_Has_Created_Identifier (Loop_Node, True); Set_Identifier (Loop_Node, Created_Name); - Scope.Table (Scope.Last).Labl := Created_Name; + Scopes (Scope.Last).Labl := Created_Name; else Set_Identifier (Loop_Node, Loop_Name); end if; @@ -1607,10 +1607,10 @@ package body Ch5 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Labl := Loop_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Etyp := E_Loop; + Scopes (Scope.Last).Labl := Loop_Name; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Etyp := E_Loop; Loop_While_Flag := (Prev_Token = Tok_Loop); Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr); @@ -1641,7 +1641,7 @@ package body Ch5 is Set_Comes_From_Source (Created_Name, False); Set_Has_Created_Identifier (Loop_Node, True); Set_Identifier (Loop_Node, Created_Name); - Scope.Table (Scope.Last).Labl := Created_Name; + Scopes (Scope.Last).Labl := Created_Name; else Set_Identifier (Loop_Node, Loop_Name); end if; @@ -1805,11 +1805,11 @@ package body Ch5 is Block_Node := New_Node (N_Block_Statement, Token_Ptr); Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Lreq := Present (Block_Name); - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Labl := Block_Name; - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Lreq := Present (Block_Name); + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Labl := Block_Name; + Scopes (Scope.Last).Sloc := Token_Ptr; Scan; -- past DECLARE @@ -1819,7 +1819,7 @@ package body Ch5 is Set_Comes_From_Source (Created_Name, False); Set_Has_Created_Identifier (Block_Node, True); Set_Identifier (Block_Node, Created_Name); - Scope.Table (Scope.Last).Labl := Created_Name; + Scopes (Scope.Last).Labl := Created_Name; else Set_Identifier (Block_Node, Block_Name); end if; @@ -1848,11 +1848,11 @@ package body Ch5 is Block_Node := New_Node (N_Block_Statement, Token_Ptr); Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Lreq := Present (Block_Name); - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Labl := Block_Name; - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Lreq := Present (Block_Name); + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Labl := Block_Name; + Scopes (Scope.Last).Sloc := Token_Ptr; if No (Block_Name) then Created_Name := @@ -1860,15 +1860,15 @@ package body Ch5 is Set_Comes_From_Source (Created_Name, False); Set_Has_Created_Identifier (Block_Node, True); Set_Identifier (Block_Node, Created_Name); - Scope.Table (Scope.Last).Labl := Created_Name; + Scopes (Scope.Last).Labl := Created_Name; else Set_Identifier (Block_Node, Block_Name); end if; Append_Elmt (Block_Node, Label_List); - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; Scan; -- past BEGIN Set_Handled_Statement_Sequence (Block_Node, P_Handled_Sequence_Of_Statements); @@ -1913,7 +1913,7 @@ package body Ch5 is if not Token_Is_At_Start_Of_Line then return False; - elsif Scope.Table (Scope.Last).Etyp /= E_Case then + elsif Scopes (Scope.Last).Etyp /= E_Case then return False; else @@ -1946,13 +1946,13 @@ package body Ch5 is Check_No_Exit_Name : for J in reverse 1 .. Scope.Last loop - if Scope.Table (J).Etyp = E_Loop then - if Present (Scope.Table (J).Labl) - and then Comes_From_Source (Scope.Table (J).Labl) + if Scopes (J).Etyp = E_Loop then + if Present (Scopes (J).Labl) + and then Comes_From_Source (Scopes (J).Labl) then -- Innermost loop in fact had a name, style check fails - Style.No_Exit_Name (Scope.Table (J).Labl); + Style.No_Exit_Name (Scopes (J).Labl); end if; exit Check_No_Exit_Name; @@ -2154,7 +2154,7 @@ package body Ch5 is Style.Check_Indentation; end if; - Error_Msg_Col := Scope.Table (Scope.Last).Ecol; + Error_Msg_Col := Scopes (Scope.Last).Ecol; if RM_Column_Check and then Token_Is_At_Start_Of_Line @@ -2163,10 +2163,10 @@ package body Ch5 is Error_Msg_SC ("(style) BEGIN in wrong column, should be@"); else - Scope.Table (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Ecol := Start_Column; end if; - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Sloc := Token_Ptr; Scan; -- past BEGIN Set_Handled_Statement_Sequence (Parent, P_Handled_Sequence_Of_Statements); @@ -2183,9 +2183,9 @@ package body Ch5 is if Parent_Nkind = N_Subprogram_Body and then Token = Tok_End - and then Scope.Table (Scope.Last).Etyp = E_Suspicious_Is + and then Scopes (Scope.Last).Etyp = E_Suspicious_Is then - Scope.Table (Scope.Last).Etyp := E_Bad_Is; + Scopes (Scope.Last).Etyp := E_Bad_Is; -- Otherwise BEGIN is not required for a package body, so we -- don't mind if it is missing, but we do construct a dummy @@ -2211,8 +2211,8 @@ package body Ch5 is -- Prepare to issue error message - Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc; - Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl; + Error_Msg_Sloc := Scopes (Scope.Last).Sloc; + Error_Msg_Node_1 := Scopes (Scope.Last).Labl; -- Now issue appropriate message @@ -2272,6 +2272,7 @@ package body Ch5 is -- (because it is required to do so under all circumstances). We can -- therefore reference the entry it removed one past the stack top. -- What we are interested in is whether it was a case of a bad IS. + -- We can't call Scopes here. if Scope.Table (Scope.Last + 1).Etyp = E_Bad_Is then Error_Msg -- CODEFIX diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index 0fc7109e351..bf7f9719b65 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -229,12 +229,13 @@ package body Ch6 is -- Set up scope stack entry. Note that the Labl field will be set later SIS_Entry_Active := False; + SIS_Aspect_Import_Seen := False; SIS_Missing_Semicolon_Message := No_Error_Msg; Push_Scope_Stack; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Lreq := False; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Lreq := False; Aspects := Empty_List; @@ -335,7 +336,7 @@ package body Ch6 is Name_Node := P_Defining_Program_Unit_Name; end if; - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; Ignore (Tok_Colon); @@ -533,7 +534,7 @@ package body Ch6 is -- i.e. that the terminating semicolon should have been IS. elsif Token = Tok_Begin - and then Start_Column >= Scope.Table (Scope.Last).Ecol + and then Start_Column >= Scopes (Scope.Last).Ecol then Error_Msg_SP -- CODEFIX ("|"";"" should be IS!"); @@ -764,7 +765,7 @@ package body Ch6 is Spec_Node : constant Node_Id := Parent - (Scope.Table (Scope.Last).Labl); + (Scopes (Scope.Last).Labl); Lib_Node : Node_Id := Spec_Node; begin @@ -773,7 +774,7 @@ package body Ch6 is if Scope.Last > 1 then Lib_Node := - Parent (Scope.Table (Scope.Last - 1).Labl); + Parent (Scopes (Scope.Last - 1).Labl); end if; if Ada_Version >= Ada_2012 @@ -917,11 +918,11 @@ package body Ch6 is if (Token in Token_Class_Declk or else Token = Tok_Identifier) - and then Start_Column <= Scope.Table (Scope.Last).Ecol + and then Start_Column <= Scopes (Scope.Last).Ecol and then Scope.Last /= 1 then - Scope.Table (Scope.Last).Etyp := E_Suspicious_Is; - Scope.Table (Scope.Last).S_Is := Prev_Token_Ptr; + Scopes (Scope.Last).Etyp := E_Suspicious_Is; + Scopes (Scope.Last).S_Is := Prev_Token_Ptr; end if; -- Build and return subprogram body, parsing declarations @@ -1004,12 +1005,17 @@ package body Ch6 is and then (Nkind (Specification_Node) /= N_Procedure_Specification or else not Null_Present (Specification_Node)) then - SIS_Labl := Scope.Table (Scope.Last).Labl; - SIS_Sloc := Scope.Table (Scope.Last).Sloc; - SIS_Ecol := Scope.Table (Scope.Last).Ecol; + SIS_Labl := Scopes (Scope.Last).Labl; + SIS_Sloc := Scopes (Scope.Last).Sloc; + SIS_Ecol := Scopes (Scope.Last).Ecol; SIS_Declaration_Node := Decl_Node; SIS_Semicolon_Sloc := Prev_Token_Ptr; - SIS_Entry_Active := True; + + -- Do not activate the entry if we have "with Import" + + if not SIS_Aspect_Import_Seen then + SIS_Entry_Active := True; + end if; end if; Pop_Scope_Stack; @@ -1946,10 +1952,10 @@ package body Ch6 is if Token = Tok_Do then Push_Scope_Stack; - Scope.Table (Scope.Last).Ecol := Ret_Strt; - Scope.Table (Scope.Last).Etyp := E_Return; - Scope.Table (Scope.Last).Labl := Error; - Scope.Table (Scope.Last).Sloc := Ret_Sloc; + Scopes (Scope.Last).Ecol := Ret_Strt; + Scopes (Scope.Last).Etyp := E_Return; + Scopes (Scope.Last).Labl := Error; + Scopes (Scope.Last).Sloc := Ret_Sloc; Scan; -- past DO Set_Handled_Statement_Sequence diff --git a/gcc/ada/par-ch7.adb b/gcc/ada/par-ch7.adb index d3cfa25d1ce..c8150a49123 100644 --- a/gcc/ada/par-ch7.adb +++ b/gcc/ada/par-ch7.adb @@ -121,9 +121,9 @@ package body Ch7 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Lreq := False; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Lreq := False; Package_Sloc := Token_Ptr; Scan; -- past PACKAGE @@ -143,9 +143,9 @@ package body Ch7 is end if; T_Body; - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Sloc := Token_Ptr; Name_Node := P_Defining_Program_Unit_Name; - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; if Aspect_Specifications_Present then @@ -209,9 +209,9 @@ package body Ch7 is -- Cases other than Package_Body else - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Sloc := Token_Ptr; Name_Node := P_Defining_Program_Unit_Name; - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; -- Case of renaming declaration @@ -290,7 +290,7 @@ package body Ch7 is (Specification_Node, P_Basic_Declarative_Items); if Token = Tok_Private then - Error_Msg_Col := Scope.Table (Scope.Last).Ecol; + Error_Msg_Col := Scopes (Scope.Last).Ecol; if RM_Column_Check then if Token_Is_At_Start_Of_Line diff --git a/gcc/ada/par-ch9.adb b/gcc/ada/par-ch9.adb index 825dac112ce..d6c6dfc45e5 100644 --- a/gcc/ada/par-ch9.adb +++ b/gcc/ada/par-ch9.adb @@ -91,16 +91,16 @@ package body Ch9 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Lreq := False; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Lreq := False; Task_Sloc := Prev_Token_Ptr; if Token = Tok_Body then Scan; -- past BODY Name_Node := P_Defining_Identifier (C_Is); - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; if Token = Tok_Left_Paren then @@ -168,7 +168,7 @@ package body Ch9 is Task_Node := New_Node (N_Task_Type_Declaration, Task_Sloc); Name_Node := P_Defining_Identifier; Set_Defining_Identifier (Task_Node, Name_Node); - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; Set_Discriminant_Specifications (Task_Node, P_Known_Discriminant_Part_Opt); @@ -177,7 +177,7 @@ package body Ch9 is Task_Node := New_Node (N_Single_Task_Declaration, Task_Sloc); Name_Node := P_Defining_Identifier (C_Is); Set_Defining_Identifier (Task_Node, Name_Node); - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; if Token = Tok_Left_Paren then @@ -441,15 +441,15 @@ package body Ch9 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Lreq := False; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Lreq := False; Protected_Sloc := Prev_Token_Ptr; if Token = Tok_Body then Scan; -- past BODY Name_Node := P_Defining_Identifier (C_Is); - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; if Token = Tok_Left_Paren then @@ -504,7 +504,7 @@ package body Ch9 is New_Node (N_Protected_Type_Declaration, Protected_Sloc); Name_Node := P_Defining_Identifier (C_Is); Set_Defining_Identifier (Protected_Node, Name_Node); - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; Set_Discriminant_Specifications (Protected_Node, P_Known_Discriminant_Part_Opt); @@ -521,7 +521,7 @@ package body Ch9 is Discard_Junk_List (P_Known_Discriminant_Part_Opt); end if; - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; end if; @@ -1074,12 +1074,12 @@ package body Ch9 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Ecol := Start_Column; Accept_Node := New_Node (N_Accept_Statement, Token_Ptr); Scan; -- past ACCEPT - Scope.Table (Scope.Last).Labl := Token_Node; + Scopes (Scope.Last).Labl := Token_Node; Current_Node := Token_Node; Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do)); @@ -1123,8 +1123,8 @@ package body Ch9 is -- Scan out DO if present if Token = Tok_Do then - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Lreq := False; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Lreq := False; Scan; -- past DO Hand_Seq := P_Handled_Sequence_Of_Statements; Set_Handled_Statement_Sequence (Accept_Node, Hand_Seq); @@ -1221,14 +1221,14 @@ package body Ch9 is Entry_Node := New_Node (N_Entry_Body, Token_Ptr); Scan; -- past ENTRY - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Lreq := False; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Lreq := False; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Sloc := Token_Ptr; Name_Node := P_Defining_Identifier; Set_Defining_Identifier (Entry_Node, Name_Node); - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; Formal_Part_Node := P_Entry_Body_Formal_Part; @@ -1521,10 +1521,10 @@ package body Ch9 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Select; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Labl := Error; + Scopes (Scope.Last).Etyp := E_Select; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Labl := Error; Select_Sloc := Token_Ptr; Scan; -- past SELECT diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb index ba1f800b922..705b7fbc9d0 100644 --- a/gcc/ada/par-endh.adb +++ b/gcc/ada/par-endh.adb @@ -180,7 +180,7 @@ package body Endh is Name_Scan_State : Saved_Scan_State; -- Save state at start of name if Name_On_Separate_Line is TRUE - Span_Node : constant Node_Id := Scope.Table (Scope.Last).Node; + Span_Node : constant Node_Id := Scopes (Scope.Last).Node; begin End_Labl_Present := False; @@ -284,7 +284,7 @@ package body Endh is if Name_On_Separate_Line then if Token /= Tok_Semicolon or else - not Same_Label (End_Labl, Scope.Table (Scope.Last).Labl) + not Same_Label (End_Labl, Scopes (Scope.Last).Labl) then Restore_Scan_State (Name_Scan_State); End_Labl := Empty; @@ -297,7 +297,7 @@ package body Endh is -- to the scan location past the END token. else - End_Labl := Scope.Table (Scope.Last).Labl; + End_Labl := Scopes (Scope.Last).Labl; if End_Labl > Empty_Or_Error then @@ -382,10 +382,10 @@ package body Endh is if Style_Check and then End_Type = E_Name and then Explicit_Start_Label (Scope.Last) - and then Nkind (Parent (Scope.Table (Scope.Last).Labl)) + and then Nkind (Parent (Scopes (Scope.Last).Labl)) /= N_Block_Statement then - Style.No_End_Name (Scope.Table (Scope.Last).Labl); + Style.No_End_Name (Scopes (Scope.Last).Labl); end if; end if; end if; @@ -710,7 +710,7 @@ package body Endh is ------------------------ procedure Evaluate_End_Entry (SS_Index : Nat) is - STE : Scope_Table_Entry renames Scope.Table (SS_Index); + STE : Scope_Table_Entry renames Scopes (SS_Index).all; begin Column_OK := (End_Column = STE.Ecol); @@ -741,7 +741,7 @@ package body Endh is if not Label_OK and then End_Labl_Present - and then not Comes_From_Source (Scope.Table (SS_Index).Labl) + and then not Comes_From_Source (Scopes (SS_Index).Labl) then -- Here is where we will search the suspicious labels table @@ -792,7 +792,7 @@ package body Endh is -- If probably misspelling, then complain, and pretend it is OK declare - Nam : constant Node_Or_Entity_Id := Scope.Table (SS_Index).Labl; + Nam : constant Node_Or_Entity_Id := Scopes (SS_Index).Labl; begin if Nkind (End_Labl) in N_Has_Chars @@ -828,7 +828,7 @@ package body Endh is elsif End_Type = E_Name then Syntax_OK := (not Explicit_Start_Label (SS_Index)) or else - (not Scope.Table (SS_Index).Lreq); + (not Scopes (SS_Index).Lreq); -- Otherwise we have cases which don't allow labels anyway, so we -- certainly accept an END which does not have a label. @@ -843,8 +843,8 @@ package body Endh is -------------------------- function Explicit_Start_Label (SS_Index : Nat) return Boolean is - L : constant Node_Id := Scope.Table (SS_Index).Labl; - Etyp : constant SS_End_Type := Scope.Table (SS_Index).Etyp; + L : constant Node_Id := Scopes (SS_Index).Labl; + Etyp : constant SS_End_Type := Scopes (SS_Index).Etyp; begin if No (L) then @@ -906,16 +906,16 @@ package body Endh is -- Suppress message if this was a potentially junk entry (e.g. a record -- entry where no record keyword was present). - if Scope.Table (Scope.Last).Junk then + if Scopes (Scope.Last).Junk then return; end if; - End_Type := Scope.Table (Scope.Last).Etyp; - Error_Msg_Col := Scope.Table (Scope.Last).Ecol; - Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc; + End_Type := Scopes (Scope.Last).Etyp; + Error_Msg_Col := Scopes (Scope.Last).Ecol; + Error_Msg_Sloc := Scopes (Scope.Last).Sloc; if Explicit_Start_Label (Scope.Last) then - Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl; + Error_Msg_Node_1 := Scopes (Scope.Last).Labl; else Error_Msg_Node_1 := Empty; end if; @@ -975,7 +975,7 @@ package body Endh is -- missing IS confirms the suspicion. else -- End_Type = E_Suspicious_Is or E_Bad_Is - Scope.Table (Scope.Last).Etyp := E_Bad_Is; + Scopes (Scope.Last).Etyp := E_Bad_Is; end if; end Output_End_Expected; @@ -990,15 +990,15 @@ package body Endh is -- Suppress message if this was a potentially junk entry (e.g. a record -- entry where no record keyword was present). - if Scope.Table (Scope.Last).Junk then + if Scopes (Scope.Last).Junk then return; end if; - End_Type := Scope.Table (Scope.Last).Etyp; - Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc; + End_Type := Scopes (Scope.Last).Etyp; + Error_Msg_Sloc := Scopes (Scope.Last).Sloc; if Explicit_Start_Label (Scope.Last) then - Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl; + Error_Msg_Node_1 := Scopes (Scope.Last).Labl; else Error_Msg_Node_1 := Empty; end if; @@ -1036,7 +1036,7 @@ package body Endh is end if; else -- End_Type = E_Suspicious_Is or E_Bad_Is - Scope.Table (Scope.Last).Etyp := E_Bad_Is; + Scopes (Scope.Last).Etyp := E_Bad_Is; end if; end Output_End_Missing; @@ -1100,7 +1100,7 @@ package body Endh is Token = Tok_Separate) and then End_Type >= E_Name and then (not End_Labl_Present - or else Same_Label (End_Labl, Scope.Table (1).Labl)) + or else Same_Label (End_Labl, Scopes (1).Labl)) and then Scope.Last > 1 then Restore_Scan_State (Scan_State); -- to END @@ -1125,17 +1125,17 @@ package body Endh is -- line as the opener. if RM_Column_Check then - if End_Column /= Scope.Table (Scope.Last).Ecol - and then Current_Line_Start > Scope.Table (Scope.Last).Sloc + if End_Column /= Scopes (Scope.Last).Ecol + and then Current_Line_Start > Scopes (Scope.Last).Sloc -- A special case, for END RECORD, we are also allowed to -- line up with the TYPE keyword opening the declaration. - and then (Scope.Table (Scope.Last).Etyp /= E_Record + and then (Scopes (Scope.Last).Etyp /= E_Record or else Get_Column_Number (End_Sloc) /= Get_Column_Number (Type_Token_Location)) then - Error_Msg_Col := Scope.Table (Scope.Last).Ecol; + Error_Msg_Col := Scopes (Scope.Last).Ecol; Error_Msg ("(style) END in wrong column, should be@", End_Sloc); end if; @@ -1176,7 +1176,7 @@ package body Endh is or else (not Same_Label (End_Labl, - Scope.Table (Scope.Last - 1).Labl))) + Scopes (Scope.Last - 1).Labl))) then T_Semicolon; Error_Msg ("duplicate end line ignored", End_Loc); @@ -1229,7 +1229,7 @@ package body Endh is -- also it is unlikely that such nesting could occur by accident. Pretty_Good := (Token_OK and (Column_OK or Label_OK)) - or else Scope.Table (Scope.Last).Etyp = E_Record; + or else Scopes (Scope.Last).Etyp = E_Record; -- Next check, if there is a deeper entry in the stack which -- has a very high probability of being acceptable, then insert @@ -1289,8 +1289,8 @@ package body Endh is -- practices vary substantially in practice. if Pretty_Good - or else End_Column <= Scope.Table (Scope.Last).Ecol - or else (End_Type = Scope.Table (Scope.Last).Etyp + or else End_Column <= Scopes (Scope.Last).Ecol + or else (End_Type = Scopes (Scope.Last).Etyp and then End_Type = E_Loop) then Output_End_Expected (Ins => False); diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb index 7b93ffa62d8..1c32a42e08f 100644 --- a/gcc/ada/par-util.adb +++ b/gcc/ada/par-util.adb @@ -162,7 +162,7 @@ package body Util is procedure Check_Bad_Layout is begin if RM_Column_Check and then Token_Is_At_Start_Of_Line - and then Start_Column <= Scope.Table (Scope.Last).Ecol + and then Start_Column <= Scopes (Scope.Last).Ecol then Error_Msg_BC -- CODEFIX ("(style) incorrect layout"); @@ -668,9 +668,9 @@ package body Util is Scope.Decrement_Last; if Include_Subprogram_In_Messages - and then Scope.Table (Scope.Last).Labl /= Error + and then Scopes (Scope.Last).Labl /= Error then - Current_Node := Scope.Table (Scope.Last).Labl; + Current_Node := Scopes (Scope.Last).Labl; end if; if Debug_Flag_P then @@ -695,8 +695,8 @@ package body Util is First_Non_Blank_Location); end if; - Scope.Table (Scope.Last).Junk := False; - Scope.Table (Scope.Last).Node := Empty; + Scopes (Scope.Last).Junk := False; + Scopes (Scope.Last).Node := Empty; if Debug_Flag_P then Error_Msg_Uint_1 := UI_From_Int (Scope.Last); diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 43a7daed995..0e3fa401a77 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -151,8 +151,17 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is SIS_Entry_Active : Boolean := False; -- Set True to indicate that an entry is active (i.e. that a subprogram - -- declaration has been encountered, and no body for this subprogram has - -- been encountered). The remaining fields are valid only if this is True. + -- declaration has been encountered, and no body for this subprogram + -- has been encountered). The remaining variables other than + -- SIS_Aspect_Import_Seen are valid only if this is True. + + SIS_Aspect_Import_Seen : Boolean := False; + -- If this is True when a subprogram declaration has been encountered, we + -- do not set SIS_Entry_Active, because the Import means there is no body. + -- Set False at the start of P_Subprogram, set True when an Import aspect + -- specification is seen, and used when P_Subprogram finds a subprogram + -- declaration. This is necessary because the aspects are parsed before + -- we know we have a subprogram declaration. SIS_Labl : Node_Id; -- Subprogram designator @@ -535,6 +544,20 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is Table_Increment => 100, Table_Name => "Scope"); + type Scope_Table_Entry_Ptr is access all Scope_Table_Entry; + + function Scopes (Index : Int) return Scope_Table_Entry_Ptr; + -- Return the indicated Scope_Table_Entry. We use a pointer for + -- efficiency. Callers should not save the pointer, but should do things + -- like Scopes (Scope.Last).Something. Note that there is one place in + -- Par.Ch5 that indexes the stack out of bounds, and can't call this. + + function Scopes (Index : Int) return Scope_Table_Entry_Ptr is + begin + pragma Assert (Index in Scope.First .. Scope.Last); + return Scope.Table (Index)'Unrestricted_Access; + end Scopes; + ------------------------------------------ -- Table for Handling Suspicious Labels -- ------------------------------------------ @@ -1332,7 +1355,7 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- Push a new entry onto the scope stack. Scope.Last (the stack pointer) -- is incremented. The Junk field is preinitialized to False. The caller -- is expected to fill in all remaining entries of the new top stack - -- entry at Scope.Table (Scope.Last). + -- entry at Scopes (Scope.Last). procedure Pop_Scope_Stack; -- Pop an entry off the top of the scope stack. Scope_Last (the scope @@ -1534,7 +1557,7 @@ begin Compiler_State := Parsing; Scope.Init; Scope.Increment_Last; - Scope.Table (0).Etyp := E_Dummy; + Scopes (0).Etyp := E_Dummy; SIS_Entry_Active := False; Last_Resync_Point := No_Location; -- 2.30.2