1 |
706 |
jeremybenn |
------------------------------------------------------------------------------
|
2 |
|
|
-- --
|
3 |
|
|
-- GNAT COMPILER COMPONENTS --
|
4 |
|
|
-- --
|
5 |
|
|
-- P A R . E N D H --
|
6 |
|
|
-- --
|
7 |
|
|
-- B o d y --
|
8 |
|
|
-- --
|
9 |
|
|
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
|
10 |
|
|
-- --
|
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. --
|
20 |
|
|
-- --
|
21 |
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
22 |
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
23 |
|
|
-- --
|
24 |
|
|
------------------------------------------------------------------------------
|
25 |
|
|
|
26 |
|
|
with Namet.Sp; use Namet.Sp;
|
27 |
|
|
with Stringt; use Stringt;
|
28 |
|
|
with Uintp; use Uintp;
|
29 |
|
|
|
30 |
|
|
with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
|
31 |
|
|
|
32 |
|
|
separate (Par)
|
33 |
|
|
package body Endh is
|
34 |
|
|
|
35 |
|
|
----------------
|
36 |
|
|
-- Local Data --
|
37 |
|
|
----------------
|
38 |
|
|
|
39 |
|
|
type End_Action_Type is (
|
40 |
|
|
-- Type used to describe the result of the Pop_End_Context call
|
41 |
|
|
|
42 |
|
|
Accept_As_Scanned,
|
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).
|
46 |
|
|
|
47 |
|
|
Insert_And_Accept,
|
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.
|
53 |
|
|
|
54 |
|
|
Skip_And_Accept,
|
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.
|
59 |
|
|
|
60 |
|
|
Skip_And_Reject);
|
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.
|
65 |
|
|
|
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.
|
69 |
|
|
|
70 |
|
|
End_Sloc : Source_Ptr;
|
71 |
|
|
-- Source location of END token
|
72 |
|
|
|
73 |
|
|
End_OK : Boolean;
|
74 |
|
|
-- Set False if error is found in END line
|
75 |
|
|
|
76 |
|
|
End_Column : Column_Number;
|
77 |
|
|
-- Column of END line
|
78 |
|
|
|
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)
|
82 |
|
|
|
83 |
|
|
End_Labl : Node_Id;
|
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.
|
88 |
|
|
|
89 |
|
|
End_Labl_Present : Boolean;
|
90 |
|
|
-- Indicates that the value in End_Labl was for an explicit label
|
91 |
|
|
|
92 |
|
|
Syntax_OK : Boolean;
|
93 |
|
|
-- Set True if the entry is syntactically correct
|
94 |
|
|
|
95 |
|
|
Token_OK : Boolean;
|
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.
|
98 |
|
|
|
99 |
|
|
Label_OK : Boolean;
|
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.
|
106 |
|
|
|
107 |
|
|
Column_OK : Boolean;
|
108 |
|
|
-- Column_OK is set True if the END sequence appears in the expected column
|
109 |
|
|
|
110 |
|
|
Scan_State : Saved_Scan_State;
|
111 |
|
|
-- Save state at start of END sequence, in case we decide not to eat it up
|
112 |
|
|
|
113 |
|
|
-----------------------
|
114 |
|
|
-- Local Subprograms --
|
115 |
|
|
-----------------------
|
116 |
|
|
|
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.
|
122 |
|
|
|
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).
|
127 |
|
|
|
128 |
|
|
procedure Output_End_Deleted;
|
129 |
|
|
-- Output a message complaining that the current END structure does not
|
130 |
|
|
-- match anything and is being deleted.
|
131 |
|
|
|
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.
|
141 |
|
|
|
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.
|
148 |
|
|
|
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.
|
154 |
|
|
|
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.
|
164 |
|
|
|
165 |
|
|
---------------
|
166 |
|
|
-- Check_End --
|
167 |
|
|
---------------
|
168 |
|
|
|
169 |
|
|
function Check_End
|
170 |
|
|
(Decl : Node_Id := Empty;
|
171 |
|
|
Is_Loc : Source_Ptr := No_Location) return Boolean
|
172 |
|
|
is
|
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
|
178 |
|
|
-- following line.
|
179 |
|
|
|
180 |
|
|
Name_Scan_State : Saved_Scan_State;
|
181 |
|
|
-- Save state at start of name if Name_On_Separate_Line is TRUE
|
182 |
|
|
|
183 |
|
|
Span_Node : constant Node_Id := Scope.Table (Scope.Last).Node;
|
184 |
|
|
|
185 |
|
|
begin
|
186 |
|
|
End_Labl_Present := False;
|
187 |
|
|
End_Labl := Empty;
|
188 |
|
|
|
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.
|
191 |
|
|
|
192 |
|
|
if Token /= Tok_End then
|
193 |
|
|
End_Type := E_Dummy;
|
194 |
|
|
|
195 |
|
|
else
|
196 |
|
|
Save_Scan_State (Scan_State); -- at END
|
197 |
|
|
End_Sloc := Token_Ptr;
|
198 |
|
|
End_Column := Start_Column;
|
199 |
|
|
End_OK := True;
|
200 |
|
|
Scan; -- past END
|
201 |
|
|
|
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.
|
206 |
|
|
|
207 |
|
|
if Present (Span_Node) then
|
208 |
|
|
Set_End_Location (Span_Node, Token_Ptr);
|
209 |
|
|
end if;
|
210 |
|
|
|
211 |
|
|
-- Cases of keywords where no label is allowed
|
212 |
|
|
|
213 |
|
|
if Token = Tok_Case then
|
214 |
|
|
End_Type := E_Case;
|
215 |
|
|
Scan; -- past CASE
|
216 |
|
|
|
217 |
|
|
elsif Token = Tok_If then
|
218 |
|
|
End_Type := E_If;
|
219 |
|
|
Scan; -- past IF
|
220 |
|
|
|
221 |
|
|
elsif Token = Tok_Record then
|
222 |
|
|
End_Type := E_Record;
|
223 |
|
|
Scan; -- past RECORD
|
224 |
|
|
|
225 |
|
|
elsif Token = Tok_Return then
|
226 |
|
|
End_Type := E_Return;
|
227 |
|
|
Scan; -- past RETURN
|
228 |
|
|
|
229 |
|
|
elsif Token = Tok_Select then
|
230 |
|
|
End_Type := E_Select;
|
231 |
|
|
Scan; -- past SELECT
|
232 |
|
|
|
233 |
|
|
-- Cases which do allow labels
|
234 |
|
|
|
235 |
|
|
else
|
236 |
|
|
-- LOOP
|
237 |
|
|
|
238 |
|
|
if Token = Tok_Loop then
|
239 |
|
|
Scan; -- past LOOP
|
240 |
|
|
End_Type := E_Loop;
|
241 |
|
|
|
242 |
|
|
-- FOR or WHILE allowed (signalling error) to substitute for LOOP
|
243 |
|
|
-- if on the same line as the END.
|
244 |
|
|
|
245 |
|
|
elsif (Token = Tok_For or else Token = Tok_While)
|
246 |
|
|
and then not Token_Is_At_Start_Of_Line
|
247 |
|
|
then
|
248 |
|
|
Scan; -- past FOR or WHILE
|
249 |
|
|
End_Type := E_Loop;
|
250 |
|
|
End_OK := False;
|
251 |
|
|
|
252 |
|
|
-- Cases with no keyword
|
253 |
|
|
|
254 |
|
|
else
|
255 |
|
|
End_Type := E_Name;
|
256 |
|
|
end if;
|
257 |
|
|
|
258 |
|
|
-- Now see if a name is present
|
259 |
|
|
|
260 |
|
|
if Token = Tok_Identifier or else
|
261 |
|
|
Token = Tok_String_Literal or else
|
262 |
|
|
Token = Tok_Operator_Symbol
|
263 |
|
|
then
|
264 |
|
|
if Token_Is_At_Start_Of_Line then
|
265 |
|
|
Name_On_Separate_Line := True;
|
266 |
|
|
Save_Scan_State (Name_Scan_State);
|
267 |
|
|
else
|
268 |
|
|
Name_On_Separate_Line := False;
|
269 |
|
|
end if;
|
270 |
|
|
|
271 |
|
|
End_Labl := P_Designator;
|
272 |
|
|
End_Labl_Present := True;
|
273 |
|
|
|
274 |
|
|
-- We have now scanned out a name. Here is where we do a check
|
275 |
|
|
-- to catch the cases like:
|
276 |
|
|
--
|
277 |
|
|
-- end loop
|
278 |
|
|
-- X := 3;
|
279 |
|
|
--
|
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.
|
284 |
|
|
|
285 |
|
|
if Name_On_Separate_Line then
|
286 |
|
|
if Token /= Tok_Semicolon or else
|
287 |
|
|
not Same_Label (End_Labl, Scope.Table (Scope.Last).Labl)
|
288 |
|
|
then
|
289 |
|
|
Restore_Scan_State (Name_Scan_State);
|
290 |
|
|
End_Labl := Empty;
|
291 |
|
|
End_Labl_Present := False;
|
292 |
|
|
end if;
|
293 |
|
|
end if;
|
294 |
|
|
|
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.
|
298 |
|
|
|
299 |
|
|
else
|
300 |
|
|
End_Labl := Scope.Table (Scope.Last).Labl;
|
301 |
|
|
|
302 |
|
|
if End_Labl > Empty_Or_Error then
|
303 |
|
|
|
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.
|
309 |
|
|
|
310 |
|
|
-- Case of child unit name
|
311 |
|
|
|
312 |
|
|
if Nkind (End_Labl) = N_Defining_Program_Unit_Name then
|
313 |
|
|
Child_End : declare
|
314 |
|
|
Eref : constant Node_Id :=
|
315 |
|
|
Make_Identifier (Token_Ptr,
|
316 |
|
|
Chars =>
|
317 |
|
|
Chars (Defining_Identifier (End_Labl)));
|
318 |
|
|
|
319 |
|
|
function Copy_Name (N : Node_Id) return Node_Id;
|
320 |
|
|
-- Copies a selected component or identifier
|
321 |
|
|
|
322 |
|
|
---------------
|
323 |
|
|
-- Copy_Name --
|
324 |
|
|
---------------
|
325 |
|
|
|
326 |
|
|
function Copy_Name (N : Node_Id) return Node_Id is
|
327 |
|
|
R : Node_Id;
|
328 |
|
|
|
329 |
|
|
begin
|
330 |
|
|
if Nkind (N) = N_Selected_Component then
|
331 |
|
|
return
|
332 |
|
|
Make_Selected_Component (Token_Ptr,
|
333 |
|
|
Prefix =>
|
334 |
|
|
Copy_Name (Prefix (N)),
|
335 |
|
|
Selector_Name =>
|
336 |
|
|
Copy_Name (Selector_Name (N)));
|
337 |
|
|
|
338 |
|
|
else
|
339 |
|
|
R := Make_Identifier (Token_Ptr, Chars (N));
|
340 |
|
|
Set_Comes_From_Source (N, False);
|
341 |
|
|
return R;
|
342 |
|
|
end if;
|
343 |
|
|
end Copy_Name;
|
344 |
|
|
|
345 |
|
|
-- Start of processing for Child_End
|
346 |
|
|
|
347 |
|
|
begin
|
348 |
|
|
Set_Comes_From_Source (Eref, False);
|
349 |
|
|
|
350 |
|
|
End_Labl :=
|
351 |
|
|
Make_Designator (Token_Ptr,
|
352 |
|
|
Name => Copy_Name (Name (End_Labl)),
|
353 |
|
|
Identifier => Eref);
|
354 |
|
|
end Child_End;
|
355 |
|
|
|
356 |
|
|
-- Simple identifier case
|
357 |
|
|
|
358 |
|
|
elsif Nkind (End_Labl) = N_Defining_Identifier
|
359 |
|
|
or else Nkind (End_Labl) = N_Identifier
|
360 |
|
|
then
|
361 |
|
|
End_Labl := Make_Identifier (Token_Ptr, Chars (End_Labl));
|
362 |
|
|
|
363 |
|
|
elsif Nkind (End_Labl) = N_Defining_Operator_Symbol
|
364 |
|
|
or else Nkind (End_Labl) = N_Operator_Symbol
|
365 |
|
|
then
|
366 |
|
|
Get_Decoded_Name_String (Chars (End_Labl));
|
367 |
|
|
|
368 |
|
|
End_Labl :=
|
369 |
|
|
Make_Operator_Symbol (Token_Ptr,
|
370 |
|
|
Chars => Chars (End_Labl),
|
371 |
|
|
Strval => String_From_Name_Buffer);
|
372 |
|
|
end if;
|
373 |
|
|
|
374 |
|
|
Set_Comes_From_Source (End_Labl, False);
|
375 |
|
|
End_Labl_Present := False;
|
376 |
|
|
|
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
|
380 |
|
|
-- independently.
|
381 |
|
|
|
382 |
|
|
if Style_Check
|
383 |
|
|
and then End_Type = E_Name
|
384 |
|
|
and then Explicit_Start_Label (Scope.Last)
|
385 |
|
|
and then Nkind (Parent (Scope.Table (Scope.Last).Labl))
|
386 |
|
|
/= N_Block_Statement
|
387 |
|
|
then
|
388 |
|
|
Style.No_End_Name (Scope.Table (Scope.Last).Labl);
|
389 |
|
|
end if;
|
390 |
|
|
end if;
|
391 |
|
|
end if;
|
392 |
|
|
end if;
|
393 |
|
|
|
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
|
397 |
|
|
-- a higher level.
|
398 |
|
|
|
399 |
|
|
if End_Type /= E_Record then
|
400 |
|
|
|
401 |
|
|
-- Scan aspect specifications
|
402 |
|
|
|
403 |
|
|
if Aspect_Specifications_Present then
|
404 |
|
|
|
405 |
|
|
-- Aspect specifications not allowed
|
406 |
|
|
|
407 |
|
|
if No (Decl) then
|
408 |
|
|
|
409 |
|
|
-- Package declaration case
|
410 |
|
|
|
411 |
|
|
if Is_Loc /= No_Location then
|
412 |
|
|
Error_Msg_SC
|
413 |
|
|
("misplaced aspects for package declaration");
|
414 |
|
|
Error_Msg
|
415 |
|
|
("info: aspect specifications belong here", Is_Loc);
|
416 |
|
|
P_Aspect_Specifications (Empty);
|
417 |
|
|
|
418 |
|
|
-- Other cases where aspect specifications are not allowed
|
419 |
|
|
|
420 |
|
|
else
|
421 |
|
|
P_Aspect_Specifications (Error);
|
422 |
|
|
end if;
|
423 |
|
|
|
424 |
|
|
-- Aspect specifications allowed
|
425 |
|
|
|
426 |
|
|
else
|
427 |
|
|
P_Aspect_Specifications (Decl);
|
428 |
|
|
end if;
|
429 |
|
|
|
430 |
|
|
-- If no aspect specifications, must have a semicolon
|
431 |
|
|
|
432 |
|
|
elsif End_Type /= E_Record then
|
433 |
|
|
if Token = Tok_Semicolon then
|
434 |
|
|
T_Semicolon;
|
435 |
|
|
|
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).
|
442 |
|
|
|
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.
|
446 |
|
|
|
447 |
|
|
elsif Token_Is_At_Start_Of_Line
|
448 |
|
|
or else Token = Tok_Colon
|
449 |
|
|
or else Token = Tok_Dot
|
450 |
|
|
then
|
451 |
|
|
T_Semicolon;
|
452 |
|
|
|
453 |
|
|
-- If the missing semicolon is not at the start of the line,
|
454 |
|
|
-- then we consider the END line to be dubious in this sense.
|
455 |
|
|
|
456 |
|
|
else
|
457 |
|
|
End_OK := False;
|
458 |
|
|
end if;
|
459 |
|
|
end if;
|
460 |
|
|
end if;
|
461 |
|
|
end if;
|
462 |
|
|
|
463 |
|
|
-- Now we call the Pop_End_Context routine to get a recommendation
|
464 |
|
|
-- as to what should be done with the END sequence we have scanned.
|
465 |
|
|
|
466 |
|
|
Pop_End_Context;
|
467 |
|
|
|
468 |
|
|
-- Remaining action depends on End_Action set by Pop_End_Context
|
469 |
|
|
|
470 |
|
|
case End_Action is
|
471 |
|
|
|
472 |
|
|
-- Accept_As_Scanned. In this case, Pop_End_Context left Token
|
473 |
|
|
-- pointing past the last token of a syntactically correct END
|
474 |
|
|
|
475 |
|
|
when Accept_As_Scanned =>
|
476 |
|
|
|
477 |
|
|
-- Syntactically correct included the possibility of a missing
|
478 |
|
|
-- semicolon. If we do have a missing semicolon, then we have
|
479 |
|
|
-- already given a message, but now we scan out possible rubbish
|
480 |
|
|
-- on the same line as the END
|
481 |
|
|
|
482 |
|
|
while not Token_Is_At_Start_Of_Line
|
483 |
|
|
and then Prev_Token /= Tok_Record
|
484 |
|
|
and then Prev_Token /= Tok_Semicolon
|
485 |
|
|
and then Token /= Tok_End
|
486 |
|
|
and then Token /= Tok_EOF
|
487 |
|
|
loop
|
488 |
|
|
Scan; -- past junk
|
489 |
|
|
end loop;
|
490 |
|
|
|
491 |
|
|
return True;
|
492 |
|
|
|
493 |
|
|
-- Insert_And_Accept. In this case, Pop_End_Context has reset Token
|
494 |
|
|
-- to point to the start of the END sequence, and recommends that it
|
495 |
|
|
-- be left in place to satisfy an outer scope level END. This means
|
496 |
|
|
-- that we proceed as though an END were present, and leave the scan
|
497 |
|
|
-- pointer unchanged.
|
498 |
|
|
|
499 |
|
|
when Insert_And_Accept =>
|
500 |
|
|
return True;
|
501 |
|
|
|
502 |
|
|
-- Skip_And_Accept. In this case, Pop_End_Context has reset Token
|
503 |
|
|
-- to point to the start of the END sequence. This END sequence is
|
504 |
|
|
-- syntactically incorrect, and an appropriate error message has
|
505 |
|
|
-- already been posted. Pop_End_Context recommends accepting the
|
506 |
|
|
-- END sequence as the one we want, so we skip past it and then
|
507 |
|
|
-- proceed as though an END were present.
|
508 |
|
|
|
509 |
|
|
when Skip_And_Accept =>
|
510 |
|
|
End_Skip;
|
511 |
|
|
return True;
|
512 |
|
|
|
513 |
|
|
-- Skip_And_Reject. In this case, Pop_End_Context has reset Token
|
514 |
|
|
-- to point to the start of the END sequence. This END sequence is
|
515 |
|
|
-- syntactically incorrect, and an appropriate error message has
|
516 |
|
|
-- already been posted. Pop_End_Context recommends entirely ignoring
|
517 |
|
|
-- this END sequence, so we skip past it and then return False, since
|
518 |
|
|
-- as far as the caller is concerned, no END sequence is present.
|
519 |
|
|
|
520 |
|
|
when Skip_And_Reject =>
|
521 |
|
|
End_Skip;
|
522 |
|
|
return False;
|
523 |
|
|
end case;
|
524 |
|
|
end Check_End;
|
525 |
|
|
|
526 |
|
|
--------------
|
527 |
|
|
-- End Skip --
|
528 |
|
|
--------------
|
529 |
|
|
|
530 |
|
|
-- This procedure skips past an END sequence. On entry Token contains
|
531 |
|
|
-- Tok_End, and we know that the END sequence is syntactically incorrect,
|
532 |
|
|
-- and that an appropriate error message has already been posted. The
|
533 |
|
|
-- mission is simply to position the scan pointer to be the best guess of
|
534 |
|
|
-- the position after the END sequence. We do not issue any additional
|
535 |
|
|
-- error messages while carrying this out.
|
536 |
|
|
|
537 |
|
|
-- Error recovery: does not raise Error_Resync
|
538 |
|
|
|
539 |
|
|
procedure End_Skip is
|
540 |
|
|
begin
|
541 |
|
|
Scan; -- past END
|
542 |
|
|
|
543 |
|
|
-- If the scan past the END leaves us on the next line, that's probably
|
544 |
|
|
-- where we should quit the scan, since it is likely that what we have
|
545 |
|
|
-- is a missing semicolon. Consider the following:
|
546 |
|
|
|
547 |
|
|
-- END
|
548 |
|
|
-- Process_Input;
|
549 |
|
|
|
550 |
|
|
-- This will have looked like a syntactically valid END sequence to the
|
551 |
|
|
-- initial scan of the END, but subsequent checking will have determined
|
552 |
|
|
-- that the label Process_Input is not an appropriate label. The real
|
553 |
|
|
-- error is a missing semicolon after the END, and by leaving the scan
|
554 |
|
|
-- pointer just past the END, we will improve the error recovery.
|
555 |
|
|
|
556 |
|
|
if Token_Is_At_Start_Of_Line then
|
557 |
|
|
return;
|
558 |
|
|
end if;
|
559 |
|
|
|
560 |
|
|
-- If there is a semicolon after the END, scan it out and we are done
|
561 |
|
|
|
562 |
|
|
if Token = Tok_Semicolon then
|
563 |
|
|
T_Semicolon;
|
564 |
|
|
return;
|
565 |
|
|
end if;
|
566 |
|
|
|
567 |
|
|
-- Otherwise skip past a token after the END on the same line. Note
|
568 |
|
|
-- that we do not eat a token on the following line since it seems
|
569 |
|
|
-- very unlikely in any case that the END gets separated from its
|
570 |
|
|
-- token, and we do not want to swallow up a keyword that starts a
|
571 |
|
|
-- legitimate construct following the bad END.
|
572 |
|
|
|
573 |
|
|
if not Token_Is_At_Start_Of_Line
|
574 |
|
|
and then
|
575 |
|
|
|
576 |
|
|
-- Cases of normal tokens following an END
|
577 |
|
|
|
578 |
|
|
(Token = Tok_Case or else
|
579 |
|
|
Token = Tok_For or else
|
580 |
|
|
Token = Tok_If or else
|
581 |
|
|
Token = Tok_Loop or else
|
582 |
|
|
Token = Tok_Record or else
|
583 |
|
|
Token = Tok_Select or else
|
584 |
|
|
|
585 |
|
|
-- Cases of bogus keywords ending loops
|
586 |
|
|
|
587 |
|
|
Token = Tok_For or else
|
588 |
|
|
Token = Tok_While or else
|
589 |
|
|
|
590 |
|
|
-- Cases of operator symbol names without quotes
|
591 |
|
|
|
592 |
|
|
Token = Tok_Abs or else
|
593 |
|
|
Token = Tok_And or else
|
594 |
|
|
Token = Tok_Mod or else
|
595 |
|
|
Token = Tok_Not or else
|
596 |
|
|
Token = Tok_Or or else
|
597 |
|
|
Token = Tok_Xor)
|
598 |
|
|
|
599 |
|
|
then
|
600 |
|
|
Scan; -- past token after END
|
601 |
|
|
|
602 |
|
|
-- If that leaves us on the next line, then we are done. This is the
|
603 |
|
|
-- same principle described above for the case of END at line end
|
604 |
|
|
|
605 |
|
|
if Token_Is_At_Start_Of_Line then
|
606 |
|
|
return;
|
607 |
|
|
|
608 |
|
|
-- If we just scanned out record, then we are done, since the
|
609 |
|
|
-- semicolon after END RECORD is not part of the END sequence
|
610 |
|
|
|
611 |
|
|
elsif Prev_Token = Tok_Record then
|
612 |
|
|
return;
|
613 |
|
|
|
614 |
|
|
-- If we have a semicolon, scan it out and we are done
|
615 |
|
|
|
616 |
|
|
elsif Token = Tok_Semicolon then
|
617 |
|
|
T_Semicolon;
|
618 |
|
|
return;
|
619 |
|
|
end if;
|
620 |
|
|
end if;
|
621 |
|
|
|
622 |
|
|
-- Check for a label present on the same line
|
623 |
|
|
|
624 |
|
|
loop
|
625 |
|
|
if Token_Is_At_Start_Of_Line then
|
626 |
|
|
return;
|
627 |
|
|
end if;
|
628 |
|
|
|
629 |
|
|
if Token /= Tok_Identifier
|
630 |
|
|
and then Token /= Tok_Operator_Symbol
|
631 |
|
|
and then Token /= Tok_String_Literal
|
632 |
|
|
then
|
633 |
|
|
exit;
|
634 |
|
|
end if;
|
635 |
|
|
|
636 |
|
|
Scan; -- past identifier, operator symbol or string literal
|
637 |
|
|
|
638 |
|
|
if Token_Is_At_Start_Of_Line then
|
639 |
|
|
return;
|
640 |
|
|
elsif Token = Tok_Dot then
|
641 |
|
|
Scan; -- past dot
|
642 |
|
|
end if;
|
643 |
|
|
end loop;
|
644 |
|
|
|
645 |
|
|
-- Skip final semicolon
|
646 |
|
|
|
647 |
|
|
if Token = Tok_Semicolon then
|
648 |
|
|
T_Semicolon;
|
649 |
|
|
|
650 |
|
|
-- If we don't have a final semicolon, skip until we either encounter
|
651 |
|
|
-- an END token, or a semicolon or the start of the next line. This
|
652 |
|
|
-- allows general junk to follow the end line (normally it is hard to
|
653 |
|
|
-- think that anyone will put anything deliberate here, and remember
|
654 |
|
|
-- that we know there is a missing semicolon in any case). We also
|
655 |
|
|
-- quite on an EOF (or else we would get stuck in an infinite loop
|
656 |
|
|
-- if there is no line end at the end of the last line of the file)
|
657 |
|
|
|
658 |
|
|
else
|
659 |
|
|
while Token /= Tok_End
|
660 |
|
|
and then Token /= Tok_EOF
|
661 |
|
|
and then Token /= Tok_Semicolon
|
662 |
|
|
and then not Token_Is_At_Start_Of_Line
|
663 |
|
|
loop
|
664 |
|
|
Scan; -- past junk token on same line
|
665 |
|
|
end loop;
|
666 |
|
|
end if;
|
667 |
|
|
|
668 |
|
|
return;
|
669 |
|
|
end End_Skip;
|
670 |
|
|
|
671 |
|
|
--------------------
|
672 |
|
|
-- End Statements --
|
673 |
|
|
--------------------
|
674 |
|
|
|
675 |
|
|
-- This procedure is called when END is required or expected to terminate
|
676 |
|
|
-- a sequence of statements. The caller has already made an appropriate
|
677 |
|
|
-- entry on the scope stack to describe the expected form of the END.
|
678 |
|
|
-- End_Statements should only be used in cases where the only appropriate
|
679 |
|
|
-- terminator is END.
|
680 |
|
|
|
681 |
|
|
-- Error recovery: cannot raise Error_Resync;
|
682 |
|
|
|
683 |
|
|
procedure End_Statements
|
684 |
|
|
(Parent : Node_Id := Empty;
|
685 |
|
|
Decl : Node_Id := Empty;
|
686 |
|
|
Is_Sloc : Source_Ptr := No_Location)
|
687 |
|
|
is
|
688 |
|
|
begin
|
689 |
|
|
-- This loop runs more than once in the case where Check_End rejects
|
690 |
|
|
-- the END sequence, as indicated by Check_End returning False.
|
691 |
|
|
|
692 |
|
|
loop
|
693 |
|
|
if Check_End (Decl, Is_Sloc) then
|
694 |
|
|
if Present (Parent) then
|
695 |
|
|
Set_End_Label (Parent, End_Labl);
|
696 |
|
|
end if;
|
697 |
|
|
|
698 |
|
|
return;
|
699 |
|
|
end if;
|
700 |
|
|
|
701 |
|
|
-- Extra statements past the bogus END are discarded. This is not
|
702 |
|
|
-- ideal for maximum error recovery, but it's too much trouble to
|
703 |
|
|
-- find an appropriate place to put them!
|
704 |
|
|
|
705 |
|
|
Discard_Junk_List (P_Sequence_Of_Statements (SS_None));
|
706 |
|
|
end loop;
|
707 |
|
|
end End_Statements;
|
708 |
|
|
|
709 |
|
|
------------------------
|
710 |
|
|
-- Evaluate End Entry --
|
711 |
|
|
------------------------
|
712 |
|
|
|
713 |
|
|
procedure Evaluate_End_Entry (SS_Index : Nat) is
|
714 |
|
|
begin
|
715 |
|
|
Column_OK := (End_Column = Scope.Table (SS_Index).Ecol);
|
716 |
|
|
|
717 |
|
|
Token_OK := (End_Type = Scope.Table (SS_Index).Etyp or else
|
718 |
|
|
(End_Type = E_Name and then
|
719 |
|
|
Scope.Table (SS_Index).Etyp >= E_Name));
|
720 |
|
|
|
721 |
|
|
Label_OK := End_Labl_Present
|
722 |
|
|
and then
|
723 |
|
|
(Same_Label (End_Labl, Scope.Table (SS_Index).Labl)
|
724 |
|
|
or else Scope.Table (SS_Index).Labl = Error);
|
725 |
|
|
|
726 |
|
|
-- Compute setting of Syntax_OK. We definitely have a syntax error
|
727 |
|
|
-- if the Token does not match properly or if P_End_Scan detected
|
728 |
|
|
-- a syntax error such as a missing semicolon.
|
729 |
|
|
|
730 |
|
|
if not Token_OK or not End_OK then
|
731 |
|
|
Syntax_OK := False;
|
732 |
|
|
|
733 |
|
|
-- Final check is that label is OK. Certainly it is OK if there
|
734 |
|
|
-- was an exact match on the label (the END label = the stack label)
|
735 |
|
|
|
736 |
|
|
elsif Label_OK then
|
737 |
|
|
Syntax_OK := True;
|
738 |
|
|
|
739 |
|
|
-- Case of label present
|
740 |
|
|
|
741 |
|
|
elsif End_Labl_Present then
|
742 |
|
|
|
743 |
|
|
-- If probably misspelling, then complain, and pretend it is OK
|
744 |
|
|
|
745 |
|
|
declare
|
746 |
|
|
Nam : constant Node_Or_Entity_Id := Scope.Table (SS_Index).Labl;
|
747 |
|
|
|
748 |
|
|
begin
|
749 |
|
|
if Nkind (End_Labl) in N_Has_Chars
|
750 |
|
|
and then Comes_From_Source (Nam)
|
751 |
|
|
and then Nkind (Nam) in N_Has_Chars
|
752 |
|
|
and then Chars (End_Labl) > Error_Name
|
753 |
|
|
and then Chars (Nam) > Error_Name
|
754 |
|
|
then
|
755 |
|
|
Error_Msg_Name_1 := Chars (Nam);
|
756 |
|
|
|
757 |
|
|
if Error_Msg_Name_1 > Error_Name then
|
758 |
|
|
if Is_Bad_Spelling_Of (Chars (Nam), Chars (End_Labl)) then
|
759 |
|
|
Error_Msg_Name_1 := Chars (Nam);
|
760 |
|
|
Error_Msg_N -- CODEFIX
|
761 |
|
|
("misspelling of %", End_Labl);
|
762 |
|
|
Syntax_OK := True;
|
763 |
|
|
return;
|
764 |
|
|
end if;
|
765 |
|
|
end if;
|
766 |
|
|
end if;
|
767 |
|
|
end;
|
768 |
|
|
|
769 |
|
|
Syntax_OK := False;
|
770 |
|
|
|
771 |
|
|
-- Otherwise we have cases of no label on the END line. For the loop
|
772 |
|
|
-- case, this is acceptable only if the loop is unlabeled.
|
773 |
|
|
|
774 |
|
|
elsif End_Type = E_Loop then
|
775 |
|
|
Syntax_OK := not Explicit_Start_Label (SS_Index);
|
776 |
|
|
|
777 |
|
|
-- Cases where a label is definitely allowed on the END line
|
778 |
|
|
|
779 |
|
|
elsif End_Type = E_Name then
|
780 |
|
|
Syntax_OK := (not Explicit_Start_Label (SS_Index))
|
781 |
|
|
or else
|
782 |
|
|
(not Scope.Table (SS_Index).Lreq);
|
783 |
|
|
|
784 |
|
|
-- Otherwise we have cases which don't allow labels anyway, so we
|
785 |
|
|
-- certainly accept an END which does not have a label.
|
786 |
|
|
|
787 |
|
|
else
|
788 |
|
|
Syntax_OK := True;
|
789 |
|
|
end if;
|
790 |
|
|
end Evaluate_End_Entry;
|
791 |
|
|
|
792 |
|
|
--------------------------
|
793 |
|
|
-- Explicit_Start_Label --
|
794 |
|
|
--------------------------
|
795 |
|
|
|
796 |
|
|
function Explicit_Start_Label (SS_Index : Nat) return Boolean is
|
797 |
|
|
L : constant Node_Id := Scope.Table (SS_Index).Labl;
|
798 |
|
|
Etyp : constant SS_End_Type := Scope.Table (SS_Index).Etyp;
|
799 |
|
|
|
800 |
|
|
begin
|
801 |
|
|
if No (L) then
|
802 |
|
|
return False;
|
803 |
|
|
|
804 |
|
|
-- In the following test we protect the call to Comes_From_Source
|
805 |
|
|
-- against lines containing previously reported syntax errors.
|
806 |
|
|
|
807 |
|
|
elsif (Etyp = E_Loop or else
|
808 |
|
|
Etyp = E_Name or else
|
809 |
|
|
Etyp = E_Suspicious_Is or else
|
810 |
|
|
Etyp = E_Bad_Is)
|
811 |
|
|
and then Comes_From_Source (L)
|
812 |
|
|
then
|
813 |
|
|
return True;
|
814 |
|
|
|
815 |
|
|
else
|
816 |
|
|
return False;
|
817 |
|
|
end if;
|
818 |
|
|
end Explicit_Start_Label;
|
819 |
|
|
|
820 |
|
|
------------------------
|
821 |
|
|
-- Output_End_Deleted --
|
822 |
|
|
------------------------
|
823 |
|
|
|
824 |
|
|
procedure Output_End_Deleted is
|
825 |
|
|
begin
|
826 |
|
|
if End_Type = E_Loop then
|
827 |
|
|
Error_Msg_SC ("no LOOP for this `END LOOP`!");
|
828 |
|
|
|
829 |
|
|
elsif End_Type = E_Case then
|
830 |
|
|
Error_Msg_SC ("no CASE for this `END CASE`");
|
831 |
|
|
|
832 |
|
|
elsif End_Type = E_If then
|
833 |
|
|
Error_Msg_SC ("no IF for this `END IF`!");
|
834 |
|
|
|
835 |
|
|
elsif End_Type = E_Record then
|
836 |
|
|
Error_Msg_SC ("no RECORD for this `END RECORD`!");
|
837 |
|
|
|
838 |
|
|
elsif End_Type = E_Return then
|
839 |
|
|
Error_Msg_SC ("no RETURN for this `END RETURN`!");
|
840 |
|
|
|
841 |
|
|
elsif End_Type = E_Select then
|
842 |
|
|
Error_Msg_SC ("no SELECT for this `END SELECT`!");
|
843 |
|
|
|
844 |
|
|
else
|
845 |
|
|
Error_Msg_SC ("no BEGIN for this END!");
|
846 |
|
|
end if;
|
847 |
|
|
end Output_End_Deleted;
|
848 |
|
|
|
849 |
|
|
-------------------------
|
850 |
|
|
-- Output_End_Expected --
|
851 |
|
|
-------------------------
|
852 |
|
|
|
853 |
|
|
procedure Output_End_Expected (Ins : Boolean) is
|
854 |
|
|
End_Type : SS_End_Type;
|
855 |
|
|
|
856 |
|
|
begin
|
857 |
|
|
-- Suppress message if this was a potentially junk entry (e.g. a record
|
858 |
|
|
-- entry where no record keyword was present).
|
859 |
|
|
|
860 |
|
|
if Scope.Table (Scope.Last).Junk then
|
861 |
|
|
return;
|
862 |
|
|
end if;
|
863 |
|
|
|
864 |
|
|
End_Type := Scope.Table (Scope.Last).Etyp;
|
865 |
|
|
Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
|
866 |
|
|
Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc;
|
867 |
|
|
|
868 |
|
|
if Explicit_Start_Label (Scope.Last) then
|
869 |
|
|
Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
|
870 |
|
|
else
|
871 |
|
|
Error_Msg_Node_1 := Empty;
|
872 |
|
|
end if;
|
873 |
|
|
|
874 |
|
|
-- Suppress message if error was posted on opening label
|
875 |
|
|
|
876 |
|
|
if Error_Msg_Node_1 > Empty_Or_Error
|
877 |
|
|
and then Error_Posted (Error_Msg_Node_1)
|
878 |
|
|
then
|
879 |
|
|
return;
|
880 |
|
|
end if;
|
881 |
|
|
|
882 |
|
|
if End_Type = E_Case then
|
883 |
|
|
Error_Msg_SC -- CODEFIX
|
884 |
|
|
("`END CASE;` expected@ for CASE#!");
|
885 |
|
|
|
886 |
|
|
elsif End_Type = E_If then
|
887 |
|
|
Error_Msg_SC -- CODEFIX
|
888 |
|
|
("`END IF;` expected@ for IF#!");
|
889 |
|
|
|
890 |
|
|
elsif End_Type = E_Loop then
|
891 |
|
|
if Error_Msg_Node_1 = Empty then
|
892 |
|
|
Error_Msg_SC -- CODEFIX
|
893 |
|
|
("`END LOOP;` expected@ for LOOP#!");
|
894 |
|
|
else
|
895 |
|
|
Error_Msg_SC -- CODEFIX
|
896 |
|
|
("`END LOOP &;` expected@!");
|
897 |
|
|
end if;
|
898 |
|
|
|
899 |
|
|
elsif End_Type = E_Record then
|
900 |
|
|
Error_Msg_SC -- CODEFIX
|
901 |
|
|
("`END RECORD;` expected@ for RECORD#!");
|
902 |
|
|
|
903 |
|
|
elsif End_Type = E_Return then
|
904 |
|
|
Error_Msg_SC -- CODEFIX
|
905 |
|
|
("`END RETURN;` expected@ for RETURN#!");
|
906 |
|
|
|
907 |
|
|
elsif End_Type = E_Select then
|
908 |
|
|
Error_Msg_SC -- CODEFIX
|
909 |
|
|
("`END SELECT;` expected@ for SELECT#!");
|
910 |
|
|
|
911 |
|
|
-- All remaining cases are cases with a name (we do not treat the
|
912 |
|
|
-- suspicious is cases specially for a replaced end, only for an
|
913 |
|
|
-- inserted end).
|
914 |
|
|
|
915 |
|
|
elsif End_Type = E_Name or else not Ins then
|
916 |
|
|
if Error_Msg_Node_1 = Empty then
|
917 |
|
|
Error_Msg_SC -- CODEFIX
|
918 |
|
|
("`END;` expected@ for BEGIN#!");
|
919 |
|
|
else
|
920 |
|
|
Error_Msg_SC -- CODEFIX
|
921 |
|
|
("`END &;` expected@!");
|
922 |
|
|
end if;
|
923 |
|
|
|
924 |
|
|
-- The other possibility is a missing END for a subprogram with a
|
925 |
|
|
-- suspicious IS (that probably should have been a semicolon). The
|
926 |
|
|
-- missing IS confirms the suspicion!
|
927 |
|
|
|
928 |
|
|
else -- End_Type = E_Suspicious_Is or E_Bad_Is
|
929 |
|
|
Scope.Table (Scope.Last).Etyp := E_Bad_Is;
|
930 |
|
|
end if;
|
931 |
|
|
end Output_End_Expected;
|
932 |
|
|
|
933 |
|
|
------------------------
|
934 |
|
|
-- Output_End_Missing --
|
935 |
|
|
------------------------
|
936 |
|
|
|
937 |
|
|
procedure Output_End_Missing is
|
938 |
|
|
End_Type : SS_End_Type;
|
939 |
|
|
|
940 |
|
|
begin
|
941 |
|
|
-- Suppress message if this was a potentially junk entry (e.g. a record
|
942 |
|
|
-- entry where no record keyword was present).
|
943 |
|
|
|
944 |
|
|
if Scope.Table (Scope.Last).Junk then
|
945 |
|
|
return;
|
946 |
|
|
end if;
|
947 |
|
|
|
948 |
|
|
End_Type := Scope.Table (Scope.Last).Etyp;
|
949 |
|
|
Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc;
|
950 |
|
|
|
951 |
|
|
if Explicit_Start_Label (Scope.Last) then
|
952 |
|
|
Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
|
953 |
|
|
else
|
954 |
|
|
Error_Msg_Node_1 := Empty;
|
955 |
|
|
end if;
|
956 |
|
|
|
957 |
|
|
if End_Type = E_Case then
|
958 |
|
|
Error_Msg_BC ("missing `END CASE;` for CASE#!");
|
959 |
|
|
|
960 |
|
|
elsif End_Type = E_If then
|
961 |
|
|
Error_Msg_BC ("missing `END IF;` for IF#!");
|
962 |
|
|
|
963 |
|
|
elsif End_Type = E_Loop then
|
964 |
|
|
if Error_Msg_Node_1 = Empty then
|
965 |
|
|
Error_Msg_BC ("missing `END LOOP;` for LOOP#!");
|
966 |
|
|
else
|
967 |
|
|
Error_Msg_BC ("missing `END LOOP &;`!");
|
968 |
|
|
end if;
|
969 |
|
|
|
970 |
|
|
elsif End_Type = E_Record then
|
971 |
|
|
Error_Msg_SC
|
972 |
|
|
("missing `END RECORD;` for RECORD#!");
|
973 |
|
|
|
974 |
|
|
elsif End_Type = E_Return then
|
975 |
|
|
Error_Msg_SC
|
976 |
|
|
("missing `END RETURN;` for RETURN#!");
|
977 |
|
|
|
978 |
|
|
elsif End_Type = E_Select then
|
979 |
|
|
Error_Msg_BC
|
980 |
|
|
("missing `END SELECT;` for SELECT#!");
|
981 |
|
|
|
982 |
|
|
elsif End_Type = E_Name then
|
983 |
|
|
if Error_Msg_Node_1 = Empty then
|
984 |
|
|
Error_Msg_BC ("missing `END;` for BEGIN#!");
|
985 |
|
|
else
|
986 |
|
|
Error_Msg_BC ("missing `END &;`!");
|
987 |
|
|
end if;
|
988 |
|
|
|
989 |
|
|
else -- End_Type = E_Suspicious_Is or E_Bad_Is
|
990 |
|
|
Scope.Table (Scope.Last).Etyp := E_Bad_Is;
|
991 |
|
|
end if;
|
992 |
|
|
end Output_End_Missing;
|
993 |
|
|
|
994 |
|
|
---------------------
|
995 |
|
|
-- Pop_End_Context --
|
996 |
|
|
---------------------
|
997 |
|
|
|
998 |
|
|
procedure Pop_End_Context is
|
999 |
|
|
|
1000 |
|
|
Pretty_Good : Boolean;
|
1001 |
|
|
-- This flag is set True if the END sequence is syntactically incorrect,
|
1002 |
|
|
-- but is (from a heuristic point of view), pretty likely to be simply
|
1003 |
|
|
-- a misspelling of the intended END.
|
1004 |
|
|
|
1005 |
|
|
Outer_Match : Boolean;
|
1006 |
|
|
-- This flag is set True if we decide that the current END sequence
|
1007 |
|
|
-- belongs to some outer level entry in the scope stack, and thus
|
1008 |
|
|
-- we will NOT eat it up in matching the current expected END.
|
1009 |
|
|
|
1010 |
|
|
begin
|
1011 |
|
|
-- If not at END, then output END expected message
|
1012 |
|
|
|
1013 |
|
|
if End_Type = E_Dummy then
|
1014 |
|
|
Output_End_Missing;
|
1015 |
|
|
Pop_Scope_Stack;
|
1016 |
|
|
End_Action := Insert_And_Accept;
|
1017 |
|
|
return;
|
1018 |
|
|
|
1019 |
|
|
-- Otherwise we do have an END present
|
1020 |
|
|
|
1021 |
|
|
else
|
1022 |
|
|
-- A special check. If we have END; followed by an end of file,
|
1023 |
|
|
-- WITH or SEPARATE, then if we are not at the outer level, then
|
1024 |
|
|
-- we have a syntax error. Consider the example:
|
1025 |
|
|
|
1026 |
|
|
-- ...
|
1027 |
|
|
-- declare
|
1028 |
|
|
-- X : Integer;
|
1029 |
|
|
-- begin
|
1030 |
|
|
-- X := Father (A);
|
1031 |
|
|
-- Process (X, X);
|
1032 |
|
|
-- end;
|
1033 |
|
|
-- with Package1;
|
1034 |
|
|
-- ...
|
1035 |
|
|
|
1036 |
|
|
-- Now the END; here is a syntactically correct closer for the
|
1037 |
|
|
-- declare block, but if we eat it up, then we obviously have
|
1038 |
|
|
-- a missing END for the outer context (since WITH can only appear
|
1039 |
|
|
-- at the outer level.
|
1040 |
|
|
|
1041 |
|
|
-- In this situation, we always reserve the END; for the outer level,
|
1042 |
|
|
-- even if it is in the wrong column. This is because it's much more
|
1043 |
|
|
-- useful to have the error message point to the DECLARE than to the
|
1044 |
|
|
-- package header in this case.
|
1045 |
|
|
|
1046 |
|
|
-- We also reserve an end with a name before the end of file if the
|
1047 |
|
|
-- name is the one we expect at the outer level.
|
1048 |
|
|
|
1049 |
|
|
if (Token = Tok_EOF or else
|
1050 |
|
|
Token = Tok_With or else
|
1051 |
|
|
Token = Tok_Separate)
|
1052 |
|
|
and then End_Type >= E_Name
|
1053 |
|
|
and then (not End_Labl_Present
|
1054 |
|
|
or else Same_Label (End_Labl, Scope.Table (1).Labl))
|
1055 |
|
|
and then Scope.Last > 1
|
1056 |
|
|
then
|
1057 |
|
|
Restore_Scan_State (Scan_State); -- to END
|
1058 |
|
|
Output_End_Expected (Ins => True);
|
1059 |
|
|
Pop_Scope_Stack;
|
1060 |
|
|
End_Action := Insert_And_Accept;
|
1061 |
|
|
return;
|
1062 |
|
|
end if;
|
1063 |
|
|
|
1064 |
|
|
-- Otherwise we go through the normal END evaluation procedure
|
1065 |
|
|
|
1066 |
|
|
Evaluate_End_Entry (Scope.Last);
|
1067 |
|
|
|
1068 |
|
|
-- If top entry in stack is syntactically correct, then we have
|
1069 |
|
|
-- scanned it out and everything is fine. This is the required
|
1070 |
|
|
-- action to properly process correct Ada programs.
|
1071 |
|
|
|
1072 |
|
|
if Syntax_OK then
|
1073 |
|
|
|
1074 |
|
|
-- Complain if checking columns and END is not in right column.
|
1075 |
|
|
-- Right in this context means exactly right, or on the same
|
1076 |
|
|
-- line as the opener.
|
1077 |
|
|
|
1078 |
|
|
if RM_Column_Check then
|
1079 |
|
|
if End_Column /= Scope.Table (Scope.Last).Ecol
|
1080 |
|
|
and then Current_Line_Start > Scope.Table (Scope.Last).Sloc
|
1081 |
|
|
|
1082 |
|
|
-- A special case, for END RECORD, we are also allowed to
|
1083 |
|
|
-- line up with the TYPE keyword opening the declaration.
|
1084 |
|
|
|
1085 |
|
|
and then (Scope.Table (Scope.Last).Etyp /= E_Record
|
1086 |
|
|
or else Get_Column_Number (End_Sloc) /=
|
1087 |
|
|
Get_Column_Number (Type_Token_Location))
|
1088 |
|
|
then
|
1089 |
|
|
Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
|
1090 |
|
|
Error_Msg
|
1091 |
|
|
("(style) END in wrong column, should be@", End_Sloc);
|
1092 |
|
|
end if;
|
1093 |
|
|
end if;
|
1094 |
|
|
|
1095 |
|
|
-- One final check. If the end had a label, check for an exact
|
1096 |
|
|
-- duplicate of this end sequence, and if so, skip it with an
|
1097 |
|
|
-- appropriate message.
|
1098 |
|
|
|
1099 |
|
|
if End_Labl_Present and then Token = Tok_End then
|
1100 |
|
|
declare
|
1101 |
|
|
Scan_State : Saved_Scan_State;
|
1102 |
|
|
End_Loc : constant Source_Ptr := Token_Ptr;
|
1103 |
|
|
Nxt_Labl : Node_Id;
|
1104 |
|
|
Dup_Found : Boolean := False;
|
1105 |
|
|
|
1106 |
|
|
begin
|
1107 |
|
|
Save_Scan_State (Scan_State);
|
1108 |
|
|
|
1109 |
|
|
Scan; -- past END
|
1110 |
|
|
|
1111 |
|
|
if Token = Tok_Identifier
|
1112 |
|
|
or else Token = Tok_Operator_Symbol
|
1113 |
|
|
then
|
1114 |
|
|
Nxt_Labl := P_Designator;
|
1115 |
|
|
|
1116 |
|
|
-- We only consider it an error if the label is a match
|
1117 |
|
|
-- and would be wrong for the level one above us, and
|
1118 |
|
|
-- the indentation is the same.
|
1119 |
|
|
|
1120 |
|
|
if Token = Tok_Semicolon
|
1121 |
|
|
and then Same_Label (End_Labl, Nxt_Labl)
|
1122 |
|
|
and then End_Column = Start_Column
|
1123 |
|
|
and then
|
1124 |
|
|
(Scope.Last = 1
|
1125 |
|
|
or else
|
1126 |
|
|
(not Explicit_Start_Label (Scope.Last - 1))
|
1127 |
|
|
or else
|
1128 |
|
|
(not Same_Label
|
1129 |
|
|
(End_Labl,
|
1130 |
|
|
Scope.Table (Scope.Last - 1).Labl)))
|
1131 |
|
|
then
|
1132 |
|
|
T_Semicolon;
|
1133 |
|
|
Error_Msg ("duplicate end line ignored", End_Loc);
|
1134 |
|
|
Dup_Found := True;
|
1135 |
|
|
end if;
|
1136 |
|
|
end if;
|
1137 |
|
|
|
1138 |
|
|
if not Dup_Found then
|
1139 |
|
|
Restore_Scan_State (Scan_State);
|
1140 |
|
|
end if;
|
1141 |
|
|
end;
|
1142 |
|
|
end if;
|
1143 |
|
|
|
1144 |
|
|
-- All OK, so return to caller indicating END is OK
|
1145 |
|
|
|
1146 |
|
|
Pop_Scope_Stack;
|
1147 |
|
|
End_Action := Accept_As_Scanned;
|
1148 |
|
|
return;
|
1149 |
|
|
end if;
|
1150 |
|
|
|
1151 |
|
|
-- If that check failed, then we definitely have an error. The issue
|
1152 |
|
|
-- is how to choose among three possible courses of action:
|
1153 |
|
|
|
1154 |
|
|
-- 1. Ignore the current END text completely, scanning past it,
|
1155 |
|
|
-- deciding that it belongs neither to the current context,
|
1156 |
|
|
-- nor to any outer context.
|
1157 |
|
|
|
1158 |
|
|
-- 2. Accept the current END text, scanning past it, and issuing
|
1159 |
|
|
-- an error message that it does not have the right form.
|
1160 |
|
|
|
1161 |
|
|
-- 3. Leave the current END text in place, NOT scanning past it,
|
1162 |
|
|
-- issuing an error message indicating the END expected for the
|
1163 |
|
|
-- current context. In this case, the END is available to match
|
1164 |
|
|
-- some outer END context.
|
1165 |
|
|
|
1166 |
|
|
-- From a correct functioning point of view, it does not make any
|
1167 |
|
|
-- difference which of these three approaches we take, the program
|
1168 |
|
|
-- will work correctly in any case. However, making an accurate
|
1169 |
|
|
-- choice among these alternatives, i.e. choosing the one that
|
1170 |
|
|
-- corresponds to what the programmer had in mind, does make a
|
1171 |
|
|
-- significant difference in the quality of error recovery.
|
1172 |
|
|
|
1173 |
|
|
Restore_Scan_State (Scan_State); -- to END
|
1174 |
|
|
|
1175 |
|
|
-- First we see how good the current END entry is with respect to
|
1176 |
|
|
-- what we expect. It is considered pretty good if the token is OK,
|
1177 |
|
|
-- and either the label or the column matches. An END for RECORD is
|
1178 |
|
|
-- always considered to be pretty good in the record case. This is
|
1179 |
|
|
-- because not only does a record disallow a nested structure, but
|
1180 |
|
|
-- also it is unlikely that such nesting could occur by accident.
|
1181 |
|
|
|
1182 |
|
|
Pretty_Good := (Token_OK and (Column_OK or Label_OK))
|
1183 |
|
|
or else Scope.Table (Scope.Last).Etyp = E_Record;
|
1184 |
|
|
|
1185 |
|
|
-- Next check, if there is a deeper entry in the stack which
|
1186 |
|
|
-- has a very high probability of being acceptable, then insert
|
1187 |
|
|
-- the END entry we want, leaving the higher level entry for later
|
1188 |
|
|
|
1189 |
|
|
for J in reverse 1 .. Scope.Last - 1 loop
|
1190 |
|
|
Evaluate_End_Entry (J);
|
1191 |
|
|
|
1192 |
|
|
-- To even consider the deeper entry to be immediately acceptable,
|
1193 |
|
|
-- it must be syntactically correct. Furthermore it must either
|
1194 |
|
|
-- have a correct label, or the correct column. If the current
|
1195 |
|
|
-- entry was a close match (Pretty_Good set), then we are even
|
1196 |
|
|
-- more strict in accepting the outer level one: even if it has
|
1197 |
|
|
-- the right label, it must have the right column as well.
|
1198 |
|
|
|
1199 |
|
|
if Syntax_OK then
|
1200 |
|
|
if Pretty_Good then
|
1201 |
|
|
Outer_Match := Label_OK and Column_OK;
|
1202 |
|
|
else
|
1203 |
|
|
Outer_Match := Label_OK or Column_OK;
|
1204 |
|
|
end if;
|
1205 |
|
|
else
|
1206 |
|
|
Outer_Match := False;
|
1207 |
|
|
end if;
|
1208 |
|
|
|
1209 |
|
|
-- If the outer entry does convincingly match the END text, then
|
1210 |
|
|
-- back up the scan to the start of the END sequence, issue an
|
1211 |
|
|
-- error message indicating the END we expected, and return with
|
1212 |
|
|
-- Token pointing to the END (case 3 from above discussion).
|
1213 |
|
|
|
1214 |
|
|
if Outer_Match then
|
1215 |
|
|
Output_End_Missing;
|
1216 |
|
|
Pop_Scope_Stack;
|
1217 |
|
|
End_Action := Insert_And_Accept;
|
1218 |
|
|
return;
|
1219 |
|
|
end if;
|
1220 |
|
|
end loop;
|
1221 |
|
|
|
1222 |
|
|
-- Here we have a situation in which the current END entry is
|
1223 |
|
|
-- syntactically incorrect, but there is no deeper entry in the
|
1224 |
|
|
-- END stack which convincingly matches it.
|
1225 |
|
|
|
1226 |
|
|
-- If the END text was judged to be a Pretty_Good match for the
|
1227 |
|
|
-- expected token or if it appears left of the expected column,
|
1228 |
|
|
-- then we will accept it as the one we want, scanning past it, even
|
1229 |
|
|
-- though it is not completely right (we issue a message showing what
|
1230 |
|
|
-- we expected it to be). This is action 2 from the discussion above.
|
1231 |
|
|
-- There is one other special case to consider: the LOOP case.
|
1232 |
|
|
-- Consider the example:
|
1233 |
|
|
|
1234 |
|
|
-- Lbl: loop
|
1235 |
|
|
-- null;
|
1236 |
|
|
-- end loop;
|
1237 |
|
|
|
1238 |
|
|
-- Here the column lines up with Lbl, so END LOOP is to the right,
|
1239 |
|
|
-- but it is still acceptable. LOOP is the one case where alignment
|
1240 |
|
|
-- practices vary substantially in practice.
|
1241 |
|
|
|
1242 |
|
|
if Pretty_Good
|
1243 |
|
|
or else End_Column <= Scope.Table (Scope.Last).Ecol
|
1244 |
|
|
or else (End_Type = Scope.Table (Scope.Last).Etyp
|
1245 |
|
|
and then End_Type = E_Loop)
|
1246 |
|
|
then
|
1247 |
|
|
Output_End_Expected (Ins => False);
|
1248 |
|
|
Pop_Scope_Stack;
|
1249 |
|
|
End_Action := Skip_And_Accept;
|
1250 |
|
|
return;
|
1251 |
|
|
|
1252 |
|
|
-- Here we have the case where the END is to the right of the
|
1253 |
|
|
-- expected column and does not have a correct label to convince
|
1254 |
|
|
-- us that it nevertheless belongs to the current scope. For this
|
1255 |
|
|
-- we consider that it probably belongs not to the current context,
|
1256 |
|
|
-- but to some inner context that was not properly recognized (due to
|
1257 |
|
|
-- other syntax errors), and for which no proper scope stack entry
|
1258 |
|
|
-- was made. The proper action in this case is to delete the END text
|
1259 |
|
|
-- and return False to the caller as a signal to keep on looking for
|
1260 |
|
|
-- an acceptable END. This is action 1 from the discussion above.
|
1261 |
|
|
|
1262 |
|
|
else
|
1263 |
|
|
Output_End_Deleted;
|
1264 |
|
|
End_Action := Skip_And_Reject;
|
1265 |
|
|
return;
|
1266 |
|
|
end if;
|
1267 |
|
|
end if;
|
1268 |
|
|
end Pop_End_Context;
|
1269 |
|
|
|
1270 |
|
|
----------------
|
1271 |
|
|
-- Same_Label --
|
1272 |
|
|
----------------
|
1273 |
|
|
|
1274 |
|
|
function Same_Label (Label1, Label2 : Node_Id) return Boolean is
|
1275 |
|
|
begin
|
1276 |
|
|
if Nkind (Label1) in N_Has_Chars
|
1277 |
|
|
and then Nkind (Label2) in N_Has_Chars
|
1278 |
|
|
then
|
1279 |
|
|
return Chars (Label1) = Chars (Label2);
|
1280 |
|
|
|
1281 |
|
|
elsif Nkind (Label1) = N_Selected_Component
|
1282 |
|
|
and then Nkind (Label2) = N_Selected_Component
|
1283 |
|
|
then
|
1284 |
|
|
return Same_Label (Prefix (Label1), Prefix (Label2)) and then
|
1285 |
|
|
Same_Label (Selector_Name (Label1), Selector_Name (Label2));
|
1286 |
|
|
|
1287 |
|
|
elsif Nkind (Label1) = N_Designator
|
1288 |
|
|
and then Nkind (Label2) = N_Defining_Program_Unit_Name
|
1289 |
|
|
then
|
1290 |
|
|
return Same_Label (Name (Label1), Name (Label2)) and then
|
1291 |
|
|
Same_Label (Identifier (Label1), Defining_Identifier (Label2));
|
1292 |
|
|
|
1293 |
|
|
else
|
1294 |
|
|
return False;
|
1295 |
|
|
end if;
|
1296 |
|
|
end Same_Label;
|
1297 |
|
|
|
1298 |
|
|
end Endh;
|