1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Stringt; use Stringt;
27 with Uintp; use Uintp;
29 with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
38 type End_Action_Type is (
39 -- Type used to describe the result of the Pop_End_Context call
42 -- Current end sequence is entirely c correct. In this case Token and
43 -- the scan pointer are left pointing past the end sequence (i.e. they
44 -- are unchanged from the values set on entry to Pop_End_Context).
47 -- Current end sequence is to be left in place to satisfy some outer
48 -- scope. Token and the scan pointer are set to point to the end
49 -- token, and should be left there. A message has been generated
50 -- indicating a missing end sequence. This status is also used for
51 -- the case when no end token is present.
54 -- The end sequence is incorrect (and an error message has been
55 -- posted), but it will still be accepted. In this case Token and
56 -- the scan pointer point back to the end token, and the caller
57 -- should skip past the end sequence before proceeding.
60 -- The end sequence is judged to belong to an unrecognized inner
61 -- scope. An appropriate message has been issued and the caller
62 -- should skip past the end sequence and then proceed as though
63 -- no end sequence had been encountered.
65 End_Action : End_Action_Type;
66 -- The variable set by Pop_End_Context call showing which of the four
67 -- decisions described above is judged the best.
69 End_Sloc : Source_Ptr;
70 -- Source location of END token
73 -- Set False if error is found in END line
75 End_Column : Column_Number;
78 End_Type : SS_End_Type;
79 -- Type of END expected. The special value E_Dummy is set to indicate that
80 -- no END token was present (so a missing END inserted message is needed)
83 -- Node_Id value for explicit name on END line, or for compiler supplied
84 -- name in the case where an optional name is not given. Empty if no name
85 -- appears. If non-empty, then it is either an N_Designator node for a
86 -- child unit or a node with a Chars field identifying the actual label.
88 End_Labl_Present : Boolean;
89 -- Indicates that the value in End_Labl was for an explicit label
92 -- Set True if the entry is syntactically correct
95 -- Set True if the keyword in the END sequence matches, or if neither
96 -- the END sequence nor the END stack entry has a keyword.
99 -- Set True if both the END sequence and the END stack entry contained
100 -- labels (other than No_Name or Error_Name) and the labels matched.
101 -- This is a stronger condition than SYNTAX_OK, since it means that a
102 -- label was present, even in a case where it was optional. Note that
103 -- the case of no label required, and no label present does NOT set
104 -- Label_OK to True, it is True only if a positive label match is found.
107 -- Column_OK is set True if the END sequence appears in the expected column
109 Scan_State : Saved_Scan_State;
110 -- Save state at start of END sequence, in case we decide not to eat it up
112 -----------------------
113 -- Local Subprograms --
114 -----------------------
116 procedure Evaluate_End_Entry (SS_Index : Nat);
117 -- Compare scanned END entry (as recorded by a prior call to P_End_Scan)
118 -- with a specified entry in the scope stack (the single parameter is the
119 -- entry index in the scope stack). Note that Scan is not called. The above
120 -- variables xxx_OK are set to indicate the result of the evaluation.
122 function Explicit_Start_Label (SS_Index : Nat) return Boolean;
123 -- Determines whether the specified entry in the scope stack has an
124 -- explicit start label (i.e. one other than one that was created by
125 -- the parser when no explicit label was present)
127 procedure Output_End_Deleted;
128 -- Output a message complaining that the current END structure does not
129 -- match anything and is being deleted.
131 procedure Output_End_Expected (Ins : Boolean);
132 -- Output a message at the start of the current token which is always an
133 -- END, complaining that the END is not of the right form. The message
134 -- indicates the expected form. The information for the message is taken
135 -- from the top entry in the scope stack. The Ins parameter is True if
136 -- an end is being inserted, and false if an existing end is being
137 -- replaced. Note that in the case of a suspicious IS for the Ins case,
138 -- we do not output the message, but instead simply mark the scope stack
139 -- entry as being a case of a bad IS.
141 procedure Output_End_Missing;
142 -- Output a message just before the current token, complaining that the
143 -- END is not of the right form. The message indicates the expected form.
144 -- The information for the message is taken from the top entry in the
145 -- scope stack. Note that in the case of a suspicious IS, we do not output
146 -- the message, but instead simply mark the scope stack entry as a bad IS.
148 procedure Pop_End_Context;
149 -- Pop_End_Context is called after processing a construct, to pop the
150 -- top entry off the end stack. It decides on the appropriate action to
151 -- to take, signalling the result by setting End_Action as described in
152 -- the global variable section.
154 function Same_Label (Label1, Label2 : Node_Id) return Boolean;
155 -- This function compares the two names associated with the given nodes.
156 -- If they are both simple (i.e. have Chars fields), then they have to
157 -- be the same name. Otherwise they must both be N_Selected_Component
158 -- nodes, referring to the same set of names, or Label1 is an N_Designator
159 -- referring to the same set of names as the N_Defining_Program_Unit_Name
160 -- in Label2. Any other combination returns False. This routine is used
161 -- to compare the End_Labl scanned from the End line with the saved label
162 -- value in the scope stack.
168 function Check_End return Boolean is
169 Name_On_Separate_Line : Boolean;
170 -- Set True if the name on an END line is on a separate source line
171 -- from the END. This is highly suspicious, but is allowed. The point
172 -- is that we want to make sure that we don't just have a missing
173 -- semicolon misleading us into swallowing an identifier from the
176 Name_Scan_State : Saved_Scan_State;
177 -- Save state at start of name if Name_On_Separate_Line is TRUE
179 Span_Node : constant Node_Id := Scope.Table (Scope.Last).Node;
182 End_Labl_Present := False;
185 -- Our first task is to scan out the END sequence if one is present.
186 -- If none is present, signal by setting End_Type to E_Dummy.
188 if Token /= Tok_End then
192 Save_Scan_State (Scan_State); -- at END
193 End_Sloc := Token_Ptr;
194 End_Column := Start_Column;
198 -- Set End_Span if expected. note that this will be useless
199 -- if we do not have the right ending keyword, but in this
200 -- case we have a malformed program anyway, and the setting
201 -- of End_Span will simply be unreliable in this case anyway.
203 if Present (Span_Node) then
204 Set_End_Location (Span_Node, Token_Ptr);
207 -- Cases of keywords where no label is allowed
209 if Token = Tok_Case then
213 elsif Token = Tok_If then
217 elsif Token = Tok_Record then
218 End_Type := E_Record;
221 elsif Token = Tok_Return then
222 End_Type := E_Return;
225 elsif Token = Tok_Select then
226 End_Type := E_Select;
229 -- Cases which do allow labels
234 if Token = Tok_Loop then
238 -- FOR or WHILE allowed (signalling error) to substitute for LOOP
239 -- if on the same line as the END
241 elsif (Token = Tok_For or else Token = Tok_While)
242 and then not Token_Is_At_Start_Of_Line
244 Scan; -- past FOR or WHILE
248 -- Cases with no keyword
254 -- Now see if a name is present
256 if Token = Tok_Identifier or else
257 Token = Tok_String_Literal or else
258 Token = Tok_Operator_Symbol
260 if Token_Is_At_Start_Of_Line then
261 Name_On_Separate_Line := True;
262 Save_Scan_State (Name_Scan_State);
264 Name_On_Separate_Line := False;
267 End_Labl := P_Designator;
268 End_Labl_Present := True;
270 -- We have now scanned out a name. Here is where we do a check
271 -- to catch the cases like:
276 -- where the missing semicolon might make us swallow up the X
277 -- as a bogus end label. In a situation like this, where the
278 -- apparent name is on a separate line, we accept it only if
279 -- it matches the label and is followed by a semicolon.
281 if Name_On_Separate_Line then
282 if Token /= Tok_Semicolon or else
283 not Same_Label (End_Labl, Scope.Table (Scope.Last).Labl)
285 Restore_Scan_State (Name_Scan_State);
287 End_Labl_Present := False;
291 -- Here for case of name allowed, but no name present. We will
292 -- supply an implicit matching name, with source location set
293 -- to the scan location past the END token.
296 End_Labl := Scope.Table (Scope.Last).Labl;
298 if End_Labl > Empty_Or_Error then
300 -- The task here is to construct a designator from the
301 -- opening label, with the components all marked as not
302 -- from source, and Is_End_Label set in the identifier
303 -- or operator symbol. The location for all components
304 -- is the curent token location.
306 -- Case of child unit name
308 if Nkind (End_Labl) = N_Defining_Program_Unit_Name then
310 Eref : constant Node_Id :=
311 Make_Identifier (Token_Ptr,
313 Chars (Defining_Identifier (End_Labl)));
315 function Copy_Name (N : Node_Id) return Node_Id;
316 -- Copies a selected component or identifier
322 function Copy_Name (N : Node_Id) return Node_Id is
326 if Nkind (N) = N_Selected_Component then
328 Make_Selected_Component (Token_Ptr,
330 Copy_Name (Prefix (N)),
332 Copy_Name (Selector_Name (N)));
336 Make_Identifier (Token_Ptr,
338 Set_Comes_From_Source (N, False);
343 -- Start of processing for Child_End
346 Set_Comes_From_Source (Eref, False);
349 Make_Designator (Token_Ptr,
350 Name => Copy_Name (Name (End_Labl)),
354 -- Simple identifier case
356 elsif Nkind (End_Labl) = N_Defining_Identifier
357 or else Nkind (End_Labl) = N_Identifier
360 Make_Identifier (Token_Ptr,
361 Chars => Chars (End_Labl));
363 elsif Nkind (End_Labl) = N_Defining_Operator_Symbol
364 or else Nkind (End_Labl) = N_Operator_Symbol
366 Get_Decoded_Name_String (Chars (End_Labl));
369 Make_Operator_Symbol (Token_Ptr,
370 Chars => Chars (End_Labl),
371 Strval => String_From_Name_Buffer);
374 Set_Comes_From_Source (End_Labl, False);
375 End_Labl_Present := False;
377 -- Do style check for missing label
380 and then End_Type = E_Name
381 and then Explicit_Start_Label (Scope.Last)
383 Style.No_End_Name (Scope.Table (Scope.Last).Labl);
389 -- Except in case of END RECORD, semicolon must follow. For END
390 -- RECORD, a semicolon does follow, but it is part of a higher level
391 -- construct. In any case, a missing semicolon is not serious enough
392 -- to consider the END statement to be bad in the sense that we
393 -- are dealing with (i.e. to be suspicious that it is not in fact
394 -- the END statement we are looking for!)
396 if End_Type /= E_Record then
397 if Token = Tok_Semicolon then
400 -- Semicolon is missing. If the missing semicolon is at the end
401 -- of the line, i.e. we are at the start of the line now, then
402 -- a missing semicolon gets flagged, but is not serious enough
403 -- to consider the END statement to be bad in the sense that we
404 -- are dealing with (i.e. to be suspicious that this END is not
405 -- the END statement we are looking for).
407 -- Similarly, if we are at a colon, we flag it but a colon for
408 -- a semicolon is not serious enough to consider the END to be
409 -- incorrect. Same thing for a period in place of a semicolon.
411 elsif Token_Is_At_Start_Of_Line
412 or else Token = Tok_Colon
413 or else Token = Tok_Dot
417 -- If the missing semicolon is not at the start of the line,
418 -- then we do consider the END line to be dubious in this sense.
426 -- Now we call the Pop_End_Context routine to get a recommendation
427 -- as to what should be done with the END sequence we have scanned.
431 -- Remaining action depends on End_Action set by Pop_End_Context
435 -- Accept_As_Scanned. In this case, Pop_End_Context left Token
436 -- pointing past the last token of a syntactically correct END
438 when Accept_As_Scanned =>
440 -- Syntactically correct included the possibility of a missing
441 -- semicolon. If we do have a missing semicolon, then we have
442 -- already given a message, but now we scan out possible rubbish
443 -- on the same line as the END
445 while not Token_Is_At_Start_Of_Line
446 and then Prev_Token /= Tok_Record
447 and then Prev_Token /= Tok_Semicolon
448 and then Token /= Tok_End
449 and then Token /= Tok_EOF
456 -- Insert_And_Accept. In this case, Pop_End_Context has reset Token
457 -- to point to the start of the END sequence, and recommends that it
458 -- be left in place to satisfy an outer scope level END. This means
459 -- that we proceed as though an END were present, and leave the scan
460 -- pointer unchanged.
462 when Insert_And_Accept =>
465 -- Skip_And_Accept. In this case, Pop_End_Context has reset Token
466 -- to point to the start of the END sequence. This END sequence is
467 -- syntactically incorrect, and an appropriate error message has
468 -- already been posted. Pop_End_Context recommends accepting the
469 -- END sequence as the one we want, so we skip past it and then
470 -- proceed as though an END were present.
472 when Skip_And_Accept =>
476 -- Skip_And_Reject. In this case, Pop_End_Context has reset Token
477 -- to point to the start of the END sequence. This END sequence is
478 -- syntactically incorrect, and an appropriate error message has
479 -- already been posted. Pop_End_Context recommends entirely ignoring
480 -- this END sequence, so we skip past it and then return False, since
481 -- as far as the caller is concerned, no END sequence is present.
483 when Skip_And_Reject =>
493 -- This procedure skips past an END sequence. On entry Token contains
494 -- Tok_End, and we know that the END sequence is syntactically incorrect,
495 -- and that an appropriate error message has already been posted. The
496 -- mission is simply to position the scan pointer to be the best guess of
497 -- the position after the END sequence. We do not issue any additional
498 -- error messages while carrying this out.
500 -- Error recovery: does not raise Error_Resync
502 procedure End_Skip is
506 -- If the scan past the END leaves us on the next line, that's probably
507 -- where we should quit the scan, since it is likely that what we have
508 -- is a missing semicolon. Consider the following:
513 -- This will have looked like a syntactically valid END sequence to the
514 -- initial scan of the END, but subsequent checking will have determined
515 -- that the label Process_Input is not an appropriate label. The real
516 -- error is a missing semicolon after the END, and by leaving the scan
517 -- pointer just past the END, we will improve the error recovery.
519 if Token_Is_At_Start_Of_Line then
523 -- If there is a semicolon after the END, scan it out and we are done
525 if Token = Tok_Semicolon then
530 -- Otherwise skip past a token after the END on the same line. Note
531 -- that we do not eat a token on the following line since it seems
532 -- very unlikely in any case that the END gets separated from its
533 -- token, and we do not want to swallow up a keyword that starts a
534 -- legitimate construct following the bad END.
536 if not Token_Is_At_Start_Of_Line
539 -- Cases of normal tokens following an END
541 (Token = Tok_Case or else
542 Token = Tok_For or else
543 Token = Tok_If or else
544 Token = Tok_Loop or else
545 Token = Tok_Record or else
546 Token = Tok_Select or else
548 -- Cases of bogus keywords ending loops
550 Token = Tok_For or else
551 Token = Tok_While or else
553 -- Cases of operator symbol names without quotes
555 Token = Tok_Abs or else
556 Token = Tok_And or else
557 Token = Tok_Mod or else
558 Token = Tok_Not or else
559 Token = Tok_Or or else
563 Scan; -- past token after END
565 -- If that leaves us on the next line, then we are done. This is the
566 -- same principle described above for the case of END at line end
568 if Token_Is_At_Start_Of_Line then
571 -- If we just scanned out record, then we are done, since the
572 -- semicolon after END RECORD is not part of the END sequence
574 elsif Prev_Token = Tok_Record then
577 -- If we have a semicolon, scan it out and we are done
579 elsif Token = Tok_Semicolon then
585 -- Check for a label present on the same line
588 if Token_Is_At_Start_Of_Line then
592 if Token /= Tok_Identifier
593 and then Token /= Tok_Operator_Symbol
594 and then Token /= Tok_String_Literal
599 Scan; -- past identifier, operator symbol or string literal
601 if Token_Is_At_Start_Of_Line then
603 elsif Token = Tok_Dot then
608 -- Skip final semicolon
610 if Token = Tok_Semicolon then
613 -- If we don't have a final semicolon, skip until we either encounter
614 -- an END token, or a semicolon or the start of the next line. This
615 -- allows general junk to follow the end line (normally it is hard to
616 -- think that anyone will put anything deliberate here, and remember
617 -- that we know there is a missing semicolon in any case). We also
618 -- quite on an EOF (or else we would get stuck in an infinite loop
619 -- if there is no line end at the end of the last line of the file)
622 while Token /= Tok_End
623 and then Token /= Tok_EOF
624 and then Token /= Tok_Semicolon
625 and then not Token_Is_At_Start_Of_Line
627 Scan; -- past junk token on same line
638 -- This procedure is called when END is required or expected to terminate
639 -- a sequence of statements. The caller has already made an appropriate
640 -- entry on the scope stack to describe the expected form of the END.
641 -- End_Statements should only be used in cases where the only appropriate
642 -- terminator is END.
644 -- Error recovery: cannot raise Error_Resync;
646 procedure End_Statements (Parent : Node_Id := Empty) is
648 -- This loop runs more than once in the case where Check_End rejects
649 -- the END sequence, as indicated by Check_End returning False.
653 if Present (Parent) then
654 Set_End_Label (Parent, End_Labl);
660 -- Extra statements past the bogus END are discarded. This is not
661 -- ideal for maximum error recovery, but it's too much trouble to
662 -- find an appropriate place to put them!
664 Discard_Junk_List (P_Sequence_Of_Statements (SS_None));
668 ------------------------
669 -- Evaluate End Entry --
670 ------------------------
672 procedure Evaluate_End_Entry (SS_Index : Nat) is
674 Column_OK := (End_Column = Scope.Table (SS_Index).Ecol);
676 Token_OK := (End_Type = Scope.Table (SS_Index).Etyp or else
677 (End_Type = E_Name and then
678 Scope.Table (SS_Index).Etyp >= E_Name));
680 Label_OK := End_Labl_Present
682 (Same_Label (End_Labl, Scope.Table (SS_Index).Labl)
683 or else Scope.Table (SS_Index).Labl = Error);
685 -- Compute setting of Syntax_OK. We definitely have a syntax error
686 -- if the Token does not match properly or if P_End_Scan detected
687 -- a syntax error such as a missing semicolon.
689 if not Token_OK or not End_OK then
692 -- Final check is that label is OK. Certainly it is OK if there
693 -- was an exact match on the label (the END label = the stack label)
698 -- Case of label present
700 elsif End_Labl_Present then
702 -- If probably misspelling, then complain, and pretend it is OK
705 Nam : constant Node_Or_Entity_Id := Scope.Table (SS_Index).Labl;
708 if Nkind (End_Labl) in N_Has_Chars
709 and then Comes_From_Source (Nam)
710 and then Nkind (Nam) in N_Has_Chars
711 and then Chars (End_Labl) > Error_Name
712 and then Chars (Nam) > Error_Name
714 Get_Name_String (Chars (End_Labl));
715 Error_Msg_Name_1 := Chars (Nam);
717 if Error_Msg_Name_1 > Error_Name then
719 S : constant String (1 .. Name_Len) :=
720 Name_Buffer (1 .. Name_Len);
723 Get_Name_String (Error_Msg_Name_1);
725 if Is_Bad_Spelling_Of
726 (Name_Buffer (1 .. Name_Len), S)
728 Error_Msg_N ("misspelling of %", End_Labl);
739 -- Otherwise we have cases of no label on the END line. For the loop
740 -- case, this is acceptable only if the loop is unlabeled.
742 elsif End_Type = E_Loop then
743 Syntax_OK := not Explicit_Start_Label (SS_Index);
745 -- Cases where a label is definitely allowed on the END line
747 elsif End_Type = E_Name then
748 Syntax_OK := (not Explicit_Start_Label (SS_Index))
750 (not Scope.Table (SS_Index).Lreq);
752 -- Otherwise we have cases which don't allow labels anyway, so we
753 -- certainly accept an END which does not have a label.
758 end Evaluate_End_Entry;
760 --------------------------
761 -- Explicit_Start_Label --
762 --------------------------
764 function Explicit_Start_Label (SS_Index : Nat) return Boolean is
765 L : constant Node_Id := Scope.Table (SS_Index).Labl;
766 Etyp : constant SS_End_Type := Scope.Table (SS_Index).Etyp;
772 -- In the following test we protect the call to Comes_From_Source
773 -- against lines containing previously reported syntax errors.
776 or else Etyp = E_Name
777 or else Etyp = E_Suspicious_Is
778 or else Etyp = E_Bad_Is)
779 and then Comes_From_Source (L)
785 end Explicit_Start_Label;
787 ------------------------
788 -- Output End Deleted --
789 ------------------------
791 procedure Output_End_Deleted is
794 if End_Type = E_Loop then
795 Error_Msg_SC ("no LOOP for this `END LOOP`!");
797 elsif End_Type = E_Case then
798 Error_Msg_SC ("no CASE for this `END CASE`");
800 elsif End_Type = E_If then
801 Error_Msg_SC ("no IF for this `END IF`!");
803 elsif End_Type = E_Record then
804 Error_Msg_SC ("no RECORD for this `END RECORD`!");
806 elsif End_Type = E_Return then
807 Error_Msg_SC ("no RETURN for this `END RETURN`!");
809 elsif End_Type = E_Select then
810 Error_Msg_SC ("no SELECT for this `END SELECT`!");
813 Error_Msg_SC ("no BEGIN for this END!");
815 end Output_End_Deleted;
817 -------------------------
818 -- Output End Expected --
819 -------------------------
821 procedure Output_End_Expected (Ins : Boolean) is
822 End_Type : SS_End_Type;
825 -- Suppress message if this was a potentially junk entry (e.g. a
826 -- record entry where no record keyword was present.
828 if Scope.Table (Scope.Last).Junk then
832 End_Type := Scope.Table (Scope.Last).Etyp;
833 Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
834 Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc;
836 if Explicit_Start_Label (Scope.Last) then
837 Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
839 Error_Msg_Node_1 := Empty;
842 -- Suppress message if error was posted on opening label
844 if Error_Msg_Node_1 > Empty_Or_Error
845 and then Error_Posted (Error_Msg_Node_1)
850 if End_Type = E_Case then
851 Error_Msg_SC ("`END CASE;` expected@ for CASE#!");
853 elsif End_Type = E_If then
854 Error_Msg_SC ("`END IF;` expected@ for IF#!");
856 elsif End_Type = E_Loop then
857 if Error_Msg_Node_1 = Empty then
859 ("`END LOOP;` expected@ for LOOP#!");
861 Error_Msg_SC ("`END LOOP &;` expected@!");
864 elsif End_Type = E_Record then
866 ("`END RECORD;` expected@ for RECORD#!");
868 elsif End_Type = E_Return then
870 ("`END RETURN;` expected@ for RETURN#!");
872 elsif End_Type = E_Select then
874 ("`END SELECT;` expected@ for SELECT#!");
876 -- All remaining cases are cases with a name (we do not treat
877 -- the suspicious is cases specially for a replaced end, only
878 -- for an inserted end).
880 elsif End_Type = E_Name or else (not Ins) then
881 if Error_Msg_Node_1 = Empty then
882 Error_Msg_SC ("`END;` expected@ for BEGIN#!");
884 Error_Msg_SC ("`END &;` expected@!");
887 -- The other possibility is a missing END for a subprogram with a
888 -- suspicious IS (that probably should have been a semicolon). The
889 -- Missing IS confirms the suspicion!
891 else -- End_Type = E_Suspicious_Is or E_Bad_Is
892 Scope.Table (Scope.Last).Etyp := E_Bad_Is;
894 end Output_End_Expected;
896 ------------------------
897 -- Output End Missing --
898 ------------------------
900 procedure Output_End_Missing is
901 End_Type : SS_End_Type;
904 -- Suppress message if this was a potentially junk entry (e.g. a
905 -- record entry where no record keyword was present.
907 if Scope.Table (Scope.Last).Junk then
911 End_Type := Scope.Table (Scope.Last).Etyp;
912 Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc;
914 if Explicit_Start_Label (Scope.Last) then
915 Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
917 Error_Msg_Node_1 := Empty;
920 if End_Type = E_Case then
921 Error_Msg_BC ("missing `END CASE;` for CASE#!");
923 elsif End_Type = E_If then
924 Error_Msg_BC ("missing `END IF;` for IF#!");
926 elsif End_Type = E_Loop then
927 if Error_Msg_Node_1 = Empty then
928 Error_Msg_BC ("missing `END LOOP;` for LOOP#!");
930 Error_Msg_BC ("missing `END LOOP &;`!");
933 elsif End_Type = E_Record then
935 ("missing `END RECORD;` for RECORD#!");
937 elsif End_Type = E_Return then
939 ("missing `END RETURN;` for RETURN#!");
941 elsif End_Type = E_Select then
943 ("missing `END SELECT;` for SELECT#!");
945 elsif End_Type = E_Name then
946 if Error_Msg_Node_1 = Empty then
947 Error_Msg_BC ("missing `END;` for BEGIN#!");
949 Error_Msg_BC ("missing `END &;`!");
952 else -- End_Type = E_Suspicious_Is or E_Bad_Is
953 Scope.Table (Scope.Last).Etyp := E_Bad_Is;
955 end Output_End_Missing;
957 ---------------------
958 -- Pop End Context --
959 ---------------------
961 procedure Pop_End_Context is
963 Pretty_Good : Boolean;
964 -- This flag is set True if the END sequence is syntactically incorrect,
965 -- but is (from a heuristic point of view), pretty likely to be simply
966 -- a misspelling of the intended END.
968 Outer_Match : Boolean;
969 -- This flag is set True if we decide that the current END sequence
970 -- belongs to some outer level entry in the scope stack, and thus
971 -- we will NOT eat it up in matching the current expected END.
974 -- If not at END, then output END expected message
976 if End_Type = E_Dummy then
979 End_Action := Insert_And_Accept;
982 -- Otherwise we do have an END present
985 -- A special check. If we have END; followed by an end of file,
986 -- WITH or SEPARATE, then if we are not at the outer level, then
987 -- we have a sytax error. Consider the example:
999 -- Now the END; here is a syntactically correct closer for the
1000 -- declare block, but if we eat it up, then we obviously have
1001 -- a missing END for the outer context (since WITH can only appear
1002 -- at the outer level.
1004 -- In this situation, we always reserve the END; for the outer level,
1005 -- even if it is in the wrong column. This is because it's much more
1006 -- useful to have the error message point to the DECLARE than to the
1007 -- package header in this case.
1009 -- We also reserve an end with a name before the end of file if the
1010 -- name is the one we expect at the outer level.
1012 if (Token = Tok_EOF or else
1013 Token = Tok_With or else
1014 Token = Tok_Separate)
1015 and then End_Type >= E_Name
1016 and then (not End_Labl_Present
1017 or else Same_Label (End_Labl, Scope.Table (1).Labl))
1018 and then Scope.Last > 1
1020 Restore_Scan_State (Scan_State); -- to END
1021 Output_End_Expected (Ins => True);
1023 End_Action := Insert_And_Accept;
1027 -- Otherwise we go through the normal END evaluation procedure
1029 Evaluate_End_Entry (Scope.Last);
1031 -- If top entry in stack is syntactically correct, then we have
1032 -- scanned it out and everything is fine. This is the required
1033 -- action to properly process correct Ada programs.
1037 -- Complain if checking columns and END is not in right column.
1038 -- Right in this context means exactly right, or on the same
1039 -- line as the opener.
1041 if Style.RM_Column_Check then
1042 if End_Column /= Scope.Table (Scope.Last).Ecol
1043 and then Current_Line_Start > Scope.Table (Scope.Last).Sloc
1045 -- A special case, for END RECORD, we are also allowed to
1046 -- line up with the TYPE keyword opening the declaration.
1048 and then (Scope.Table (Scope.Last).Etyp /= E_Record
1049 or else Get_Column_Number (End_Sloc) /=
1050 Get_Column_Number (Type_Token_Location))
1052 Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
1054 ("(style) END in wrong column, should be@", End_Sloc);
1058 -- One final check. If the end had a label, check for an exact
1059 -- duplicate of this end sequence, and if so, skip it with an
1060 -- appropriate message.
1062 if End_Labl_Present and then Token = Tok_End then
1064 Scan_State : Saved_Scan_State;
1065 End_Loc : constant Source_Ptr := Token_Ptr;
1067 Dup_Found : Boolean := False;
1070 Save_Scan_State (Scan_State);
1074 if Token = Tok_Identifier
1075 or else Token = Tok_Operator_Symbol
1077 Nxt_Labl := P_Designator;
1079 -- We only consider it an error if the label is a match
1080 -- and would be wrong for the level one above us, and
1081 -- the indentation is the same.
1083 if Token = Tok_Semicolon
1084 and then Same_Label (End_Labl, Nxt_Labl)
1085 and then End_Column = Start_Column
1089 (not Explicit_Start_Label (Scope.Last - 1))
1093 Scope.Table (Scope.Last - 1).Labl)))
1096 Error_Msg ("duplicate end line ignored", End_Loc);
1101 if not Dup_Found then
1102 Restore_Scan_State (Scan_State);
1107 -- All OK, so return to caller indicating END is OK
1110 End_Action := Accept_As_Scanned;
1114 -- If that check failed, then we definitely have an error. The issue
1115 -- is how to choose among three possible courses of action:
1117 -- 1. Ignore the current END text completely, scanning past it,
1118 -- deciding that it belongs neither to the current context,
1119 -- nor to any outer context.
1121 -- 2. Accept the current END text, scanning past it, and issuing
1122 -- an error message that it does not have the right form.
1124 -- 3. Leave the current END text in place, NOT scanning past it,
1125 -- issuing an error message indicating the END expected for the
1126 -- current context. In this case, the END is available to match
1127 -- some outer END context.
1129 -- From a correct functioning point of view, it does not make any
1130 -- difference which of these three approaches we take, the program
1131 -- will work correctly in any case. However, making an accurate
1132 -- choice among these alternatives, i.e. choosing the one that
1133 -- corresponds to what the programmer had in mind, does make a
1134 -- significant difference in the quality of error recovery.
1136 Restore_Scan_State (Scan_State); -- to END
1138 -- First we see how good the current END entry is with respect to
1139 -- what we expect. It is considered pretty good if the token is OK,
1140 -- and either the label or the column matches. an END for RECORD is
1141 -- always considered to be pretty good in the record case. This is
1142 -- because not only does a record disallow a nested structure, but
1143 -- also it is unlikely that such nesting could occur by accident.
1145 Pretty_Good := (Token_OK and (Column_OK or Label_OK))
1146 or else Scope.Table (Scope.Last).Etyp = E_Record;
1148 -- Next check, if there is a deeper entry in the stack which
1149 -- has a very high probability of being acceptable, then insert
1150 -- the END entry we want, leaving the higher level entry for later
1152 for J in reverse 1 .. Scope.Last - 1 loop
1153 Evaluate_End_Entry (J);
1155 -- To even consider the deeper entry to be immediately acceptable,
1156 -- it must be syntactically correct. Furthermore it must either
1157 -- have a correct label, or the correct column. If the current
1158 -- entry was a close match (Pretty_Good set), then we are even
1159 -- more strict in accepting the outer level one: even if it has
1160 -- the right label, it must have the right column as well.
1164 Outer_Match := Label_OK and Column_OK;
1166 Outer_Match := Label_OK or Column_OK;
1169 Outer_Match := False;
1172 -- If the outer entry does convincingly match the END text, then
1173 -- back up the scan to the start of the END sequence, issue an
1174 -- error message indicating the END we expected, and return with
1175 -- Token pointing to the END (case 3 from above discussion).
1180 End_Action := Insert_And_Accept;
1185 -- Here we have a situation in which the current END entry is
1186 -- syntactically incorrect, but there is no deeper entry in the
1187 -- END stack which convincingly matches it.
1189 -- If the END text was judged to be a Pretty_Good match for the
1190 -- expected token or if it appears left of the expected column,
1191 -- then we will accept it as the one we want, scanning past it, even
1192 -- though it is not completely right (we issue a message showing what
1193 -- we expected it to be). This is action 2 from the discussion above.
1194 -- There is one other special case to consider: the LOOP case.
1195 -- Consider the example:
1201 -- Here the column lines up with Lbl, so END LOOP is to the right,
1202 -- but it is still acceptable. LOOP is the one case where alignment
1203 -- practices vary substantially in practice.
1206 or else End_Column <= Scope.Table (Scope.Last).Ecol
1207 or else (End_Type = Scope.Table (Scope.Last).Etyp
1208 and then End_Type = E_Loop)
1210 Output_End_Expected (Ins => False);
1212 End_Action := Skip_And_Accept;
1215 -- Here we have the case where the END is to the right of the
1216 -- expected column and does not have a correct label to convince
1217 -- us that it nevertheless belongs to the current scope. For this
1218 -- we consider that it probably belongs not to the current context,
1219 -- but to some inner context that was not properly recognized (due to
1220 -- other syntax errors), and for which no proper scope stack entry
1221 -- was made. The proper action in this case is to delete the END text
1222 -- and return False to the caller as a signal to keep on looking for
1223 -- an acceptable END. This is action 1 from the discussion above.
1227 End_Action := Skip_And_Reject;
1231 end Pop_End_Context;
1237 function Same_Label (Label1, Label2 : Node_Id) return Boolean is
1239 if Nkind (Label1) in N_Has_Chars
1240 and then Nkind (Label2) in N_Has_Chars
1242 return Chars (Label1) = Chars (Label2);
1244 elsif Nkind (Label1) = N_Selected_Component
1245 and then Nkind (Label2) = N_Selected_Component
1247 return Same_Label (Prefix (Label1), Prefix (Label2)) and then
1248 Same_Label (Selector_Name (Label1), Selector_Name (Label2));
1250 elsif Nkind (Label1) = N_Designator
1251 and then Nkind (Label2) = N_Defining_Program_Unit_Name
1253 return Same_Label (Name (Label1), Name (Label2)) and then
1254 Same_Label (Identifier (Label1), Defining_Identifier (Label2));