1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2023, 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 Namet
.Sp
; use Namet
.Sp
;
27 with Stringt
; use Stringt
;
28 with Uintp
; use Uintp
;
30 with GNAT
.Spelling_Checker
; use GNAT
.Spelling_Checker
;
39 type End_Action_Type
is (
40 -- Type used to describe the result of the Pop_End_Context call
43 -- Current end sequence is entirely c correct. In this case Token and
44 -- the scan pointer are left pointing past the end sequence (i.e. they
45 -- are unchanged from the values set on entry to Pop_End_Context).
48 -- Current end sequence is to be left in place to satisfy some outer
49 -- scope. Token and the scan pointer are set to point to the end
50 -- token, and should be left there. A message has been generated
51 -- indicating a missing end sequence. This status is also used for
52 -- the case when no end token is present.
55 -- The end sequence is incorrect (and an error message has been
56 -- posted), but it will still be accepted. In this case Token and
57 -- the scan pointer point back to the end token, and the caller
58 -- should skip past the end sequence before proceeding.
61 -- The end sequence is judged to belong to an unrecognized inner
62 -- scope. An appropriate message has been issued and the caller
63 -- should skip past the end sequence and then proceed as though
64 -- no end sequence had been encountered.
66 End_Action
: End_Action_Type
;
67 -- The variable set by Pop_End_Context call showing which of the four
68 -- decisions described above is judged the best.
70 End_Sloc
: Source_Ptr
;
71 -- Source location of END token
74 -- Set False if error is found in END line
76 End_Column
: Column_Number
;
79 End_Type
: SS_End_Type
;
80 -- Type of END expected. The special value E_Dummy is set to indicate that
81 -- no END token was present (so a missing END inserted message is needed)
84 -- Node_Id value for explicit name on END line, or for compiler supplied
85 -- name in the case where an optional name is not given. Empty if no name
86 -- appears. If non-empty, then it is either an N_Designator node for a
87 -- child unit or a node with a Chars field identifying the actual label.
89 End_Labl_Present
: Boolean;
90 -- Indicates that the value in End_Labl was for an explicit label
93 -- Set True if the entry is syntactically correct
96 -- Set True if the keyword in the END sequence matches, or if neither
97 -- the END sequence nor the END stack entry has a keyword.
100 -- Set True if both the END sequence and the END stack entry contained
101 -- labels (other than No_Name or Error_Name) and the labels matched.
102 -- This is a stronger condition than SYNTAX_OK, since it means that a
103 -- label was present, even in a case where it was optional. Note that
104 -- the case of no label required, and no label present does NOT set
105 -- Label_OK to True, it is True only if a positive label match is found.
108 -- Column_OK is set True if the END sequence appears in the expected column
110 Scan_State
: Saved_Scan_State
;
111 -- Save state at start of END sequence, in case we decide not to eat it up
113 -----------------------
114 -- Local Subprograms --
115 -----------------------
117 procedure Evaluate_End_Entry
(SS_Index
: Nat
);
118 -- Compare scanned END entry (as recorded by a prior call to P_End_Scan)
119 -- with a specified entry in the scope stack (the single parameter is the
120 -- entry index in the scope stack). Note that Scan is not called. The above
121 -- variables xxx_OK are set to indicate the result of the evaluation.
123 function Explicit_Start_Label
(SS_Index
: Nat
) return Boolean;
124 -- Determines whether the specified entry in the scope stack has an
125 -- explicit start label (i.e. one other than one that was created by
126 -- the parser when no explicit label was present).
128 procedure Output_End_Deleted
;
129 -- Output a message complaining that the current END structure does not
130 -- match anything and is being deleted.
132 procedure Output_End_Expected
(Ins
: Boolean);
133 -- Output a message at the start of the current token which is always an
134 -- END, complaining that the END is not of the right form. The message
135 -- indicates the expected form. The information for the message is taken
136 -- from the top entry in the scope stack. The Ins parameter is True if
137 -- an end is being inserted, and false if an existing end is being
138 -- replaced. Note that in the case of a suspicious IS for the Ins case,
139 -- we do not output the message, but instead simply mark the scope stack
140 -- entry as being a case of a bad IS.
142 procedure Output_End_Missing
;
143 -- Output a message just before the current token, complaining that the
144 -- END is not of the right form. The message indicates the expected form.
145 -- The information for the message is taken from the top entry in the
146 -- scope stack. Note that in the case of a suspicious IS, we do not output
147 -- the message, but instead simply mark the scope stack entry as a bad IS.
149 procedure Pop_End_Context
;
150 -- Pop_End_Context is called after processing a construct, to pop the
151 -- top entry off the end stack. It decides on the appropriate action to
152 -- to take, signalling the result by setting End_Action as described in
153 -- the global variable section.
155 function Same_Label
(Label1
, Label2
: Node_Id
) return Boolean;
156 -- This function compares the two names associated with the given nodes.
157 -- If they are both simple (i.e. have Chars fields), then they have to
158 -- be the same name. Otherwise they must both be N_Selected_Component
159 -- nodes, referring to the same set of names, or Label1 is an N_Designator
160 -- referring to the same set of names as the N_Defining_Program_Unit_Name
161 -- in Label2. Any other combination returns False. This routine is used
162 -- to compare the End_Labl scanned from the End line with the saved label
163 -- value in the scope stack.
170 (Decl
: Node_Id
:= Empty
;
171 Is_Loc
: Source_Ptr
:= No_Location
) return Boolean
173 Name_On_Separate_Line
: Boolean;
174 -- Set True if the name on an END line is on a separate source line
175 -- from the END. This is highly suspicious, but is allowed. The point
176 -- is that we want to make sure that we don't just have a missing
177 -- semicolon misleading us into swallowing an identifier from the
180 Name_Scan_State
: Saved_Scan_State
;
181 -- Save state at start of name if Name_On_Separate_Line is TRUE
183 Span_Node
: constant Node_Id
:= Scopes
(Scope
.Last
).Node
;
186 End_Labl_Present
:= False;
189 -- Our first task is to scan out the END sequence if one is present.
190 -- If none is present, signal by setting End_Type to E_Dummy.
192 if Token
/= Tok_End
then
196 Save_Scan_State
(Scan_State
); -- at END
197 End_Sloc
:= Token_Ptr
;
198 End_Column
:= Start_Column
;
202 -- Set End_Span if expected. Note that this will be useless
203 -- if we do not have the right ending keyword, but in this
204 -- case we have a malformed program anyway, and the setting
205 -- of End_Span will simply be unreliable in this case anyway.
207 if Present
(Span_Node
) then
208 Set_End_Location
(Span_Node
, Token_Ptr
);
211 -- Cases of keywords where no label is allowed
213 if Token
= Tok_Case
then
217 elsif Token
= Tok_If
then
221 elsif Token
= Tok_Record
then
222 End_Type
:= E_Record
;
225 elsif Token
= Tok_Return
then
226 End_Type
:= E_Return
;
229 elsif Token
= Tok_Select
then
230 End_Type
:= E_Select
;
233 -- Cases which do allow labels
238 if Token
= Tok_Loop
then
242 -- FOR or WHILE allowed (signalling error) to substitute for LOOP
243 -- if on the same line as the END.
245 elsif Token
in Tok_For | Tok_While
246 and then not Token_Is_At_Start_Of_Line
248 Scan
; -- past FOR or WHILE
252 -- Cases with no keyword
258 -- Now see if a name is present
260 if Token
= Tok_Identifier
or else
261 Token
= Tok_String_Literal
or else
262 Token
= Tok_Operator_Symbol
264 if Token_Is_At_Start_Of_Line
then
265 Name_On_Separate_Line
:= True;
266 Save_Scan_State
(Name_Scan_State
);
268 Name_On_Separate_Line
:= False;
271 End_Labl
:= P_Designator
;
272 End_Labl_Present
:= True;
274 -- We have now scanned out a name. Here is where we do a check
275 -- to catch the cases like:
280 -- where the missing semicolon might make us swallow up the X
281 -- as a bogus end label. In a situation like this, where the
282 -- apparent name is on a separate line, we accept it only if
283 -- it matches the label and is followed by a semicolon.
285 if Name_On_Separate_Line
then
286 if Token
/= Tok_Semicolon
or else
287 not Same_Label
(End_Labl
, Scopes
(Scope
.Last
).Labl
)
289 Restore_Scan_State
(Name_Scan_State
);
291 End_Labl_Present
:= False;
295 -- Here for case of name allowed, but no name present. We will
296 -- supply an implicit matching name, with source location set
297 -- to the scan location past the END token.
300 End_Labl
:= Scopes
(Scope
.Last
).Labl
;
302 if End_Labl
> Empty_Or_Error
then
304 -- The task here is to construct a designator from the
305 -- opening label, with the components all marked as not
306 -- from source, and Is_End_Label set in the identifier
307 -- or operator symbol. The location for all components
308 -- is the current token location.
310 -- Case of child unit name
312 if Nkind
(End_Labl
) = N_Defining_Program_Unit_Name
then
314 Eref
: constant Node_Id
:=
315 Make_Identifier
(Token_Ptr
,
317 Chars
(Defining_Identifier
(End_Labl
)));
319 function Copy_Name
(N
: Node_Id
) return Node_Id
;
320 -- Copies a selected component or identifier
326 function Copy_Name
(N
: Node_Id
) return Node_Id
is
330 if Nkind
(N
) = N_Selected_Component
then
332 Make_Selected_Component
(Token_Ptr
,
334 Copy_Name
(Prefix
(N
)),
336 Copy_Name
(Selector_Name
(N
)));
339 R
:= Make_Identifier
(Token_Ptr
, Chars
(N
));
340 Set_Comes_From_Source
(N
, False);
345 -- Start of processing for Child_End
348 Set_Comes_From_Source
(Eref
, False);
351 Make_Designator
(Token_Ptr
,
352 Name
=> Copy_Name
(Name
(End_Labl
)),
356 -- Simple identifier case
358 elsif Nkind
(End_Labl
) = N_Defining_Identifier
359 or else Nkind
(End_Labl
) = N_Identifier
361 End_Labl
:= Make_Identifier
(Token_Ptr
, 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 label permitted but not present. Note:
378 -- for the case of a block statement, the label is required
379 -- to be repeated, and this legality rule is enforced
383 and then End_Type
= E_Name
384 and then Explicit_Start_Label
(Scope
.Last
)
385 and then Nkind
(Parent
(Scopes
(Scope
.Last
).Labl
))
388 Style
.No_End_Name
(Scopes
(Scope
.Last
).Labl
);
394 -- Deal with terminating aspect specifications and following semi-
395 -- colon. We skip this in the case of END RECORD, since in this
396 -- case the aspect specifications and semicolon are handled at
399 if End_Type
/= E_Record
then
401 -- Scan aspect specifications
403 if Aspect_Specifications_Present
then
405 -- Aspect specifications not allowed
409 -- Package declaration case
411 if Is_Loc
/= No_Location
then
413 ("misplaced aspects for package declaration");
415 ("info: aspect specifications belong here??", Is_Loc
);
416 P_Aspect_Specifications
(Empty
);
418 -- Other cases where aspect specifications are not allowed
421 P_Aspect_Specifications
(Error
);
424 -- Aspect specifications allowed
427 P_Aspect_Specifications
(Decl
);
430 -- If no aspect specifications, must have a semicolon
432 elsif End_Type
/= E_Record
then
433 if Token
= Tok_Semicolon
then
436 -- Semicolon is missing. If the missing semicolon is at the end
437 -- of the line, i.e. we are at the start of the line now, then
438 -- a missing semicolon gets flagged, but is not serious enough
439 -- to consider the END statement to be bad in the sense that we
440 -- are dealing with (i.e. to be suspicious that this END is not
441 -- the END statement we are looking for).
443 -- Similarly, if we are at a colon, we flag it but a colon for
444 -- a semicolon is not serious enough to consider the END to be
445 -- incorrect. Same thing for a period in place of a semicolon.
447 elsif Token_Is_At_Start_Of_Line
448 or else Token
in Tok_Colon | Tok_Dot
452 -- If the missing semicolon is not at the start of the line,
453 -- then we consider the END line to be dubious in this sense.
462 -- Now we call the Pop_End_Context routine to get a recommendation
463 -- as to what should be done with the END sequence we have scanned.
467 -- Remaining action depends on End_Action set by Pop_End_Context
471 -- Accept_As_Scanned. In this case, Pop_End_Context left Token
472 -- pointing past the last token of a syntactically correct END
474 when Accept_As_Scanned
=>
476 -- Syntactically correct included the possibility of a missing
477 -- semicolon. If we do have a missing semicolon, then we have
478 -- already given a message, but now we scan out possible rubbish
479 -- on the same line as the END
481 while not Token_Is_At_Start_Of_Line
482 and then Prev_Token
not in Tok_Record | Tok_Semicolon
483 and then Token
not in Tok_End | Tok_EOF
490 -- Insert_And_Accept. In this case, Pop_End_Context has reset Token
491 -- to point to the start of the END sequence, and recommends that it
492 -- be left in place to satisfy an outer scope level END. This means
493 -- that we proceed as though an END were present, and leave the scan
494 -- pointer unchanged.
496 when Insert_And_Accept
=>
499 -- Skip_And_Accept. In this case, Pop_End_Context has reset Token
500 -- to point to the start of the END sequence. This END sequence is
501 -- syntactically incorrect, and an appropriate error message has
502 -- already been posted. Pop_End_Context recommends accepting the
503 -- END sequence as the one we want, so we skip past it and then
504 -- proceed as though an END were present.
506 when Skip_And_Accept
=>
510 -- Skip_And_Reject. In this case, Pop_End_Context has reset Token
511 -- to point to the start of the END sequence. This END sequence is
512 -- syntactically incorrect, and an appropriate error message has
513 -- already been posted. Pop_End_Context recommends entirely ignoring
514 -- this END sequence, so we skip past it and then return False, since
515 -- as far as the caller is concerned, no END sequence is present.
517 when Skip_And_Reject
=>
527 -- This procedure skips past an END sequence. On entry Token contains
528 -- Tok_End, and we know that the END sequence is syntactically incorrect,
529 -- and that an appropriate error message has already been posted. The
530 -- mission is simply to position the scan pointer to be the best guess of
531 -- the position after the END sequence. We do not issue any additional
532 -- error messages while carrying this out.
534 -- Error recovery: does not raise Error_Resync
536 procedure End_Skip
is
540 -- If the scan past the END leaves us on the next line, that's probably
541 -- where we should quit the scan, since it is likely that what we have
542 -- is a missing semicolon. Consider the following:
547 -- This will have looked like a syntactically valid END sequence to the
548 -- initial scan of the END, but subsequent checking will have determined
549 -- that the label Process_Input is not an appropriate label. The real
550 -- error is a missing semicolon after the END, and by leaving the scan
551 -- pointer just past the END, we will improve the error recovery.
553 if Token_Is_At_Start_Of_Line
then
557 -- If there is a semicolon after the END, scan it out and we are done
559 if Token
= Tok_Semicolon
then
564 -- Otherwise skip past a token after the END on the same line. Note
565 -- that we do not eat a token on the following line since it seems
566 -- very unlikely in any case that the END gets separated from its
567 -- token, and we do not want to swallow up a keyword that starts a
568 -- legitimate construct following the bad END.
570 if not Token_Is_At_Start_Of_Line
573 -- Cases of normal tokens following an END
575 (Token
= Tok_Case
or else
576 Token
= Tok_If
or else
577 Token
= Tok_Loop
or else
578 Token
= Tok_Record
or else
579 Token
= Tok_Select
or else
581 -- Cases of bogus keywords ending loops
583 Token
= Tok_For
or else
584 Token
= Tok_While
or else
586 -- Cases of operator symbol names without quotes
588 Token
= Tok_Abs
or else
589 Token
= Tok_And
or else
590 Token
= Tok_Mod
or else
591 Token
= Tok_Not
or else
592 Token
= Tok_Or
or else
596 Scan
; -- past token after END
598 -- If that leaves us on the next line, then we are done. This is the
599 -- same principle described above for the case of END at line end
601 if Token_Is_At_Start_Of_Line
then
604 -- If we just scanned out record, then we are done, since the
605 -- semicolon after END RECORD is not part of the END sequence
607 elsif Prev_Token
= Tok_Record
then
610 -- If we have a semicolon, scan it out and we are done
612 elsif Token
= Tok_Semicolon
then
618 -- Check for a label present on the same line
621 if Token_Is_At_Start_Of_Line
then
626 Tok_Identifier | Tok_Operator_Symbol | Tok_String_Literal
631 Scan
; -- past identifier, operator symbol or string literal
633 if Token_Is_At_Start_Of_Line
then
635 elsif Token
= Tok_Dot
then
640 -- Skip final semicolon
642 if Token
= Tok_Semicolon
then
645 -- If we don't have a final semicolon, skip until we either encounter
646 -- an END token, or a semicolon or the start of the next line. This
647 -- allows general junk to follow the end line (normally it is hard to
648 -- think that anyone will put anything deliberate here, and remember
649 -- that we know there is a missing semicolon in any case). We also
650 -- quite on an EOF (or else we would get stuck in an infinite loop
651 -- if there is no line end at the end of the last line of the file)
654 while Token
not in Tok_End | Tok_EOF | Tok_Semicolon
655 and then not Token_Is_At_Start_Of_Line
657 Scan
; -- past junk token on same line
668 -- This procedure is called when END is required or expected to terminate
669 -- a sequence of statements. The caller has already made an appropriate
670 -- entry on the scope stack to describe the expected form of the END.
671 -- End_Statements should only be used in cases where the only appropriate
672 -- terminator is END.
674 -- Error recovery: cannot raise Error_Resync;
676 procedure End_Statements
677 (Parent
: Node_Id
:= Empty
;
678 Decl
: Node_Id
:= Empty
;
679 Is_Sloc
: Source_Ptr
:= No_Location
)
682 -- This loop runs more than once in the case where Check_End rejects
683 -- the END sequence, as indicated by Check_End returning False.
686 if Check_End
(Decl
, Is_Sloc
) then
687 if Present
(Parent
) then
688 Set_End_Label
(Parent
, End_Labl
);
694 -- Extra statements past the bogus END are discarded. This is not
695 -- ideal for maximum error recovery, but it's too much trouble to
696 -- find an appropriate place to put them.
698 Discard_Junk_List
(P_Sequence_Of_Statements
(SS_None
));
702 ------------------------
703 -- Evaluate End Entry --
704 ------------------------
706 procedure Evaluate_End_Entry
(SS_Index
: Nat
) is
707 STE
: Scope_Table_Entry
renames Scopes
(SS_Index
).all;
710 Column_OK
:= (End_Column
= STE
.Ecol
);
712 Token_OK
:= (End_Type
= STE
.Etyp
713 or else (End_Type
= E_Name
and then STE
.Etyp
>= E_Name
));
715 Label_OK
:= End_Labl_Present
716 and then (Same_Label
(End_Labl
, STE
.Labl
)
717 or else STE
.Labl
= Error
);
719 -- Special case to consider. Suppose we have the suspicious label case,
720 -- e.g. a situation like:
729 -- This is the case where we want to use the entry in the suspicious
730 -- label table to flag the semicolon saying it should be a colon.
732 -- Label_OK will be false because the label does not match (we have
733 -- My_Label on the end line, and the generated name for the scope). Also
734 -- End_Labl_Present will be True.
737 and then End_Labl_Present
738 and then not Comes_From_Source
(Scopes
(SS_Index
).Labl
)
740 -- Here is where we will search the suspicious labels table
742 for J
in 1 .. Suspicious_Labels
.Last
loop
744 SLE
: Suspicious_Label_Entry
renames
745 Suspicious_Labels
.Table
(J
);
747 -- See if character name of label matches
749 if Chars
(Name
(SLE
.Proc_Call
)) = Chars
(End_Labl
)
751 -- And first token of loop/block identifies this entry
753 and then SLE
.Start_Token
= STE
.Sloc
755 -- We have the special case, issue the error message
758 (""";"" should be "":""", SLE
.Semicolon_Loc
);
760 -- And indicate we consider the Label OK after all
769 -- Compute setting of Syntax_OK. We definitely have a syntax error
770 -- if the Token does not match properly or if P_End_Scan detected
771 -- a syntax error such as a missing semicolon.
773 if not Token_OK
or not End_OK
then
776 -- Final check is that label is OK. Certainly it is OK if there
777 -- was an exact match on the label (the END label = the stack label)
782 -- Case of label present
784 elsif End_Labl_Present
then
786 -- If probably misspelling, then complain, and pretend it is OK
789 Nam
: constant Node_Or_Entity_Id
:= Scopes
(SS_Index
).Labl
;
792 if Nkind
(End_Labl
) in N_Has_Chars
793 and then Comes_From_Source
(Nam
)
794 and then Nkind
(Nam
) in N_Has_Chars
795 and then Chars
(End_Labl
) > Error_Name
796 and then Chars
(Nam
) > Error_Name
798 Error_Msg_Name_1
:= Chars
(Nam
);
800 if Error_Msg_Name_1
> Error_Name
then
801 if Is_Bad_Spelling_Of
(Chars
(Nam
), Chars
(End_Labl
)) then
802 Error_Msg_Name_1
:= Chars
(Nam
);
803 Error_Msg_N
-- CODEFIX
804 ("misspelling of %", End_Labl
);
814 -- Otherwise we have cases of no label on the END line. For the loop
815 -- case, this is acceptable only if the loop is unlabeled.
817 elsif End_Type
= E_Loop
then
818 Syntax_OK
:= not Explicit_Start_Label
(SS_Index
);
820 -- Cases where a label is definitely allowed on the END line
822 elsif End_Type
= E_Name
then
823 Syntax_OK
:= not Explicit_Start_Label
(SS_Index
)
825 not Scopes
(SS_Index
).Lreq
;
827 -- Otherwise we have cases which don't allow labels anyway, so we
828 -- certainly accept an END which does not have a label.
833 end Evaluate_End_Entry
;
835 --------------------------
836 -- Explicit_Start_Label --
837 --------------------------
839 function Explicit_Start_Label
(SS_Index
: Nat
) return Boolean is
840 L
: constant Node_Id
:= Scopes
(SS_Index
).Labl
;
841 Etyp
: constant SS_End_Type
:= Scopes
(SS_Index
).Etyp
;
847 -- In the following test we protect the call to Comes_From_Source
848 -- against lines containing previously reported syntax errors.
850 elsif (Etyp
= E_Loop
or else
851 Etyp
= E_Name
or else
852 Etyp
= E_Suspicious_Is
or else
854 and then Comes_From_Source
(L
)
861 end Explicit_Start_Label
;
863 ------------------------
864 -- Output_End_Deleted --
865 ------------------------
867 procedure Output_End_Deleted
is
869 if End_Type
= E_Loop
then
870 Error_Msg_SC
("no LOOP for this `END LOOP`!");
872 elsif End_Type
= E_Case
then
873 Error_Msg_SC
("no CASE for this `END CASE`");
875 elsif End_Type
= E_If
then
876 Error_Msg_SC
("no IF for this `END IF`!");
878 elsif End_Type
= E_Record
then
879 Error_Msg_SC
("no RECORD for this `END RECORD`!");
881 elsif End_Type
= E_Return
then
882 Error_Msg_SC
("no RETURN for this `END RETURN`!");
884 elsif End_Type
= E_Select
then
885 Error_Msg_SC
("no SELECT for this `END SELECT`!");
888 Error_Msg_SC
("no BEGIN for this END!");
890 end Output_End_Deleted
;
892 -------------------------
893 -- Output_End_Expected --
894 -------------------------
896 procedure Output_End_Expected
(Ins
: Boolean) is
897 End_Type
: SS_End_Type
;
900 -- Suppress message if this was a potentially junk entry (e.g. a record
901 -- entry where no record keyword was present).
903 if Scopes
(Scope
.Last
).Junk
then
907 End_Type
:= Scopes
(Scope
.Last
).Etyp
;
908 Error_Msg_Col
:= Scopes
(Scope
.Last
).Ecol
;
909 Error_Msg_Sloc
:= Scopes
(Scope
.Last
).Sloc
;
911 if Explicit_Start_Label
(Scope
.Last
) then
912 Error_Msg_Node_1
:= Scopes
(Scope
.Last
).Labl
;
914 Error_Msg_Node_1
:= Empty
;
917 -- Suppress message if error was posted on opening label
919 if Error_Msg_Node_1
> Empty_Or_Error
920 and then Error_Posted
(Error_Msg_Node_1
)
925 if End_Type
= E_Case
then
926 Error_Msg_SC
-- CODEFIX
927 ("`END CASE;` expected@ for CASE#!");
929 elsif End_Type
= E_If
then
930 Error_Msg_SC
-- CODEFIX
931 ("`END IF;` expected@ for IF#!");
933 elsif End_Type
= E_Loop
then
934 if Error_Msg_Node_1
= Empty
then
935 Error_Msg_SC
-- CODEFIX
936 ("`END LOOP;` expected@ for LOOP#!");
938 Error_Msg_SC
-- CODEFIX
939 ("`END LOOP &;` expected@!");
942 elsif End_Type
= E_Record
then
943 Error_Msg_SC
-- CODEFIX
944 ("`END RECORD;` expected@ for RECORD#!");
946 elsif End_Type
= E_Return
then
947 Error_Msg_SC
-- CODEFIX
948 ("`END RETURN;` expected@ for RETURN#!");
950 elsif End_Type
= E_Select
then
951 Error_Msg_SC
-- CODEFIX
952 ("`END SELECT;` expected@ for SELECT#!");
954 -- All remaining cases are cases with a name (we do not treat the
955 -- suspicious is cases specially for a replaced end, only for an
958 elsif End_Type
= E_Name
or else not Ins
then
959 if Error_Msg_Node_1
= Empty
then
960 Error_Msg_SC
-- CODEFIX
961 ("`END;` expected@ for BEGIN#!");
963 Error_Msg_SC
-- CODEFIX
964 ("`END &;` expected@!");
967 -- The other possibility is a missing END for a subprogram with a
968 -- suspicious IS (that probably should have been a semicolon). The
969 -- missing IS confirms the suspicion.
971 else -- End_Type = E_Suspicious_Is or E_Bad_Is
972 Scopes
(Scope
.Last
).Etyp
:= E_Bad_Is
;
974 end Output_End_Expected
;
976 ------------------------
977 -- Output_End_Missing --
978 ------------------------
980 procedure Output_End_Missing
is
981 End_Type
: SS_End_Type
;
984 -- Suppress message if this was a potentially junk entry (e.g. a record
985 -- entry where no record keyword was present).
987 if Scopes
(Scope
.Last
).Junk
then
991 End_Type
:= Scopes
(Scope
.Last
).Etyp
;
992 Error_Msg_Sloc
:= Scopes
(Scope
.Last
).Sloc
;
994 if Explicit_Start_Label
(Scope
.Last
) then
995 Error_Msg_Node_1
:= Scopes
(Scope
.Last
).Labl
;
997 Error_Msg_Node_1
:= Empty
;
1000 if End_Type
= E_Case
then
1001 Error_Msg_BC
("missing `END CASE;` for CASE#!");
1003 elsif End_Type
= E_If
then
1004 Error_Msg_BC
("missing `END IF;` for IF#!");
1006 elsif End_Type
= E_Loop
then
1007 if Error_Msg_Node_1
= Empty
then
1008 Error_Msg_BC
("missing `END LOOP;` for LOOP#!");
1010 Error_Msg_BC
("missing `END LOOP &;`!");
1013 elsif End_Type
= E_Record
then
1015 ("missing `END RECORD;` for RECORD#!");
1017 elsif End_Type
= E_Return
then
1019 ("missing `END RETURN;` for RETURN#!");
1021 elsif End_Type
= E_Select
then
1023 ("missing `END SELECT;` for SELECT#!");
1025 elsif End_Type
= E_Name
then
1026 if Error_Msg_Node_1
= Empty
then
1027 Error_Msg_BC
("missing `END;` for BEGIN#!");
1029 Error_Msg_BC
("missing `END &;`!");
1032 else -- End_Type = E_Suspicious_Is or E_Bad_Is
1033 Scopes
(Scope
.Last
).Etyp
:= E_Bad_Is
;
1035 end Output_End_Missing
;
1037 ---------------------
1038 -- Pop_End_Context --
1039 ---------------------
1041 procedure Pop_End_Context
is
1043 Pretty_Good
: Boolean;
1044 -- This flag is set True if the END sequence is syntactically incorrect,
1045 -- but is (from a heuristic point of view), pretty likely to be simply
1046 -- a misspelling of the intended END.
1048 Outer_Match
: Boolean;
1049 -- This flag is set True if we decide that the current END sequence
1050 -- belongs to some outer level entry in the scope stack, and thus
1051 -- we will NOT eat it up in matching the current expected END.
1054 -- If not at END, then output END expected message
1056 if End_Type
= E_Dummy
then
1059 End_Action
:= Insert_And_Accept
;
1062 -- Otherwise we do have an END present
1065 -- A special check. If we have END; followed by an end of file,
1066 -- WITH or SEPARATE, then if we are not at the outer level, then
1067 -- we have a syntax error. Consider the example:
1079 -- Now the END; here is a syntactically correct closer for the
1080 -- declare block, but if we eat it up, then we obviously have
1081 -- a missing END for the outer context (since WITH can only appear
1082 -- at the outer level.
1084 -- In this situation, we always reserve the END; for the outer level,
1085 -- even if it is in the wrong column. This is because it's much more
1086 -- useful to have the error message point to the DECLARE than to the
1087 -- package header in this case.
1089 -- We also reserve an end with a name before the end of file if the
1090 -- name is the one we expect at the outer level.
1092 if (Token
= Tok_EOF
or else
1093 Token
= Tok_With
or else
1094 Token
= Tok_Separate
)
1095 and then End_Type
>= E_Name
1096 and then (not End_Labl_Present
1097 or else Same_Label
(End_Labl
, Scopes
(1).Labl
))
1098 and then Scope
.Last
> 1
1100 Restore_Scan_State
(Scan_State
); -- to END
1101 Output_End_Expected
(Ins
=> True);
1103 End_Action
:= Insert_And_Accept
;
1107 -- Otherwise we go through the normal END evaluation procedure
1109 Evaluate_End_Entry
(Scope
.Last
);
1111 -- If top entry in stack is syntactically correct, then we have
1112 -- scanned it out and everything is fine. This is the required
1113 -- action to properly process correct Ada programs.
1117 -- Complain if checking columns and END is not in right column.
1118 -- Right in this context means exactly right, or on the same
1119 -- line as the opener.
1121 if RM_Column_Check
then
1122 if End_Column
/= Scopes
(Scope
.Last
).Ecol
1123 and then Current_Line_Start
> Scopes
(Scope
.Last
).Sloc
1125 -- A special case, for END RECORD, we are also allowed to
1126 -- line up with the TYPE keyword opening the declaration.
1128 and then (Scopes
(Scope
.Last
).Etyp
/= E_Record
1129 or else Get_Column_Number
(End_Sloc
) /=
1130 Get_Column_Number
(Type_Token_Location
))
1132 Error_Msg_Col
:= Scopes
(Scope
.Last
).Ecol
;
1134 ("(style) END in wrong column, should be@?l?", End_Sloc
);
1138 -- One final check. If the end had a label, check for an exact
1139 -- duplicate of this end sequence, and if so, skip it with an
1140 -- appropriate message.
1142 if End_Labl_Present
and then Token
= Tok_End
then
1144 Scan_State
: Saved_Scan_State
;
1145 End_Loc
: constant Source_Ptr
:= Token_Ptr
;
1147 Dup_Found
: Boolean := False;
1150 Save_Scan_State
(Scan_State
);
1154 if Token
in Tok_Identifier | Tok_Operator_Symbol
then
1155 Nxt_Labl
:= P_Designator
;
1157 -- We only consider it an error if the label is a match
1158 -- and would be wrong for the level one above us, and
1159 -- the indentation is the same.
1161 if Token
= Tok_Semicolon
1162 and then Same_Label
(End_Labl
, Nxt_Labl
)
1163 and then End_Column
= Start_Column
1167 not Explicit_Start_Label
(Scope
.Last
- 1)
1171 Scopes
(Scope
.Last
- 1).Labl
))
1174 Error_Msg
("duplicate end line ignored", End_Loc
);
1179 if not Dup_Found
then
1180 Restore_Scan_State
(Scan_State
);
1185 -- All OK, so return to caller indicating END is OK
1188 End_Action
:= Accept_As_Scanned
;
1192 -- If that check failed, then we definitely have an error. The issue
1193 -- is how to choose among three possible courses of action:
1195 -- 1. Ignore the current END text completely, scanning past it,
1196 -- deciding that it belongs neither to the current context,
1197 -- nor to any outer context.
1199 -- 2. Accept the current END text, scanning past it, and issuing
1200 -- an error message that it does not have the right form.
1202 -- 3. Leave the current END text in place, NOT scanning past it,
1203 -- issuing an error message indicating the END expected for the
1204 -- current context. In this case, the END is available to match
1205 -- some outer END context.
1207 -- From a correct functioning point of view, it does not make any
1208 -- difference which of these three approaches we take, the program
1209 -- will work correctly in any case. However, making an accurate
1210 -- choice among these alternatives, i.e. choosing the one that
1211 -- corresponds to what the programmer had in mind, does make a
1212 -- significant difference in the quality of error recovery.
1214 Restore_Scan_State
(Scan_State
); -- to END
1216 -- First we see how good the current END entry is with respect to
1217 -- what we expect. It is considered pretty good if the token is OK,
1218 -- and either the label or the column matches. An END for RECORD is
1219 -- always considered to be pretty good in the record case. This is
1220 -- because not only does a record disallow a nested structure, but
1221 -- also it is unlikely that such nesting could occur by accident.
1223 Pretty_Good
:= (Token_OK
and (Column_OK
or Label_OK
))
1224 or else Scopes
(Scope
.Last
).Etyp
= E_Record
;
1226 -- Next check, if there is a deeper entry in the stack which
1227 -- has a very high probability of being acceptable, then insert
1228 -- the END entry we want, leaving the higher level entry for later
1230 for J
in reverse 1 .. Scope
.Last
- 1 loop
1231 Evaluate_End_Entry
(J
);
1233 -- To even consider the deeper entry to be immediately acceptable,
1234 -- it must be syntactically correct. Furthermore it must either
1235 -- have a correct label, or the correct column. If the current
1236 -- entry was a close match (Pretty_Good set), then we are even
1237 -- more strict in accepting the outer level one: even if it has
1238 -- the right label, it must have the right column as well.
1242 Outer_Match
:= Label_OK
and Column_OK
;
1244 Outer_Match
:= Label_OK
or Column_OK
;
1247 Outer_Match
:= False;
1250 -- If the outer entry does convincingly match the END text, then
1251 -- back up the scan to the start of the END sequence, issue an
1252 -- error message indicating the END we expected, and return with
1253 -- Token pointing to the END (case 3 from above discussion).
1258 End_Action
:= Insert_And_Accept
;
1263 -- Here we have a situation in which the current END entry is
1264 -- syntactically incorrect, but there is no deeper entry in the
1265 -- END stack which convincingly matches it.
1267 -- If the END text was judged to be a Pretty_Good match for the
1268 -- expected token or if it appears left of the expected column,
1269 -- then we will accept it as the one we want, scanning past it, even
1270 -- though it is not completely right (we issue a message showing what
1271 -- we expected it to be). This is action 2 from the discussion above.
1272 -- There is one other special case to consider: the LOOP case.
1273 -- Consider the example:
1279 -- Here the column lines up with Lbl, so END LOOP is to the right,
1280 -- but it is still acceptable. LOOP is the one case where alignment
1281 -- practices vary substantially in practice.
1284 or else End_Column
<= Scopes
(Scope
.Last
).Ecol
1285 or else (End_Type
= Scopes
(Scope
.Last
).Etyp
1286 and then End_Type
= E_Loop
)
1288 Output_End_Expected
(Ins
=> False);
1290 End_Action
:= Skip_And_Accept
;
1293 -- Here we have the case where the END is to the right of the
1294 -- expected column and does not have a correct label to convince
1295 -- us that it nevertheless belongs to the current scope. For this
1296 -- we consider that it probably belongs not to the current context,
1297 -- but to some inner context that was not properly recognized (due to
1298 -- other syntax errors), and for which no proper scope stack entry
1299 -- was made. The proper action in this case is to delete the END text
1300 -- and return False to the caller as a signal to keep on looking for
1301 -- an acceptable END. This is action 1 from the discussion above.
1305 End_Action
:= Skip_And_Reject
;
1309 end Pop_End_Context
;
1315 function Same_Label
(Label1
, Label2
: Node_Id
) return Boolean is
1317 if Nkind
(Label1
) in N_Has_Chars
1318 and then Nkind
(Label2
) in N_Has_Chars
1320 return Chars
(Label1
) = Chars
(Label2
);
1322 elsif Nkind
(Label1
) = N_Selected_Component
1323 and then Nkind
(Label2
) = N_Selected_Component
1325 return Same_Label
(Prefix
(Label1
), Prefix
(Label2
)) and then
1326 Same_Label
(Selector_Name
(Label1
), Selector_Name
(Label2
));
1328 elsif Nkind
(Label1
) = N_Designator
1329 and then Nkind
(Label2
) = N_Defining_Program_Unit_Name
1331 return Same_Label
(Name
(Label1
), Name
(Label2
)) and then
1332 Same_Label
(Identifier
(Label1
), Defining_Identifier
(Label2
));