annotate gcc/ada/par-endh.adb @ 131:84e7813d76e9

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