Geek Gadgets 1

home *** CD-ROM | disk | FTP | other *** search

/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / par-endh.adb < prev next >

Wrap

Text File | 1996-09-28 | 35KB | 933 lines

------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- P A R . E N D H -- -- -- -- B o d y -- -- -- -- $Revision: 1.33 $ -- -- -- -- Copyright (c) 1992,1993,1994 NYU, All Rights Reserved -- -- -- -- 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 2, 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 COPYING. If not, write -- -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -- -- -- ------------------------------------------------------------------------------ separate (Par) package body Endh is ---------------- -- Local Data -- ---------------- 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 name on END line, or Empty if no name appeared. If -- this is non-empty, then it is either an N_Designator node for a child -- unit or a node with a Chars field that identifies the actual 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 -- or (a special case added in version 1.3) if we have the END RECORD -- case. Since RECORD cannot nest, this is as good as a matching label -- for being sure that we have the right one! 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 Check_Label (Label1, Label2 : Node_Id); -- Given two labels, which are known to match, i.e. a call to Same_Label -- for Label1, Label2 previously returned True, determines if the spelling -- meets the style checking rules. Check_Label is called only if the -- Style_Check mode is set on. procedure Evaluate_End_Entry (SS_Index : Int); -- 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. 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; -- 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. Note that in the case of a -- suspicious IS, 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. 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 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 begin -- 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 -- Cases of keywords where no label is allowed if Token = Tok_Case then End_Type := E_Case; End_Labl := Empty; Scan; -- past CASE elsif Token = Tok_If then End_Type := E_If; End_Labl := Empty; Scan; -- past IF elsif Token = Tok_Record then End_Type := E_Record; End_Labl := Empty; Scan; -- past RECORD elsif Token = Tok_Select then End_Type := E_Select; End_Labl := Empty; 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 elsif Token = Tok_For or else Token = Tok_While 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; -- 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, Scope.Table (Scope.Last).Labl) then Restore_Scan_State (Name_Scan_State); End_Labl := Empty; end if; end if; -- Here for case of name allowed, but no name present else End_Labl := Empty; if Style_Check and then End_Type = E_Name and then Present (Scope.Table (Scope.Last).Labl) then Style.No_End (Scope.Table (Scope.Last).Labl); end if; end if; end if; -- Except in case of END RECORD, semicolon must follow. For END -- RECORD, a semicolon does follow, but it is part of a higher level -- construct. In any case, a missing semicolon 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 it is not in fact -- the END statement we are looking for!) if End_Type /= E_Record then T_Semicolon; 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 /= Tok_Record and then Prev_Token /= Tok_Semicolon and then Token /= Tok_End and then Token /= 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; ----------------- -- Check_Label -- ----------------- -- This is a simple recursive routine that checks the separate components -- of a child unit label one by one. Compare coding to Same_Label, but -- note that tests can be simplified because we know that Label1 and -- Label2 have already passed the Same_Label test, since Check_Label -- is only called if Label_OK is set to True. procedure Check_Label (Label1, Label2 : Node_Id) is begin if Nkind (Label1) in N_Has_Chars then if Nkind (Label1) = N_Identifier then Style.Check_Identifier (Label1, Label2); end if; elsif Nkind (Label1) = N_Selected_Component then Check_Label (Prefix (Label1), Prefix (Label2)); Check_Label (Selector_Name (Label1), Selector_Name (Label2)); else Check_Label (Name (Label1), Name (Label2)); Check_Label (Identifier (Label1), Defining_Identifier (Label2)); end if; end Check_Label; -------------- -- 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 Scan; -- past semicolon return; end if; -- Otherwise skip past a token after the END. Note that we skip past -- for or while, to allow END for and END while to substitute for -- END loop (of course an error message has already been issued). if Token = Tok_Case or else Token = Tok_For or else Token = Tok_If or else Token = Tok_Loop or else Token = Tok_Record or else Token = Tok_Select or else Token = Tok_While 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 Scan; -- past 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 /= Tok_Identifier and then Token /= Tok_Operator_Symbol and then Token /= 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 Scan; -- past 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 /= Tok_End and then Token /= Tok_EOF and then Token /= 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 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 then 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 : Int) is begin Column_OK := (End_Column = Scope.Table (SS_Index).Ecol); Token_OK := (End_Type = Scope.Table (SS_Index).Etyp or else (End_Type = E_Name and then Scope.Table (SS_Index).Etyp >= E_Name)); Label_OK := (Token_OK and then End_Type = E_Record) or else (Present (End_Labl) and then (Same_Label (End_Labl, Scope.Table (SS_Index).Labl) or else Scope.Table (SS_Index).Labl = Error)); -- 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; return; end if; -- 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) if Label_OK then Syntax_OK := True; return; end if; -- If there was a label and it did not match, then we definitely -- do have a syntax error. if Present (End_Labl) then Syntax_OK := False; return; end if; -- Otherwise we have cases of no label on the END line. For the loop -- case, this is acceptable only if the loop is unlabeled. if End_Type = E_Loop then Syntax_OK := (Scope.Table (SS_Index).Labl = Empty); return; -- Cases where a label is definitely allowed on the END line elsif End_Type = E_Name then Syntax_OK := (Scope.Table (SS_Index).Labl = Empty or else not Scope.Table (SS_Index).Lreq); return; -- 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; return; end if; end Evaluate_End_Entry; ------------------------ -- 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_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 is End_Type : SS_End_Type; begin End_Type := Scope.Table (Scope.Last).Etyp; Error_Msg_Col := Scope.Table (Scope.Last).Ecol; Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl; Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc; if End_Type = E_Case then Error_Msg_SC ("`END CASE;` expected@ for CASE#!"); elsif End_Type = E_If then Error_Msg_SC ("`END IF;` expected@ for IF#!"); elsif End_Type = E_Loop then if Error_Msg_Node_1 = Empty then Error_Msg_SC ("`END LOOP;` expected@ for LOOP#!"); else Error_Msg_SC ("`END LOOP&;` expected@!"); end if; elsif End_Type = E_Record then Error_Msg_SC ("`END RECORD;` expected@ for RECORD#!"); elsif End_Type = E_Select then Error_Msg_SC ("`END SELECT;` expected@ for SELECT#!"); elsif End_Type = E_Name then if Error_Msg_Node_1 = Empty then Error_Msg_SC ("`END;` expected@ for BEGIN#!"); else Error_Msg_SC ("`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 Scope.Table (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 End_Type := Scope.Table (Scope.Last).Etyp; Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl; Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc; 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_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 Scope.Table (Scope.Last).Etyp := E_Bad_Is; end if; end Output_End_Missing; ---------------- -- 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; --------------------- -- Pop End Context -- --------------------- procedure Pop_End_Context is Pretty_Good : Boolean; -- This flag is set True if the END sequence is syntactically incorrect, -- but has the right token type and the right column (this means that -- it is wrong only in lacking a semicolon or having the wrong label) 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 sytax 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. if (Token = Tok_EOF or else Token = Tok_With or else Token = Tok_Separate) and then End_Type >= E_Name and then No (End_Labl) and then Scope.Last > 1 then Restore_Scan_State (Scan_State); -- to END Output_End_Expected; 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 /= Scope.Table (Scope.Last).Ecol and then Current_Line_Start > Scope.Table (Scope.Last).Sloc then Error_Msg_Col := Scope.Table (Scope.Last).Ecol; Error_Msg ("END in wrong column, should be@", End_Sloc); end if; end if; -- If label was present, check its spelling if (Style_Check and Label_OK) and then Present (End_Labl) then Check_Label (End_Labl, Scope.Table (Scope.Last).Labl); 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. Pretty_Good := Token_OK and (Column_OK or Label_OK); -- 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 <= Scope.Table (Scope.Last).Ecol or else (End_Type = Scope.Table (Scope.Last).Etyp and then End_Type = E_Loop) then Output_End_Expected; 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; end Endh;