| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- P A R . E N D H -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- |
| -- for more details. You should have received a copy of the GNU General -- |
| -- Public License distributed with GNAT; see file COPYING3. If not, go to -- |
| -- http://www.gnu.org/licenses for a complete copy of the license. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Namet.Sp; use Namet.Sp; |
| with Stringt; use Stringt; |
| with Uintp; use Uintp; |
| |
| with GNAT.Spelling_Checker; use GNAT.Spelling_Checker; |
| |
| separate (Par) |
| package body Endh is |
| |
| ---------------- |
| -- Local Data -- |
| ---------------- |
| |
| type End_Action_Type is ( |
| -- Type used to describe the result of the Pop_End_Context call |
| |
| Accept_As_Scanned, |
| -- Current end sequence is entirely c correct. In this case Token and |
| -- the scan pointer are left pointing past the end sequence (i.e. they |
| -- are unchanged from the values set on entry to Pop_End_Context). |
| |
| Insert_And_Accept, |
| -- Current end sequence is to be left in place to satisfy some outer |
| -- scope. Token and the scan pointer are set to point to the end |
| -- token, and should be left there. A message has been generated |
| -- indicating a missing end sequence. This status is also used for |
| -- the case when no end token is present. |
| |
| Skip_And_Accept, |
| -- The end sequence is incorrect (and an error message has been |
| -- posted), but it will still be accepted. In this case Token and |
| -- the scan pointer point back to the end token, and the caller |
| -- should skip past the end sequence before proceeding. |
| |
| Skip_And_Reject); |
| -- The end sequence is judged to belong to an unrecognized inner |
| -- scope. An appropriate message has been issued and the caller |
| -- should skip past the end sequence and then proceed as though |
| -- no end sequence had been encountered. |
| |
| End_Action : End_Action_Type; |
| -- The variable set by Pop_End_Context call showing which of the four |
| -- decisions described above is judged the best. |
| |
| End_Sloc : Source_Ptr; |
| -- Source location of END token |
| |
| End_OK : Boolean; |
| -- Set False if error is found in END line |
| |
| End_Column : Column_Number; |
| -- Column of END line |
| |
| End_Type : SS_End_Type; |
| -- Type of END expected. The special value E_Dummy is set to indicate that |
| -- no END token was present (so a missing END inserted message is needed) |
| |
| End_Labl : Node_Id; |
| -- Node_Id value for explicit name on END line, or for compiler supplied |
| -- name in the case where an optional name is not given. Empty if no name |
| -- appears. If non-empty, then it is either an N_Designator node for a |
| -- child unit or a node with a Chars field identifying the actual label. |
| |
| End_Labl_Present : Boolean; |
| -- Indicates that the value in End_Labl was for an explicit label |
| |
| Syntax_OK : Boolean; |
| -- Set True if the entry is syntactically correct |
| |
| Token_OK : Boolean; |
| -- Set True if the keyword in the END sequence matches, or if neither |
| -- the END sequence nor the END stack entry has a keyword. |
| |
| Label_OK : Boolean; |
| -- Set True if both the END sequence and the END stack entry contained |
| -- labels (other than No_Name or Error_Name) and the labels matched. |
| -- This is a stronger condition than SYNTAX_OK, since it means that a |
| -- label was present, even in a case where it was optional. Note that |
| -- the case of no label required, and no label present does NOT set |
| -- Label_OK to True, it is True only if a positive label match is found. |
| |
| Column_OK : Boolean; |
| -- Column_OK is set True if the END sequence appears in the expected column |
| |
| Scan_State : Saved_Scan_State; |
| -- Save state at start of END sequence, in case we decide not to eat it up |
| |
| ----------------------- |
| -- Local Subprograms -- |
| ----------------------- |
| |
| procedure Evaluate_End_Entry (SS_Index : Nat); |
| -- Compare scanned END entry (as recorded by a prior call to P_End_Scan) |
| -- with a specified entry in the scope stack (the single parameter is the |
| -- entry index in the scope stack). Note that Scan is not called. The above |
| -- variables xxx_OK are set to indicate the result of the evaluation. |
| |
| function Explicit_Start_Label (SS_Index : Nat) return Boolean; |
| -- Determines whether the specified entry in the scope stack has an |
| -- explicit start label (i.e. one other than one that was created by |
| -- the parser when no explicit label was present). |
| |
| procedure Output_End_Deleted; |
| -- Output a message complaining that the current END structure does not |
| -- match anything and is being deleted. |
| |
| procedure Output_End_Expected (Ins : Boolean); |
| -- Output a message at the start of the current token which is always an |
| -- END, complaining that the END is not of the right form. The message |
| -- indicates the expected form. The information for the message is taken |
| -- from the top entry in the scope stack. The Ins parameter is True if |
| -- an end is being inserted, and false if an existing end is being |
| -- replaced. Note that in the case of a suspicious IS for the Ins case, |
| -- we do not output the message, but instead simply mark the scope stack |
| -- entry as being a case of a bad IS. |
| |
| procedure Output_End_Missing; |
| -- Output a message just before the current token, complaining that the |
| -- END is not of the right form. The message indicates the expected form. |
| -- The information for the message is taken from the top entry in the |
| -- scope stack. Note that in the case of a suspicious IS, we do not output |
| -- the message, but instead simply mark the scope stack entry as a bad IS. |
| |
| procedure Pop_End_Context; |
| -- Pop_End_Context is called after processing a construct, to pop the |
| -- top entry off the end stack. It decides on the appropriate action to |
| -- to take, signalling the result by setting End_Action as described in |
| -- the global variable section. |
| |
| function Same_Label (Label1, Label2 : Node_Id) return Boolean; |
| -- This function compares the two names associated with the given nodes. |
| -- If they are both simple (i.e. have Chars fields), then they have to |
| -- be the same name. Otherwise they must both be N_Selected_Component |
| -- nodes, referring to the same set of names, or Label1 is an N_Designator |
| -- referring to the same set of names as the N_Defining_Program_Unit_Name |
| -- in Label2. Any other combination returns False. This routine is used |
| -- to compare the End_Labl scanned from the End line with the saved label |
| -- value in the scope stack. |
| |
| --------------- |
| -- Check_End -- |
| --------------- |
| |
| function Check_End |
| (Decl : Node_Id := Empty; |
| Is_Loc : Source_Ptr := No_Location) return Boolean |
| is |
| Name_On_Separate_Line : Boolean; |
| -- Set True if the name on an END line is on a separate source line |
| -- from the END. This is highly suspicious, but is allowed. The point |
| -- is that we want to make sure that we don't just have a missing |
| -- semicolon misleading us into swallowing an identifier from the |
| -- following line. |
| |
| Name_Scan_State : Saved_Scan_State; |
| -- Save state at start of name if Name_On_Separate_Line is TRUE |
| |
| Span_Node : constant Node_Id := Scopes (Scope.Last).Node; |
| |
| begin |
| End_Labl_Present := False; |
| End_Labl := Empty; |
| |
| -- Our first task is to scan out the END sequence if one is present. |
| -- If none is present, signal by setting End_Type to E_Dummy. |
| |
| if Token /= Tok_End then |
| End_Type := E_Dummy; |
| |
| else |
| Save_Scan_State (Scan_State); -- at END |
| End_Sloc := Token_Ptr; |
| End_Column := Start_Column; |
| End_OK := True; |
| Scan; -- past END |
| |
| -- Set End_Span if expected. Note that this will be useless |
| -- if we do not have the right ending keyword, but in this |
| -- case we have a malformed program anyway, and the setting |
| -- of End_Span will simply be unreliable in this case anyway. |
| |
| if Present (Span_Node) then |
| Set_End_Location (Span_Node, Token_Ptr); |
| end if; |
| |
| -- Cases of keywords where no label is allowed |
| |
| if Token = Tok_Case then |
| End_Type := E_Case; |
| Scan; -- past CASE |
| |
| elsif Token = Tok_If then |
| End_Type := E_If; |
| Scan; -- past IF |
| |
| elsif Token = Tok_Record then |
| End_Type := E_Record; |
| Scan; -- past RECORD |
| |
| elsif Token = Tok_Return then |
| End_Type := E_Return; |
| Scan; -- past RETURN |
| |
| elsif Token = Tok_Select then |
| End_Type := E_Select; |
| Scan; -- past SELECT |
| |
| -- Cases which do allow labels |
| |
| else |
| -- LOOP |
| |
| if Token = Tok_Loop then |
| Scan; -- past LOOP |
| End_Type := E_Loop; |
| |
| -- FOR or WHILE allowed (signalling error) to substitute for LOOP |
| -- if on the same line as the END. |
| |
| elsif Token in Tok_For | Tok_While |
| and then not Token_Is_At_Start_Of_Line |
| then |
| Scan; -- past FOR or WHILE |
| End_Type := E_Loop; |
| End_OK := False; |
| |
| -- Cases with no keyword |
| |
| else |
| End_Type := E_Name; |
| end if; |
| |
| -- Now see if a name is present |
| |
| if Token = Tok_Identifier or else |
| Token = Tok_String_Literal or else |
| Token = Tok_Operator_Symbol |
| then |
| if Token_Is_At_Start_Of_Line then |
| Name_On_Separate_Line := True; |
| Save_Scan_State (Name_Scan_State); |
| else |
| Name_On_Separate_Line := False; |
| end if; |
| |
| End_Labl := P_Designator; |
| End_Labl_Present := True; |
| |
| -- We have now scanned out a name. Here is where we do a check |
| -- to catch the cases like: |
| -- |
| -- end loop |
| -- X := 3; |
| -- |
| -- where the missing semicolon might make us swallow up the X |
| -- as a bogus end label. In a situation like this, where the |
| -- apparent name is on a separate line, we accept it only if |
| -- it matches the label and is followed by a semicolon. |
| |
| if Name_On_Separate_Line then |
| if Token /= Tok_Semicolon or else |
| not Same_Label (End_Labl, Scopes (Scope.Last).Labl) |
| then |
| Restore_Scan_State (Name_Scan_State); |
| End_Labl := Empty; |
| End_Labl_Present := False; |
| end if; |
| end if; |
| |
| -- Here for case of name allowed, but no name present. We will |
| -- supply an implicit matching name, with source location set |
| -- to the scan location past the END token. |
| |
| else |
| End_Labl := Scopes (Scope.Last).Labl; |
| |
| if End_Labl > Empty_Or_Error then |
| |
| -- The task here is to construct a designator from the |
| -- opening label, with the components all marked as not |
| -- from source, and Is_End_Label set in the identifier |
| -- or operator symbol. The location for all components |
| -- is the current token location. |
| |
| -- Case of child unit name |
| |
| if Nkind (End_Labl) = N_Defining_Program_Unit_Name then |
| Child_End : declare |
| Eref : constant Node_Id := |
| Make_Identifier (Token_Ptr, |
| Chars => |
| Chars (Defining_Identifier (End_Labl))); |
| |
| function Copy_Name (N : Node_Id) return Node_Id; |
| -- Copies a selected component or identifier |
| |
| --------------- |
| -- Copy_Name -- |
| --------------- |
| |
| function Copy_Name (N : Node_Id) return Node_Id is |
| R : Node_Id; |
| |
| begin |
| if Nkind (N) = N_Selected_Component then |
| return |
| Make_Selected_Component (Token_Ptr, |
| Prefix => |
| Copy_Name (Prefix (N)), |
| Selector_Name => |
| Copy_Name (Selector_Name (N))); |
| |
| else |
| R := Make_Identifier (Token_Ptr, Chars (N)); |
| Set_Comes_From_Source (N, False); |
| return R; |
| end if; |
| end Copy_Name; |
| |
| -- Start of processing for Child_End |
| |
| begin |
| Set_Comes_From_Source (Eref, False); |
| |
| End_Labl := |
| Make_Designator (Token_Ptr, |
| Name => Copy_Name (Name (End_Labl)), |
| Identifier => Eref); |
| end Child_End; |
| |
| -- Simple identifier case |
| |
| elsif Nkind (End_Labl) = N_Defining_Identifier |
| or else Nkind (End_Labl) = N_Identifier |
| then |
| End_Labl := Make_Identifier (Token_Ptr, Chars (End_Labl)); |
| |
| elsif Nkind (End_Labl) = N_Defining_Operator_Symbol |
| or else Nkind (End_Labl) = N_Operator_Symbol |
| then |
| Get_Decoded_Name_String (Chars (End_Labl)); |
| |
| End_Labl := |
| Make_Operator_Symbol (Token_Ptr, |
| Chars => Chars (End_Labl), |
| Strval => String_From_Name_Buffer); |
| end if; |
| |
| Set_Comes_From_Source (End_Labl, False); |
| End_Labl_Present := False; |
| |
| -- Do style check for label permitted but not present. Note: |
| -- for the case of a block statement, the label is required |
| -- to be repeated, and this legality rule is enforced |
| -- independently. |
| |
| if Style_Check |
| and then End_Type = E_Name |
| and then Explicit_Start_Label (Scope.Last) |
| and then Nkind (Parent (Scopes (Scope.Last).Labl)) |
| /= N_Block_Statement |
| then |
| Style.No_End_Name (Scopes (Scope.Last).Labl); |
| end if; |
| end if; |
| end if; |
| end if; |
| |
| -- Deal with terminating aspect specifications and following semi- |
| -- colon. We skip this in the case of END RECORD, since in this |
| -- case the aspect specifications and semicolon are handled at |
| -- a higher level. |
| |
| if End_Type /= E_Record then |
| |
| -- Scan aspect specifications |
| |
| if Aspect_Specifications_Present then |
| |
| -- Aspect specifications not allowed |
| |
| if No (Decl) then |
| |
| -- Package declaration case |
| |
| if Is_Loc /= No_Location then |
| Error_Msg_SC |
| ("misplaced aspects for package declaration"); |
| Error_Msg |
| ("info: aspect specifications belong here??", Is_Loc); |
| P_Aspect_Specifications (Empty); |
| |
| -- Other cases where aspect specifications are not allowed |
| |
| else |
| P_Aspect_Specifications (Error); |
| end if; |
| |
| -- Aspect specifications allowed |
| |
| else |
| P_Aspect_Specifications (Decl); |
| end if; |
| |
| -- If no aspect specifications, must have a semicolon |
| |
| elsif End_Type /= E_Record then |
| if Token = Tok_Semicolon then |
| T_Semicolon; |
| |
| -- Semicolon is missing. If the missing semicolon is at the end |
| -- of the line, i.e. we are at the start of the line now, then |
| -- a missing semicolon gets flagged, but is not serious enough |
| -- to consider the END statement to be bad in the sense that we |
| -- are dealing with (i.e. to be suspicious that this END is not |
| -- the END statement we are looking for). |
| |
| -- Similarly, if we are at a colon, we flag it but a colon for |
| -- a semicolon is not serious enough to consider the END to be |
| -- incorrect. Same thing for a period in place of a semicolon. |
| |
| elsif Token_Is_At_Start_Of_Line |
| or else Token in Tok_Colon | Tok_Dot |
| then |
| T_Semicolon; |
| |
| -- If the missing semicolon is not at the start of the line, |
| -- then we consider the END line to be dubious in this sense. |
| |
| else |
| End_OK := False; |
| end if; |
| end if; |
| end if; |
| end if; |
| |
| -- Now we call the Pop_End_Context routine to get a recommendation |
| -- as to what should be done with the END sequence we have scanned. |
| |
| Pop_End_Context; |
| |
| -- Remaining action depends on End_Action set by Pop_End_Context |
| |
| case End_Action is |
| |
| -- Accept_As_Scanned. In this case, Pop_End_Context left Token |
| -- pointing past the last token of a syntactically correct END |
| |
| when Accept_As_Scanned => |
| |
| -- Syntactically correct included the possibility of a missing |
| -- semicolon. If we do have a missing semicolon, then we have |
| -- already given a message, but now we scan out possible rubbish |
| -- on the same line as the END |
| |
| while not Token_Is_At_Start_Of_Line |
| and then Prev_Token not in Tok_Record | Tok_Semicolon |
| and then Token not in Tok_End | Tok_EOF |
| loop |
| Scan; -- past junk |
| end loop; |
| |
| return True; |
| |
| -- Insert_And_Accept. In this case, Pop_End_Context has reset Token |
| -- to point to the start of the END sequence, and recommends that it |
| -- be left in place to satisfy an outer scope level END. This means |
| -- that we proceed as though an END were present, and leave the scan |
| -- pointer unchanged. |
| |
| when Insert_And_Accept => |
| return True; |
| |
| -- Skip_And_Accept. In this case, Pop_End_Context has reset Token |
| -- to point to the start of the END sequence. This END sequence is |
| -- syntactically incorrect, and an appropriate error message has |
| -- already been posted. Pop_End_Context recommends accepting the |
| -- END sequence as the one we want, so we skip past it and then |
| -- proceed as though an END were present. |
| |
| when Skip_And_Accept => |
| End_Skip; |
| return True; |
| |
| -- Skip_And_Reject. In this case, Pop_End_Context has reset Token |
| -- to point to the start of the END sequence. This END sequence is |
| -- syntactically incorrect, and an appropriate error message has |
| -- already been posted. Pop_End_Context recommends entirely ignoring |
| -- this END sequence, so we skip past it and then return False, since |
| -- as far as the caller is concerned, no END sequence is present. |
| |
| when Skip_And_Reject => |
| End_Skip; |
| return False; |
| end case; |
| end Check_End; |
| |
| -------------- |
| -- End Skip -- |
| -------------- |
| |
| -- This procedure skips past an END sequence. On entry Token contains |
| -- Tok_End, and we know that the END sequence is syntactically incorrect, |
| -- and that an appropriate error message has already been posted. The |
| -- mission is simply to position the scan pointer to be the best guess of |
| -- the position after the END sequence. We do not issue any additional |
| -- error messages while carrying this out. |
| |
| -- Error recovery: does not raise Error_Resync |
| |
| procedure End_Skip is |
| begin |
| Scan; -- past END |
| |
| -- If the scan past the END leaves us on the next line, that's probably |
| -- where we should quit the scan, since it is likely that what we have |
| -- is a missing semicolon. Consider the following: |
| |
| -- END |
| -- Process_Input; |
| |
| -- This will have looked like a syntactically valid END sequence to the |
| -- initial scan of the END, but subsequent checking will have determined |
| -- that the label Process_Input is not an appropriate label. The real |
| -- error is a missing semicolon after the END, and by leaving the scan |
| -- pointer just past the END, we will improve the error recovery. |
| |
| if Token_Is_At_Start_Of_Line then |
| return; |
| end if; |
| |
| -- If there is a semicolon after the END, scan it out and we are done |
| |
| if Token = Tok_Semicolon then |
| T_Semicolon; |
| return; |
| end if; |
| |
| -- Otherwise skip past a token after the END on the same line. Note |
| -- that we do not eat a token on the following line since it seems |
| -- very unlikely in any case that the END gets separated from its |
| -- token, and we do not want to swallow up a keyword that starts a |
| -- legitimate construct following the bad END. |
| |
| if not Token_Is_At_Start_Of_Line |
| and then |
| |
| -- Cases of normal tokens following an END |
| |
| (Token = Tok_Case or else |
| Token = Tok_If or else |
| Token = Tok_Loop or else |
| Token = Tok_Record or else |
| Token = Tok_Select or else |
| |
| -- Cases of bogus keywords ending loops |
| |
| Token = Tok_For or else |
| Token = Tok_While or else |
| |
| -- Cases of operator symbol names without quotes |
| |
| Token = Tok_Abs or else |
| Token = Tok_And or else |
| Token = Tok_Mod or else |
| Token = Tok_Not or else |
| Token = Tok_Or or else |
| Token = Tok_Xor) |
| |
| then |
| Scan; -- past token after END |
| |
| -- If that leaves us on the next line, then we are done. This is the |
| -- same principle described above for the case of END at line end |
| |
| if Token_Is_At_Start_Of_Line then |
| return; |
| |
| -- If we just scanned out record, then we are done, since the |
| -- semicolon after END RECORD is not part of the END sequence |
| |
| elsif Prev_Token = Tok_Record then |
| return; |
| |
| -- If we have a semicolon, scan it out and we are done |
| |
| elsif Token = Tok_Semicolon then |
| T_Semicolon; |
| return; |
| end if; |
| end if; |
| |
| -- Check for a label present on the same line |
| |
| loop |
| if Token_Is_At_Start_Of_Line then |
| return; |
| end if; |
| |
| if Token not in |
| Tok_Identifier | Tok_Operator_Symbol | Tok_String_Literal |
| then |
| exit; |
| end if; |
| |
| Scan; -- past identifier, operator symbol or string literal |
| |
| if Token_Is_At_Start_Of_Line then |
| return; |
| elsif Token = Tok_Dot then |
| Scan; -- past dot |
| end if; |
| end loop; |
| |
| -- Skip final semicolon |
| |
| if Token = Tok_Semicolon then |
| T_Semicolon; |
| |
| -- If we don't have a final semicolon, skip until we either encounter |
| -- an END token, or a semicolon or the start of the next line. This |
| -- allows general junk to follow the end line (normally it is hard to |
| -- think that anyone will put anything deliberate here, and remember |
| -- that we know there is a missing semicolon in any case). We also |
| -- quite on an EOF (or else we would get stuck in an infinite loop |
| -- if there is no line end at the end of the last line of the file) |
| |
| else |
| while Token not in Tok_End | Tok_EOF | Tok_Semicolon |
| and then not Token_Is_At_Start_Of_Line |
| loop |
| Scan; -- past junk token on same line |
| end loop; |
| end if; |
| |
| return; |
| end End_Skip; |
| |
| -------------------- |
| -- End Statements -- |
| -------------------- |
| |
| -- This procedure is called when END is required or expected to terminate |
| -- a sequence of statements. The caller has already made an appropriate |
| -- entry on the scope stack to describe the expected form of the END. |
| -- End_Statements should only be used in cases where the only appropriate |
| -- terminator is END. |
| |
| -- Error recovery: cannot raise Error_Resync; |
| |
| procedure End_Statements |
| (Parent : Node_Id := Empty; |
| Decl : Node_Id := Empty; |
| Is_Sloc : Source_Ptr := No_Location) |
| is |
| begin |
| -- This loop runs more than once in the case where Check_End rejects |
| -- the END sequence, as indicated by Check_End returning False. |
| |
| loop |
| if Check_End (Decl, Is_Sloc) then |
| if Present (Parent) then |
| Set_End_Label (Parent, End_Labl); |
| end if; |
| |
| return; |
| end if; |
| |
| -- Extra statements past the bogus END are discarded. This is not |
| -- ideal for maximum error recovery, but it's too much trouble to |
| -- find an appropriate place to put them. |
| |
| Discard_Junk_List (P_Sequence_Of_Statements (SS_None)); |
| end loop; |
| end End_Statements; |
| |
| ------------------------ |
| -- Evaluate End Entry -- |
| ------------------------ |
| |
| procedure Evaluate_End_Entry (SS_Index : Nat) is |
| STE : Scope_Table_Entry renames Scopes (SS_Index).all; |
| |
| begin |
| Column_OK := (End_Column = STE.Ecol); |
| |
| Token_OK := (End_Type = STE.Etyp |
| or else (End_Type = E_Name and then STE.Etyp >= E_Name)); |
| |
| Label_OK := End_Labl_Present |
| and then (Same_Label (End_Labl, STE.Labl) |
| or else STE.Labl = Error); |
| |
| -- Special case to consider. Suppose we have the suspicious label case, |
| -- e.g. a situation like: |
| |
| -- My_Label; |
| -- declare |
| -- ... |
| -- begin |
| -- ... |
| -- end My_Label; |
| |
| -- This is the case where we want to use the entry in the suspicious |
| -- label table to flag the semicolon saying it should be a colon. |
| |
| -- Label_OK will be false because the label does not match (we have |
| -- My_Label on the end line, and the generated name for the scope). Also |
| -- End_Labl_Present will be True. |
| |
| if not Label_OK |
| and then End_Labl_Present |
| and then not Comes_From_Source (Scopes (SS_Index).Labl) |
| then |
| -- Here is where we will search the suspicious labels table |
| |
| for J in 1 .. Suspicious_Labels.Last loop |
| declare |
| SLE : Suspicious_Label_Entry renames |
| Suspicious_Labels.Table (J); |
| begin |
| -- See if character name of label matches |
| |
| if Chars (Name (SLE.Proc_Call)) = Chars (End_Labl) |
| |
| -- And first token of loop/block identifies this entry |
| |
| and then SLE.Start_Token = STE.Sloc |
| then |
| -- We have the special case, issue the error message |
| |
| Error_Msg -- CODEFIX |
| (""";"" should be "":""", SLE.Semicolon_Loc); |
| |
| -- And indicate we consider the Label OK after all |
| |
| Label_OK := True; |
| exit; |
| end if; |
| end; |
| end loop; |
| end if; |
| |
| -- Compute setting of Syntax_OK. We definitely have a syntax error |
| -- if the Token does not match properly or if P_End_Scan detected |
| -- a syntax error such as a missing semicolon. |
| |
| if not Token_OK or not End_OK then |
| Syntax_OK := False; |
| |
| -- Final check is that label is OK. Certainly it is OK if there |
| -- was an exact match on the label (the END label = the stack label) |
| |
| elsif Label_OK then |
| Syntax_OK := True; |
| |
| -- Case of label present |
| |
| elsif End_Labl_Present then |
| |
| -- If probably misspelling, then complain, and pretend it is OK |
| |
| declare |
| Nam : constant Node_Or_Entity_Id := Scopes (SS_Index).Labl; |
| |
| begin |
| if Nkind (End_Labl) in N_Has_Chars |
| and then Comes_From_Source (Nam) |
| and then Nkind (Nam) in N_Has_Chars |
| and then Chars (End_Labl) > Error_Name |
| and then Chars (Nam) > Error_Name |
| then |
| Error_Msg_Name_1 := Chars (Nam); |
| |
| if Error_Msg_Name_1 > Error_Name then |
| if Is_Bad_Spelling_Of (Chars (Nam), Chars (End_Labl)) then |
| Error_Msg_Name_1 := Chars (Nam); |
| Error_Msg_N -- CODEFIX |
| ("misspelling of %", End_Labl); |
| Syntax_OK := True; |
| return; |
| end if; |
| end if; |
| end if; |
| end; |
| |
| Syntax_OK := False; |
| |
| -- Otherwise we have cases of no label on the END line. For the loop |
| -- case, this is acceptable only if the loop is unlabeled. |
| |
| elsif End_Type = E_Loop then |
| Syntax_OK := not Explicit_Start_Label (SS_Index); |
| |
| -- Cases where a label is definitely allowed on the END line |
| |
| elsif End_Type = E_Name then |
| Syntax_OK := (not Explicit_Start_Label (SS_Index)) |
| or else |
| (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. |
| |
| else |
| Syntax_OK := True; |
| end if; |
| end Evaluate_End_Entry; |
| |
| -------------------------- |
| -- Explicit_Start_Label -- |
| -------------------------- |
| |
| function Explicit_Start_Label (SS_Index : Nat) return Boolean is |
| L : constant Node_Id := Scopes (SS_Index).Labl; |
| Etyp : constant SS_End_Type := Scopes (SS_Index).Etyp; |
| |
| begin |
| if No (L) then |
| return False; |
| |
| -- In the following test we protect the call to Comes_From_Source |
| -- against lines containing previously reported syntax errors. |
| |
| elsif (Etyp = E_Loop or else |
| Etyp = E_Name or else |
| Etyp = E_Suspicious_Is or else |
| Etyp = E_Bad_Is) |
| and then Comes_From_Source (L) |
| then |
| return True; |
| |
| else |
| return False; |
| end if; |
| end Explicit_Start_Label; |
| |
| ------------------------ |
| -- Output_End_Deleted -- |
| ------------------------ |
| |
| procedure Output_End_Deleted is |
| begin |
| if End_Type = E_Loop then |
| Error_Msg_SC ("no LOOP for this `END LOOP`!"); |
| |
| elsif End_Type = E_Case then |
| Error_Msg_SC ("no CASE for this `END CASE`"); |
| |
| elsif End_Type = E_If then |
| Error_Msg_SC ("no IF for this `END IF`!"); |
| |
| elsif End_Type = E_Record then |
| Error_Msg_SC ("no RECORD for this `END RECORD`!"); |
| |
| elsif End_Type = E_Return then |
| Error_Msg_SC ("no RETURN for this `END RETURN`!"); |
| |
| elsif End_Type = E_Select then |
| Error_Msg_SC ("no SELECT for this `END SELECT`!"); |
| |
| else |
| Error_Msg_SC ("no BEGIN for this END!"); |
| end if; |
| end Output_End_Deleted; |
| |
| ------------------------- |
| -- Output_End_Expected -- |
| ------------------------- |
| |
| procedure Output_End_Expected (Ins : Boolean) is |
| End_Type : SS_End_Type; |
| |
| begin |
| -- Suppress message if this was a potentially junk entry (e.g. a record |
| -- entry where no record keyword was present). |
| |
| if Scopes (Scope.Last).Junk then |
| return; |
| end if; |
| |
| 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 := Scopes (Scope.Last).Labl; |
| else |
| Error_Msg_Node_1 := Empty; |
| end if; |
| |
| -- Suppress message if error was posted on opening label |
| |
| if Error_Msg_Node_1 > Empty_Or_Error |
| and then Error_Posted (Error_Msg_Node_1) |
| then |
| return; |
| end if; |
| |
| if End_Type = E_Case then |
| Error_Msg_SC -- CODEFIX |
| ("`END CASE;` expected@ for CASE#!"); |
| |
| elsif End_Type = E_If then |
| Error_Msg_SC -- CODEFIX |
| ("`END IF;` expected@ for IF#!"); |
| |
| elsif End_Type = E_Loop then |
| if Error_Msg_Node_1 = Empty then |
| Error_Msg_SC -- CODEFIX |
| ("`END LOOP;` expected@ for LOOP#!"); |
| else |
| Error_Msg_SC -- CODEFIX |
| ("`END LOOP &;` expected@!"); |
| end if; |
| |
| elsif End_Type = E_Record then |
| Error_Msg_SC -- CODEFIX |
| ("`END RECORD;` expected@ for RECORD#!"); |
| |
| elsif End_Type = E_Return then |
| Error_Msg_SC -- CODEFIX |
| ("`END RETURN;` expected@ for RETURN#!"); |
| |
| elsif End_Type = E_Select then |
| Error_Msg_SC -- CODEFIX |
| ("`END SELECT;` expected@ for SELECT#!"); |
| |
| -- All remaining cases are cases with a name (we do not treat the |
| -- suspicious is cases specially for a replaced end, only for an |
| -- inserted end). |
| |
| elsif End_Type = E_Name or else not Ins then |
| if Error_Msg_Node_1 = Empty then |
| Error_Msg_SC -- CODEFIX |
| ("`END;` expected@ for BEGIN#!"); |
| else |
| Error_Msg_SC -- CODEFIX |
| ("`END &;` expected@!"); |
| end if; |
| |
| -- The other possibility is a missing END for a subprogram with a |
| -- suspicious IS (that probably should have been a semicolon). The |
| -- missing IS confirms the suspicion. |
| |
| else -- End_Type = E_Suspicious_Is or E_Bad_Is |
| Scopes (Scope.Last).Etyp := E_Bad_Is; |
| end if; |
| end Output_End_Expected; |
| |
| ------------------------ |
| -- Output_End_Missing -- |
| ------------------------ |
| |
| procedure Output_End_Missing is |
| End_Type : SS_End_Type; |
| |
| begin |
| -- Suppress message if this was a potentially junk entry (e.g. a record |
| -- entry where no record keyword was present). |
| |
| if Scopes (Scope.Last).Junk then |
| return; |
| end if; |
| |
| End_Type := Scopes (Scope.Last).Etyp; |
| Error_Msg_Sloc := Scopes (Scope.Last).Sloc; |
| |
| if Explicit_Start_Label (Scope.Last) then |
| Error_Msg_Node_1 := Scopes (Scope.Last).Labl; |
| else |
| Error_Msg_Node_1 := Empty; |
| end if; |
| |
| if End_Type = E_Case then |
| Error_Msg_BC ("missing `END CASE;` for CASE#!"); |
| |
| elsif End_Type = E_If then |
| Error_Msg_BC ("missing `END IF;` for IF#!"); |
| |
| elsif End_Type = E_Loop then |
| if Error_Msg_Node_1 = Empty then |
| Error_Msg_BC ("missing `END LOOP;` for LOOP#!"); |
| else |
| Error_Msg_BC ("missing `END LOOP &;`!"); |
| end if; |
| |
| elsif End_Type = E_Record then |
| Error_Msg_SC |
| ("missing `END RECORD;` for RECORD#!"); |
| |
| elsif End_Type = E_Return then |
| Error_Msg_SC |
| ("missing `END RETURN;` for RETURN#!"); |
| |
| elsif End_Type = E_Select then |
| Error_Msg_BC |
| ("missing `END SELECT;` for SELECT#!"); |
| |
| elsif End_Type = E_Name then |
| if Error_Msg_Node_1 = Empty then |
| Error_Msg_BC ("missing `END;` for BEGIN#!"); |
| else |
| Error_Msg_BC ("missing `END &;`!"); |
| end if; |
| |
| else -- End_Type = E_Suspicious_Is or E_Bad_Is |
| Scopes (Scope.Last).Etyp := E_Bad_Is; |
| end if; |
| end Output_End_Missing; |
| |
| --------------------- |
| -- Pop_End_Context -- |
| --------------------- |
| |
| procedure Pop_End_Context is |
| |
| Pretty_Good : Boolean; |
| -- This flag is set True if the END sequence is syntactically incorrect, |
| -- but is (from a heuristic point of view), pretty likely to be simply |
| -- a misspelling of the intended END. |
| |
| Outer_Match : Boolean; |
| -- This flag is set True if we decide that the current END sequence |
| -- belongs to some outer level entry in the scope stack, and thus |
| -- we will NOT eat it up in matching the current expected END. |
| |
| begin |
| -- If not at END, then output END expected message |
| |
| if End_Type = E_Dummy then |
| Output_End_Missing; |
| Pop_Scope_Stack; |
| End_Action := Insert_And_Accept; |
| return; |
| |
| -- Otherwise we do have an END present |
| |
| else |
| -- A special check. If we have END; followed by an end of file, |
| -- WITH or SEPARATE, then if we are not at the outer level, then |
| -- we have a syntax error. Consider the example: |
| |
| -- ... |
| -- declare |
| -- X : Integer; |
| -- begin |
| -- X := Father (A); |
| -- Process (X, X); |
| -- end; |
| -- with Package1; |
| -- ... |
| |
| -- Now the END; here is a syntactically correct closer for the |
| -- declare block, but if we eat it up, then we obviously have |
| -- a missing END for the outer context (since WITH can only appear |
| -- at the outer level. |
| |
| -- In this situation, we always reserve the END; for the outer level, |
| -- even if it is in the wrong column. This is because it's much more |
| -- useful to have the error message point to the DECLARE than to the |
| -- package header in this case. |
| |
| -- We also reserve an end with a name before the end of file if the |
| -- name is the one we expect at the outer level. |
| |
| if (Token = Tok_EOF or else |
| Token = Tok_With or else |
| Token = Tok_Separate) |
| and then End_Type >= E_Name |
| and then (not End_Labl_Present |
| or else Same_Label (End_Labl, Scopes (1).Labl)) |
| and then Scope.Last > 1 |
| then |
| Restore_Scan_State (Scan_State); -- to END |
| Output_End_Expected (Ins => True); |
| Pop_Scope_Stack; |
| End_Action := Insert_And_Accept; |
| return; |
| end if; |
| |
| -- Otherwise we go through the normal END evaluation procedure |
| |
| Evaluate_End_Entry (Scope.Last); |
| |
| -- If top entry in stack is syntactically correct, then we have |
| -- scanned it out and everything is fine. This is the required |
| -- action to properly process correct Ada programs. |
| |
| if Syntax_OK then |
| |
| -- Complain if checking columns and END is not in right column. |
| -- Right in this context means exactly right, or on the same |
| -- line as the opener. |
| |
| if RM_Column_Check then |
| 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 (Scopes (Scope.Last).Etyp /= E_Record |
| or else Get_Column_Number (End_Sloc) /= |
| Get_Column_Number (Type_Token_Location)) |
| then |
| Error_Msg_Col := Scopes (Scope.Last).Ecol; |
| Error_Msg |
| ("(style) END in wrong column, should be@", End_Sloc); |
| end if; |
| end if; |
| |
| -- One final check. If the end had a label, check for an exact |
| -- duplicate of this end sequence, and if so, skip it with an |
| -- appropriate message. |
| |
| if End_Labl_Present and then Token = Tok_End then |
| declare |
| Scan_State : Saved_Scan_State; |
| End_Loc : constant Source_Ptr := Token_Ptr; |
| Nxt_Labl : Node_Id; |
| Dup_Found : Boolean := False; |
| |
| begin |
| Save_Scan_State (Scan_State); |
| |
| Scan; -- past END |
| |
| if Token in Tok_Identifier | Tok_Operator_Symbol then |
| Nxt_Labl := P_Designator; |
| |
| -- We only consider it an error if the label is a match |
| -- and would be wrong for the level one above us, and |
| -- the indentation is the same. |
| |
| if Token = Tok_Semicolon |
| and then Same_Label (End_Labl, Nxt_Labl) |
| and then End_Column = Start_Column |
| and then |
| (Scope.Last = 1 |
| or else |
| (not Explicit_Start_Label (Scope.Last - 1)) |
| or else |
| (not Same_Label |
| (End_Labl, |
| Scopes (Scope.Last - 1).Labl))) |
| then |
| T_Semicolon; |
| Error_Msg ("duplicate end line ignored", End_Loc); |
| Dup_Found := True; |
| end if; |
| end if; |
| |
| if not Dup_Found then |
| Restore_Scan_State (Scan_State); |
| end if; |
| end; |
| end if; |
| |
| -- All OK, so return to caller indicating END is OK |
| |
| Pop_Scope_Stack; |
| End_Action := Accept_As_Scanned; |
| return; |
| end if; |
| |
| -- If that check failed, then we definitely have an error. The issue |
| -- is how to choose among three possible courses of action: |
| |
| -- 1. Ignore the current END text completely, scanning past it, |
| -- deciding that it belongs neither to the current context, |
| -- nor to any outer context. |
| |
| -- 2. Accept the current END text, scanning past it, and issuing |
| -- an error message that it does not have the right form. |
| |
| -- 3. Leave the current END text in place, NOT scanning past it, |
| -- issuing an error message indicating the END expected for the |
| -- current context. In this case, the END is available to match |
| -- some outer END context. |
| |
| -- From a correct functioning point of view, it does not make any |
| -- difference which of these three approaches we take, the program |
| -- will work correctly in any case. However, making an accurate |
| -- choice among these alternatives, i.e. choosing the one that |
| -- corresponds to what the programmer had in mind, does make a |
| -- significant difference in the quality of error recovery. |
| |
| Restore_Scan_State (Scan_State); -- to END |
| |
| -- First we see how good the current END entry is with respect to |
| -- what we expect. It is considered pretty good if the token is OK, |
| -- and either the label or the column matches. An END for RECORD is |
| -- always considered to be pretty good in the record case. This is |
| -- because not only does a record disallow a nested structure, but |
| -- also it is unlikely that such nesting could occur by accident. |
| |
| Pretty_Good := (Token_OK and (Column_OK or Label_OK)) |
| 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 |
| -- the END entry we want, leaving the higher level entry for later |
| |
| for J in reverse 1 .. Scope.Last - 1 loop |
| Evaluate_End_Entry (J); |
| |
| -- To even consider the deeper entry to be immediately acceptable, |
| -- it must be syntactically correct. Furthermore it must either |
| -- have a correct label, or the correct column. If the current |
| -- entry was a close match (Pretty_Good set), then we are even |
| -- more strict in accepting the outer level one: even if it has |
| -- the right label, it must have the right column as well. |
| |
| if Syntax_OK then |
| if Pretty_Good then |
| Outer_Match := Label_OK and Column_OK; |
| else |
| Outer_Match := Label_OK or Column_OK; |
| end if; |
| else |
| Outer_Match := False; |
| end if; |
| |
| -- If the outer entry does convincingly match the END text, then |
| -- back up the scan to the start of the END sequence, issue an |
| -- error message indicating the END we expected, and return with |
| -- Token pointing to the END (case 3 from above discussion). |
| |
| if Outer_Match then |
| Output_End_Missing; |
| Pop_Scope_Stack; |
| End_Action := Insert_And_Accept; |
| return; |
| end if; |
| end loop; |
| |
| -- Here we have a situation in which the current END entry is |
| -- syntactically incorrect, but there is no deeper entry in the |
| -- END stack which convincingly matches it. |
| |
| -- If the END text was judged to be a Pretty_Good match for the |
| -- expected token or if it appears left of the expected column, |
| -- then we will accept it as the one we want, scanning past it, even |
| -- though it is not completely right (we issue a message showing what |
| -- we expected it to be). This is action 2 from the discussion above. |
| -- There is one other special case to consider: the LOOP case. |
| -- Consider the example: |
| |
| -- Lbl: loop |
| -- null; |
| -- end loop; |
| |
| -- Here the column lines up with Lbl, so END LOOP is to the right, |
| -- but it is still acceptable. LOOP is the one case where alignment |
| -- practices vary substantially in practice. |
| |
| if Pretty_Good |
| 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); |
| Pop_Scope_Stack; |
| End_Action := Skip_And_Accept; |
| return; |
| |
| -- Here we have the case where the END is to the right of the |
| -- expected column and does not have a correct label to convince |
| -- us that it nevertheless belongs to the current scope. For this |
| -- we consider that it probably belongs not to the current context, |
| -- but to some inner context that was not properly recognized (due to |
| -- other syntax errors), and for which no proper scope stack entry |
| -- was made. The proper action in this case is to delete the END text |
| -- and return False to the caller as a signal to keep on looking for |
| -- an acceptable END. This is action 1 from the discussion above. |
| |
| else |
| Output_End_Deleted; |
| End_Action := Skip_And_Reject; |
| return; |
| end if; |
| end if; |
| end Pop_End_Context; |
| |
| ---------------- |
| -- Same_Label -- |
| ---------------- |
| |
| function Same_Label (Label1, Label2 : Node_Id) return Boolean is |
| begin |
| if Nkind (Label1) in N_Has_Chars |
| and then Nkind (Label2) in N_Has_Chars |
| then |
| return Chars (Label1) = Chars (Label2); |
| |
| elsif Nkind (Label1) = N_Selected_Component |
| and then Nkind (Label2) = N_Selected_Component |
| then |
| return Same_Label (Prefix (Label1), Prefix (Label2)) and then |
| Same_Label (Selector_Name (Label1), Selector_Name (Label2)); |
| |
| elsif Nkind (Label1) = N_Designator |
| and then Nkind (Label2) = N_Defining_Program_Unit_Name |
| then |
| return Same_Label (Name (Label1), Name (Label2)) and then |
| Same_Label (Identifier (Label1), Defining_Identifier (Label2)); |
| |
| else |
| return False; |
| end if; |
| end Same_Label; |
| |
| end Endh; |
