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