]>
Commit | Line | Data |
---|---|---|
996ae0b0 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- S E M _ C H 1 1 -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
8d0d46f4 | 9 | -- Copyright (C) 1992-2021, Free Software Foundation, Inc. -- |
996ae0b0 RK |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
996ae0b0 RK |
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 -- | |
b5c84c3c RD |
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. -- | |
996ae0b0 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
996ae0b0 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
26 | with Atree; use Atree; | |
fbf5a39b | 27 | with Checks; use Checks; |
76f9c7f4 BD |
28 | with Einfo; use Einfo; |
29 | with Einfo.Entities; use Einfo.Entities; | |
30 | with Einfo.Utils; use Einfo.Utils; | |
996ae0b0 RK |
31 | with Errout; use Errout; |
32 | with Lib; use Lib; | |
33 | with Lib.Xref; use Lib.Xref; | |
8909e1ed | 34 | with Namet; use Namet; |
996ae0b0 RK |
35 | with Nlists; use Nlists; |
36 | with Nmake; use Nmake; | |
37 | with Opt; use Opt; | |
38 | with Restrict; use Restrict; | |
6e937c1c | 39 | with Rident; use Rident; |
996ae0b0 RK |
40 | with Rtsfind; use Rtsfind; |
41 | with Sem; use Sem; | |
c2e54001 | 42 | with Sem_Aux; use Sem_Aux; |
996ae0b0 RK |
43 | with Sem_Ch5; use Sem_Ch5; |
44 | with Sem_Ch8; use Sem_Ch8; | |
0f1a6a0b | 45 | with Sem_Ch13; use Sem_Ch13; |
996ae0b0 RK |
46 | with Sem_Res; use Sem_Res; |
47 | with Sem_Util; use Sem_Util; | |
6109adeb | 48 | with Sem_Warn; use Sem_Warn; |
76f9c7f4 BD |
49 | with Sinfo; use Sinfo; |
50 | with Sinfo.Nodes; use Sinfo.Nodes; | |
51 | with Sinfo.Utils; use Sinfo.Utils; | |
744c73a5 | 52 | with Snames; use Snames; |
996ae0b0 | 53 | with Stand; use Stand; |
996ae0b0 RK |
54 | |
55 | package body Sem_Ch11 is | |
56 | ||
57 | ----------------------------------- | |
58 | -- Analyze_Exception_Declaration -- | |
59 | ----------------------------------- | |
60 | ||
61 | procedure Analyze_Exception_Declaration (N : Node_Id) is | |
1af4455a HK |
62 | Id : constant Entity_Id := Defining_Identifier (N); |
63 | PF : constant Boolean := Is_Pure (Current_Scope); | |
8636f52f | 64 | |
996ae0b0 | 65 | begin |
baa3441d RD |
66 | Generate_Definition (Id); |
67 | Enter_Name (Id); | |
68 | Set_Ekind (Id, E_Exception); | |
baa3441d | 69 | Set_Etype (Id, Standard_Exception_Type); |
996ae0b0 | 70 | Set_Is_Statically_Allocated (Id); |
baa3441d | 71 | Set_Is_Pure (Id, PF); |
eaba57fb RD |
72 | |
73 | if Has_Aspects (N) then | |
74 | Analyze_Aspect_Specifications (N, Id); | |
75 | end if; | |
996ae0b0 RK |
76 | end Analyze_Exception_Declaration; |
77 | ||
78 | -------------------------------- | |
79 | -- Analyze_Exception_Handlers -- | |
80 | -------------------------------- | |
81 | ||
82 | procedure Analyze_Exception_Handlers (L : List_Id) is | |
83 | Handler : Node_Id; | |
84 | Choice : Entity_Id; | |
85 | Id : Node_Id; | |
86 | H_Scope : Entity_Id := Empty; | |
87 | ||
88 | procedure Check_Duplication (Id : Node_Id); | |
89 | -- Iterate through the identifiers in each handler to find duplicates | |
90 | ||
fbf5a39b AC |
91 | function Others_Present return Boolean; |
92 | -- Returns True if others handler is present | |
93 | ||
996ae0b0 RK |
94 | ----------------------- |
95 | -- Check_Duplication -- | |
96 | ----------------------- | |
97 | ||
98 | procedure Check_Duplication (Id : Node_Id) is | |
fbf5a39b AC |
99 | Handler : Node_Id; |
100 | Id1 : Node_Id; | |
101 | Id_Entity : Entity_Id := Entity (Id); | |
996ae0b0 RK |
102 | |
103 | begin | |
fbf5a39b AC |
104 | if Present (Renamed_Entity (Id_Entity)) then |
105 | Id_Entity := Renamed_Entity (Id_Entity); | |
106 | end if; | |
107 | ||
996ae0b0 RK |
108 | Handler := First_Non_Pragma (L); |
109 | while Present (Handler) loop | |
110 | Id1 := First (Exception_Choices (Handler)); | |
996ae0b0 RK |
111 | while Present (Id1) loop |
112 | ||
113 | -- Only check against the exception choices which precede | |
114 | -- Id in the handler, since the ones that follow Id have not | |
115 | -- been analyzed yet and will be checked in a subsequent call. | |
116 | ||
117 | if Id = Id1 then | |
118 | return; | |
119 | ||
120 | elsif Nkind (Id1) /= N_Others_Choice | |
fbf5a39b AC |
121 | and then |
122 | (Id_Entity = Entity (Id1) | |
59e9bc0b | 123 | or else (Id_Entity = Renamed_Entity (Entity (Id1)))) |
996ae0b0 RK |
124 | then |
125 | if Handler /= Parent (Id) then | |
126 | Error_Msg_Sloc := Sloc (Id1); | |
59e9bc0b | 127 | Error_Msg_NE ("exception choice duplicates &#", Id, Id1); |
996ae0b0 RK |
128 | |
129 | else | |
0ab80019 AC |
130 | if Ada_Version = Ada_83 |
131 | and then Comes_From_Source (Id) | |
132 | then | |
996ae0b0 | 133 | Error_Msg_N |
64f4351d | 134 | ("(Ada 83) duplicate exception choice&", Id); |
996ae0b0 RK |
135 | end if; |
136 | end if; | |
137 | end if; | |
138 | ||
139 | Next_Non_Pragma (Id1); | |
140 | end loop; | |
141 | ||
142 | Next (Handler); | |
143 | end loop; | |
144 | end Check_Duplication; | |
145 | ||
fbf5a39b AC |
146 | -------------------- |
147 | -- Others_Present -- | |
148 | -------------------- | |
149 | ||
150 | function Others_Present return Boolean is | |
151 | H : Node_Id; | |
152 | ||
153 | begin | |
154 | H := First (L); | |
155 | while Present (H) loop | |
156 | if Nkind (H) /= N_Pragma | |
157 | and then Nkind (First (Exception_Choices (H))) = N_Others_Choice | |
158 | then | |
159 | return True; | |
160 | end if; | |
161 | ||
162 | Next (H); | |
163 | end loop; | |
164 | ||
165 | return False; | |
166 | end Others_Present; | |
167 | ||
d8221f45 | 168 | -- Start of processing for Analyze_Exception_Handlers |
996ae0b0 RK |
169 | |
170 | begin | |
171 | Handler := First (L); | |
321c24f7 AC |
172 | |
173 | -- Pragma Restriction_Warnings has more related semantics than pragma | |
174 | -- Restrictions in that it flags exception handlers as violators. Note | |
175 | -- that the compiler must still generate handlers for certain critical | |
176 | -- scenarios such as finalization. As a result, these handlers should | |
177 | -- not be subjected to the restriction check when in warnings mode. | |
178 | ||
179 | if not Comes_From_Source (Handler) | |
180 | and then (Restriction_Warnings (No_Exception_Handlers) | |
181 | or else Restriction_Warnings (No_Exception_Propagation) | |
182 | or else Restriction_Warnings (No_Exceptions)) | |
183 | then | |
184 | null; | |
185 | ||
186 | else | |
187 | Check_Restriction (No_Exceptions, Handler); | |
188 | Check_Restriction (No_Exception_Handlers, Handler); | |
189 | end if; | |
996ae0b0 | 190 | |
fbf5a39b AC |
191 | -- Kill current remembered values, since we don't know where we were |
192 | -- when the exception was raised. | |
193 | ||
194 | Kill_Current_Values; | |
195 | ||
996ae0b0 RK |
196 | -- Loop through handlers (which can include pragmas) |
197 | ||
198 | while Present (Handler) loop | |
199 | ||
200 | -- If pragma just analyze it | |
201 | ||
202 | if Nkind (Handler) = N_Pragma then | |
203 | Analyze (Handler); | |
204 | ||
205 | -- Otherwise we have a real exception handler | |
206 | ||
207 | else | |
baa3441d RD |
208 | -- Deal with choice parameter. The exception handler is a |
209 | -- declarative part for the choice parameter, so it constitutes a | |
210 | -- scope for visibility purposes. We create an entity to denote | |
211 | -- the whole exception part, and use it as the scope of all the | |
212 | -- choices, which may even have the same name without conflict. | |
16b05213 | 213 | -- This scope plays no other role in expansion or code generation. |
996ae0b0 RK |
214 | |
215 | Choice := Choice_Parameter (Handler); | |
216 | ||
217 | if Present (Choice) then | |
baa3441d RD |
218 | Set_Local_Raise_Not_OK (Handler); |
219 | ||
220 | if Comes_From_Source (Choice) then | |
221 | Check_Restriction (No_Exception_Propagation, Choice); | |
e74d643a | 222 | Set_Debug_Info_Needed (Choice); |
baa3441d RD |
223 | end if; |
224 | ||
996ae0b0 | 225 | if No (H_Scope) then |
baa3441d RD |
226 | H_Scope := |
227 | New_Internal_Entity | |
228 | (E_Block, Current_Scope, Sloc (Choice), 'E'); | |
75a957f5 | 229 | Set_Is_Exception_Handler (H_Scope); |
996ae0b0 RK |
230 | end if; |
231 | ||
8909e1ed | 232 | Push_Scope (H_Scope); |
996ae0b0 RK |
233 | Set_Etype (H_Scope, Standard_Void_Type); |
234 | ||
996ae0b0 RK |
235 | Enter_Name (Choice); |
236 | Set_Ekind (Choice, E_Variable); | |
8909e1ed JM |
237 | |
238 | if RTE_Available (RE_Exception_Occurrence) then | |
239 | Set_Etype (Choice, RTE (RE_Exception_Occurrence)); | |
240 | end if; | |
241 | ||
996ae0b0 | 242 | Generate_Definition (Choice); |
fbf5a39b | 243 | |
dc06abec RD |
244 | -- Indicate that choice has an initial value, since in effect |
245 | -- this field is assigned an initial value by the exception. | |
246 | -- We also consider that it is modified in the source. | |
fbf5a39b | 247 | |
dc06abec | 248 | Set_Has_Initial_Value (Choice, True); |
fbf5a39b | 249 | Set_Never_Set_In_Source (Choice, False); |
996ae0b0 RK |
250 | end if; |
251 | ||
252 | Id := First (Exception_Choices (Handler)); | |
253 | while Present (Id) loop | |
254 | if Nkind (Id) = N_Others_Choice then | |
255 | if Present (Next (Id)) | |
256 | or else Present (Next (Handler)) | |
257 | or else Present (Prev (Id)) | |
258 | then | |
259 | Error_Msg_N ("OTHERS must appear alone and last", Id); | |
260 | end if; | |
261 | ||
262 | else | |
263 | Analyze (Id); | |
264 | ||
baa3441d RD |
265 | -- In most cases the choice has already been analyzed in |
266 | -- Analyze_Handled_Statement_Sequence, in order to expand | |
267 | -- local handlers. This advance analysis does not take into | |
268 | -- account the case in which a choice has the same name as | |
269 | -- the choice parameter of the handler, which may hide an | |
270 | -- outer exception. This pathological case appears in ACATS | |
271 | -- B80001_3.adb, and requires an explicit check to verify | |
272 | -- that the id is not hidden. | |
273 | ||
996ae0b0 RK |
274 | if not Is_Entity_Name (Id) |
275 | or else Ekind (Entity (Id)) /= E_Exception | |
baa3441d RD |
276 | or else |
277 | (Nkind (Id) = N_Identifier | |
278 | and then Chars (Id) = Chars (Choice)) | |
996ae0b0 RK |
279 | then |
280 | Error_Msg_N ("exception name expected", Id); | |
281 | ||
282 | else | |
d5e96bc6 HK |
283 | -- Emit a warning at the declaration level when a local |
284 | -- exception is never raised explicitly. | |
285 | ||
286 | if Warn_On_Redundant_Constructs | |
287 | and then not Is_Raised (Entity (Id)) | |
288 | and then Scope (Entity (Id)) = Current_Scope | |
289 | then | |
290 | Error_Msg_NE | |
dbfeb4fa | 291 | ("exception & is never raised?r?", Entity (Id), Id); |
d5e96bc6 HK |
292 | end if; |
293 | ||
996ae0b0 | 294 | if Present (Renamed_Entity (Entity (Id))) then |
5f3ab6fb AC |
295 | if Entity (Id) = Standard_Numeric_Error then |
296 | Check_Restriction (No_Obsolescent_Features, Id); | |
297 | ||
298 | if Warn_On_Obsolescent_Feature then | |
299 | Error_Msg_N | |
300 | ("Numeric_Error is an " & | |
dbfeb4fa | 301 | "obsolescent feature (RM J.6(1))?j?", Id); |
5f3ab6fb | 302 | Error_Msg_N |
dbfeb4fa | 303 | ("\use Constraint_Error instead?j?", Id); |
5f3ab6fb | 304 | end if; |
fbf5a39b | 305 | end if; |
996ae0b0 RK |
306 | end if; |
307 | ||
308 | Check_Duplication (Id); | |
309 | ||
310 | -- Check for exception declared within generic formal | |
311 | -- package (which is illegal, see RM 11.2(8)) | |
312 | ||
313 | declare | |
314 | Ent : Entity_Id := Entity (Id); | |
fbf5a39b | 315 | Scop : Entity_Id; |
996ae0b0 RK |
316 | |
317 | begin | |
fbf5a39b AC |
318 | if Present (Renamed_Entity (Ent)) then |
319 | Ent := Renamed_Entity (Ent); | |
320 | end if; | |
321 | ||
322 | Scop := Scope (Ent); | |
996ae0b0 RK |
323 | while Scop /= Standard_Standard |
324 | and then Ekind (Scop) = E_Package | |
325 | loop | |
6109adeb | 326 | if Nkind (Declaration_Node (Scop)) = |
996ae0b0 RK |
327 | N_Package_Specification |
328 | and then | |
329 | Nkind (Original_Node (Parent | |
330 | (Declaration_Node (Scop)))) = | |
331 | N_Formal_Package_Declaration | |
332 | then | |
333 | Error_Msg_NE | |
75a957f5 AC |
334 | ("exception& is declared in generic formal " |
335 | & "package", Id, Ent); | |
996ae0b0 | 336 | Error_Msg_N |
75a957f5 AC |
337 | ("\and therefore cannot appear in handler " |
338 | & "(RM 11.2(8))", Id); | |
996ae0b0 | 339 | exit; |
6109adeb RD |
340 | |
341 | -- If the exception is declared in an inner | |
342 | -- instance, nothing else to check. | |
343 | ||
344 | elsif Is_Generic_Instance (Scop) then | |
345 | exit; | |
996ae0b0 RK |
346 | end if; |
347 | ||
348 | Scop := Scope (Scop); | |
349 | end loop; | |
350 | end; | |
351 | end if; | |
352 | end if; | |
353 | ||
354 | Next (Id); | |
355 | end loop; | |
356 | ||
baa3441d RD |
357 | -- Check for redundant handler (has only raise statement) and is |
358 | -- either an others handler, or is a specific handler when no | |
359 | -- others handler is present. | |
fbf5a39b AC |
360 | |
361 | if Warn_On_Redundant_Constructs | |
362 | and then List_Length (Statements (Handler)) = 1 | |
363 | and then Nkind (First (Statements (Handler))) = N_Raise_Statement | |
364 | and then No (Name (First (Statements (Handler)))) | |
365 | and then (not Others_Present | |
59e9bc0b | 366 | or else Nkind (First (Exception_Choices (Handler))) = |
fbf5a39b AC |
367 | N_Others_Choice) |
368 | then | |
369 | Error_Msg_N | |
dbfeb4fa | 370 | ("useless handler contains only a reraise statement?r?", |
fbf5a39b AC |
371 | Handler); |
372 | end if; | |
373 | ||
374 | -- Now analyze the statements of this handler | |
375 | ||
996ae0b0 RK |
376 | Analyze_Statements (Statements (Handler)); |
377 | ||
75a957f5 AC |
378 | -- If a choice was present, we created a special scope for it, so |
379 | -- this is where we pop that special scope to get rid of it. | |
fbf5a39b | 380 | |
996ae0b0 RK |
381 | if Present (Choice) then |
382 | End_Scope; | |
383 | end if; | |
996ae0b0 RK |
384 | end if; |
385 | ||
386 | Next (Handler); | |
387 | end loop; | |
388 | end Analyze_Exception_Handlers; | |
389 | ||
390 | -------------------------------- | |
391 | -- Analyze_Handled_Statements -- | |
392 | -------------------------------- | |
393 | ||
394 | procedure Analyze_Handled_Statements (N : Node_Id) is | |
395 | Handlers : constant List_Id := Exception_Handlers (N); | |
baa3441d RD |
396 | Handler : Node_Id; |
397 | Choice : Node_Id; | |
996ae0b0 RK |
398 | |
399 | begin | |
fbf5a39b AC |
400 | if Present (Handlers) then |
401 | Kill_All_Checks; | |
402 | end if; | |
403 | ||
baa3441d RD |
404 | -- We are now going to analyze the statements and then the exception |
405 | -- handlers. We certainly need to do things in this order to get the | |
406 | -- proper sequential semantics for various warnings. | |
407 | ||
408 | -- However, there is a glitch. When we process raise statements, an | |
409 | -- optimization is to look for local handlers and specialize the code | |
410 | -- in this case. | |
411 | ||
412 | -- In order to detect if a handler is matching, we must have at least | |
413 | -- analyzed the choices in the proper scope so that proper visibility | |
414 | -- analysis is performed. Hence we analyze just the choices first, | |
415 | -- before we analyze the statement sequence. | |
416 | ||
417 | Handler := First_Non_Pragma (Handlers); | |
418 | while Present (Handler) loop | |
419 | Choice := First_Non_Pragma (Exception_Choices (Handler)); | |
420 | while Present (Choice) loop | |
421 | Analyze (Choice); | |
422 | Next_Non_Pragma (Choice); | |
423 | end loop; | |
424 | ||
425 | Next_Non_Pragma (Handler); | |
426 | end loop; | |
427 | ||
6109adeb RD |
428 | -- Analyze statements in sequence |
429 | ||
996ae0b0 RK |
430 | Analyze_Statements (Statements (N)); |
431 | ||
814cc240 AC |
432 | -- If the current scope is a subprogram, entry or task body or declare |
433 | -- block then this is the right place to check for hanging useless | |
434 | -- assignments from the statement sequence. Skip this in the body of a | |
435 | -- postcondition, since in that case there are no source references, and | |
436 | -- we need to preserve deferred references from the enclosing scope. | |
6109adeb | 437 | |
814cc240 AC |
438 | if ((Is_Subprogram (Current_Scope) or else Is_Entry (Current_Scope)) |
439 | and then Chars (Current_Scope) /= Name_uPostconditions) | |
4a08c95c | 440 | or else Ekind (Current_Scope) in E_Block | E_Task_Type |
744c73a5 | 441 | then |
6109adeb RD |
442 | Warn_On_Useless_Assignments (Current_Scope); |
443 | end if; | |
444 | ||
445 | -- Deal with handlers or AT END proc | |
446 | ||
996ae0b0 RK |
447 | if Present (Handlers) then |
448 | Analyze_Exception_Handlers (Handlers); | |
996ae0b0 RK |
449 | elsif Present (At_End_Proc (N)) then |
450 | Analyze (At_End_Proc (N)); | |
451 | end if; | |
452 | end Analyze_Handled_Statements; | |
453 | ||
c8d63650 RD |
454 | ------------------------------ |
455 | -- Analyze_Raise_Expression -- | |
456 | ------------------------------ | |
457 | ||
458 | procedure Analyze_Raise_Expression (N : Node_Id) is | |
459 | Exception_Id : constant Node_Id := Name (N); | |
460 | Exception_Name : Entity_Id := Empty; | |
461 | ||
462 | begin | |
e917e3b8 | 463 | if Comes_From_Source (N) then |
c86cf714 | 464 | Check_Compiler_Unit ("raise expression", N); |
e917e3b8 AC |
465 | end if; |
466 | ||
c8d63650 RD |
467 | -- Check exception restrictions on the original source |
468 | ||
469 | if Comes_From_Source (N) then | |
470 | Check_Restriction (No_Exceptions, N); | |
471 | end if; | |
472 | ||
473 | Analyze (Exception_Id); | |
474 | ||
475 | if Is_Entity_Name (Exception_Id) then | |
476 | Exception_Name := Entity (Exception_Id); | |
477 | end if; | |
478 | ||
479 | if No (Exception_Name) | |
480 | or else Ekind (Exception_Name) /= E_Exception | |
481 | then | |
482 | Error_Msg_N | |
483 | ("exception name expected in raise statement", Exception_Id); | |
484 | else | |
485 | Set_Is_Raised (Exception_Name); | |
486 | end if; | |
487 | ||
488 | -- Deal with RAISE WITH case | |
489 | ||
490 | if Present (Expression (N)) then | |
c8d63650 RD |
491 | Analyze_And_Resolve (Expression (N), Standard_String); |
492 | end if; | |
493 | ||
494 | -- Check obsolescent use of Numeric_Error | |
495 | ||
496 | if Exception_Name = Standard_Numeric_Error then | |
497 | Check_Restriction (No_Obsolescent_Features, Exception_Id); | |
498 | end if; | |
499 | ||
500 | -- Kill last assignment indication | |
501 | ||
502 | Kill_Current_Values (Last_Assignment_Only => True); | |
503 | ||
3e586e10 AC |
504 | -- Raise_Type is compatible with all other types so that the raise |
505 | -- expression is legal in any expression context. It will be eventually | |
506 | -- replaced by the concrete type imposed by the context. | |
c8d63650 | 507 | |
3e586e10 | 508 | Set_Etype (N, Raise_Type); |
c8d63650 RD |
509 | end Analyze_Raise_Expression; |
510 | ||
996ae0b0 RK |
511 | ----------------------------- |
512 | -- Analyze_Raise_Statement -- | |
513 | ----------------------------- | |
514 | ||
515 | procedure Analyze_Raise_Statement (N : Node_Id) is | |
516 | Exception_Id : constant Node_Id := Name (N); | |
a9d8907c | 517 | Exception_Name : Entity_Id := Empty; |
996ae0b0 | 518 | P : Node_Id; |
dedac3eb | 519 | Par : Node_Id; |
996ae0b0 RK |
520 | |
521 | begin | |
522 | Check_Unreachable_Code (N); | |
523 | ||
524 | -- Check exception restrictions on the original source | |
525 | ||
526 | if Comes_From_Source (N) then | |
527 | Check_Restriction (No_Exceptions, N); | |
528 | end if; | |
529 | ||
dedac3eb | 530 | -- Check for useless assignment to OUT or IN OUT scalar preceding the |
dbfeb4fa | 531 | -- raise. Right now only look at assignment statements, could do more??? |
fbf5a39b AC |
532 | |
533 | if Is_List_Member (N) then | |
534 | declare | |
535 | P : Node_Id; | |
536 | L : Node_Id; | |
537 | ||
538 | begin | |
539 | P := Prev (N); | |
540 | ||
dedac3eb RD |
541 | -- Skip past null statements and pragmas |
542 | ||
543 | while Present (P) | |
4a08c95c | 544 | and then Nkind (P) in N_Null_Statement | N_Pragma |
dedac3eb RD |
545 | loop |
546 | P := Prev (P); | |
547 | end loop; | |
548 | ||
549 | -- See if preceding statement is an assignment | |
550 | ||
59e9bc0b | 551 | if Present (P) and then Nkind (P) = N_Assignment_Statement then |
fbf5a39b AC |
552 | L := Name (P); |
553 | ||
dedac3eb RD |
554 | -- Give warning for assignment to scalar formal |
555 | ||
fbf5a39b AC |
556 | if Is_Scalar_Type (Etype (L)) |
557 | and then Is_Entity_Name (L) | |
558 | and then Is_Formal (Entity (L)) | |
c2e54001 AC |
559 | |
560 | -- Do this only for parameters to the current subprogram. | |
561 | -- This avoids some false positives for the nested case. | |
562 | ||
563 | and then Nearest_Dynamic_Scope (Current_Scope) = | |
59e9bc0b | 564 | Scope (Entity (L)) |
c2e54001 | 565 | |
fbf5a39b | 566 | then |
dedac3eb RD |
567 | -- Don't give warning if we are covered by an exception |
568 | -- handler, since this may result in false positives, since | |
569 | -- the handler may handle the exception and return normally. | |
570 | ||
a2773bd3 AC |
571 | -- First find the enclosing handled sequence of statements |
572 | -- (note, we could also look for a handler in an outer block | |
573 | -- but currently we don't, and in that case we'll emit the | |
574 | -- warning). | |
dedac3eb RD |
575 | |
576 | Par := N; | |
577 | loop | |
578 | Par := Parent (Par); | |
579 | exit when Nkind (Par) = N_Handled_Sequence_Of_Statements; | |
580 | end loop; | |
581 | ||
582 | -- See if there is a handler, give message if not | |
583 | ||
584 | if No (Exception_Handlers (Par)) then | |
585 | Error_Msg_N | |
59e9bc0b AC |
586 | ("assignment to pass-by-copy formal " |
587 | & "may have no effect??", P); | |
dedac3eb | 588 | Error_Msg_N |
59e9bc0b AC |
589 | ("\RAISE statement may result in abnormal return " |
590 | & "(RM 6.4.1(17))??", P); | |
dedac3eb | 591 | end if; |
fbf5a39b AC |
592 | end if; |
593 | end if; | |
594 | end; | |
595 | end if; | |
596 | ||
996ae0b0 RK |
597 | -- Reraise statement |
598 | ||
599 | if No (Exception_Id) then | |
996ae0b0 | 600 | P := Parent (N); |
4a08c95c AC |
601 | while Nkind (P) not in |
602 | N_Exception_Handler | N_Subprogram_Body | N_Package_Body | | |
603 | N_Task_Body | N_Entry_Body | |
996ae0b0 RK |
604 | loop |
605 | P := Parent (P); | |
996ae0b0 RK |
606 | end loop; |
607 | ||
608 | if Nkind (P) /= N_Exception_Handler then | |
609 | Error_Msg_N | |
610 | ("reraise statement must appear directly in a handler", N); | |
baa3441d RD |
611 | |
612 | -- If a handler has a reraise, it cannot be the target of a local | |
613 | -- raise (goto optimization is impossible), and if the no exception | |
614 | -- propagation restriction is set, this is a violation. | |
615 | ||
616 | else | |
617 | Set_Local_Raise_Not_OK (P); | |
d9f86c0c RD |
618 | |
619 | -- Do not check the restriction if the reraise statement is part | |
620 | -- of the code generated for an AT-END handler. That's because | |
621 | -- if the restriction is actually active, we never generate this | |
622 | -- raise anyway, so the apparent violation is bogus. | |
623 | ||
624 | if not From_At_End (N) then | |
625 | Check_Restriction (No_Exception_Propagation, N); | |
626 | end if; | |
996ae0b0 RK |
627 | end if; |
628 | ||
629 | -- Normal case with exception id present | |
630 | ||
631 | else | |
632 | Analyze (Exception_Id); | |
633 | ||
634 | if Is_Entity_Name (Exception_Id) then | |
635 | Exception_Name := Entity (Exception_Id); | |
996ae0b0 RK |
636 | end if; |
637 | ||
638 | if No (Exception_Name) | |
639 | or else Ekind (Exception_Name) /= E_Exception | |
640 | then | |
641 | Error_Msg_N | |
642 | ("exception name expected in raise statement", Exception_Id); | |
d5e96bc6 HK |
643 | else |
644 | Set_Is_Raised (Exception_Name); | |
996ae0b0 | 645 | end if; |
a9d8907c | 646 | |
2d9ea47f RD |
647 | -- Deal with RAISE WITH case |
648 | ||
a9d8907c JM |
649 | if Present (Expression (N)) then |
650 | Analyze_And_Resolve (Expression (N), Standard_String); | |
651 | end if; | |
996ae0b0 | 652 | end if; |
67ce0d7e | 653 | |
b5c739f9 RD |
654 | -- Check obsolescent use of Numeric_Error |
655 | ||
656 | if Exception_Name = Standard_Numeric_Error then | |
657 | Check_Restriction (No_Obsolescent_Features, Exception_Id); | |
658 | end if; | |
659 | ||
660 | -- Kill last assignment indication | |
661 | ||
67ce0d7e | 662 | Kill_Current_Values (Last_Assignment_Only => True); |
996ae0b0 RK |
663 | end Analyze_Raise_Statement; |
664 | ||
665 | ----------------------------- | |
666 | -- Analyze_Raise_xxx_Error -- | |
667 | ----------------------------- | |
668 | ||
669 | -- Normally, the Etype is already set (when this node is used within | |
670 | -- an expression, since it is copied from the node which it rewrites). | |
671 | -- If this node is used in a statement context, then we set the type | |
672 | -- Standard_Void_Type. This is used both by Gigi and by the front end | |
673 | -- to distinguish the statement use and the subexpression use. | |
674 | ||
675 | -- The only other required processing is to take care of the Condition | |
676 | -- field if one is present. | |
677 | ||
678 | procedure Analyze_Raise_xxx_Error (N : Node_Id) is | |
1ded1a1f ES |
679 | |
680 | function Same_Expression (C1, C2 : Node_Id) return Boolean; | |
681 | -- It often occurs that two identical raise statements are generated in | |
682 | -- succession (for example when dynamic elaboration checks take place on | |
683 | -- separate expressions in a call). If the two statements are identical | |
684 | -- according to the simple criterion that follows, the raise is | |
685 | -- converted into a null statement. | |
686 | ||
687 | --------------------- | |
688 | -- Same_Expression -- | |
689 | --------------------- | |
690 | ||
691 | function Same_Expression (C1, C2 : Node_Id) return Boolean is | |
692 | begin | |
693 | if No (C1) and then No (C2) then | |
694 | return True; | |
695 | ||
696 | elsif Is_Entity_Name (C1) and then Is_Entity_Name (C2) then | |
697 | return Entity (C1) = Entity (C2); | |
698 | ||
699 | elsif Nkind (C1) /= Nkind (C2) then | |
700 | return False; | |
701 | ||
702 | elsif Nkind (C1) in N_Unary_Op then | |
703 | return Same_Expression (Right_Opnd (C1), Right_Opnd (C2)); | |
704 | ||
705 | elsif Nkind (C1) in N_Binary_Op then | |
2c1b72d7 AC |
706 | return Same_Expression (Left_Opnd (C1), Left_Opnd (C2)) |
707 | and then | |
708 | Same_Expression (Right_Opnd (C1), Right_Opnd (C2)); | |
1ded1a1f | 709 | |
811c6a85 AC |
710 | elsif Nkind (C1) = N_Null then |
711 | return True; | |
712 | ||
1ded1a1f ES |
713 | else |
714 | return False; | |
715 | end if; | |
716 | end Same_Expression; | |
717 | ||
718 | -- Start of processing for Analyze_Raise_xxx_Error | |
719 | ||
996ae0b0 RK |
720 | begin |
721 | if No (Etype (N)) then | |
722 | Set_Etype (N, Standard_Void_Type); | |
723 | end if; | |
724 | ||
725 | if Present (Condition (N)) then | |
726 | Analyze_And_Resolve (Condition (N), Standard_Boolean); | |
727 | end if; | |
728 | ||
729 | -- Deal with static cases in obvious manner | |
730 | ||
731 | if Nkind (Condition (N)) = N_Identifier then | |
732 | if Entity (Condition (N)) = Standard_True then | |
733 | Set_Condition (N, Empty); | |
734 | ||
735 | elsif Entity (Condition (N)) = Standard_False then | |
736 | Rewrite (N, Make_Null_Statement (Sloc (N))); | |
737 | end if; | |
738 | end if; | |
1ded1a1f ES |
739 | |
740 | -- Remove duplicate raise statements. Note that the previous one may | |
741 | -- already have been removed as well. | |
742 | ||
743 | if not Comes_From_Source (N) | |
744 | and then Nkind (N) /= N_Null_Statement | |
745 | and then Is_List_Member (N) | |
746 | and then Present (Prev (N)) | |
747 | and then Nkind (N) = Nkind (Original_Node (Prev (N))) | |
748 | and then Same_Expression | |
749 | (Condition (N), Condition (Original_Node (Prev (N)))) | |
750 | then | |
751 | Rewrite (N, Make_Null_Statement (Sloc (N))); | |
752 | end if; | |
996ae0b0 RK |
753 | end Analyze_Raise_xxx_Error; |
754 | ||
996ae0b0 | 755 | end Sem_Ch11; |