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-2012, 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 begin 715 Column_OK := (End_Column = Scope.Table (SS_Index).Ecol); 716 717 Token_OK := (End_Type = Scope.Table (SS_Index).Etyp or else 718 (End_Type = E_Name and then 719 Scope.Table (SS_Index).Etyp >= E_Name)); 720 721 Label_OK := End_Labl_Present 722 and then 723 (Same_Label (End_Labl, Scope.Table (SS_Index).Labl) 724 or else Scope.Table (SS_Index).Labl = Error); 725 726 -- Compute setting of Syntax_OK. We definitely have a syntax error 727 -- if the Token does not match properly or if P_End_Scan detected 728 -- a syntax error such as a missing semicolon. 729 730 if not Token_OK or not End_OK then 731 Syntax_OK := False; 732 733 -- Final check is that label is OK. Certainly it is OK if there 734 -- was an exact match on the label (the END label = the stack label) 735 736 elsif Label_OK then 737 Syntax_OK := True; 738 739 -- Case of label present 740 741 elsif End_Labl_Present then 742 743 -- If probably misspelling, then complain, and pretend it is OK 744 745 declare 746 Nam : constant Node_Or_Entity_Id := Scope.Table (SS_Index).Labl; 747 748 begin 749 if Nkind (End_Labl) in N_Has_Chars 750 and then Comes_From_Source (Nam) 751 and then Nkind (Nam) in N_Has_Chars 752 and then Chars (End_Labl) > Error_Name 753 and then Chars (Nam) > Error_Name 754 then 755 Error_Msg_Name_1 := Chars (Nam); 756 757 if Error_Msg_Name_1 > Error_Name then 758 if Is_Bad_Spelling_Of (Chars (Nam), Chars (End_Labl)) then 759 Error_Msg_Name_1 := Chars (Nam); 760 Error_Msg_N -- CODEFIX 761 ("misspelling of %", End_Labl); 762 Syntax_OK := True; 763 return; 764 end if; 765 end if; 766 end if; 767 end; 768 769 Syntax_OK := False; 770 771 -- Otherwise we have cases of no label on the END line. For the loop 772 -- case, this is acceptable only if the loop is unlabeled. 773 774 elsif End_Type = E_Loop then 775 Syntax_OK := not Explicit_Start_Label (SS_Index); 776 777 -- Cases where a label is definitely allowed on the END line 778 779 elsif End_Type = E_Name then 780 Syntax_OK := (not Explicit_Start_Label (SS_Index)) 781 or else 782 (not Scope.Table (SS_Index).Lreq); 783 784 -- Otherwise we have cases which don't allow labels anyway, so we 785 -- certainly accept an END which does not have a label. 786 787 else 788 Syntax_OK := True; 789 end if; 790 end Evaluate_End_Entry; 791 792 -------------------------- 793 -- Explicit_Start_Label -- 794 -------------------------- 795 796 function Explicit_Start_Label (SS_Index : Nat) return Boolean is 797 L : constant Node_Id := Scope.Table (SS_Index).Labl; 798 Etyp : constant SS_End_Type := Scope.Table (SS_Index).Etyp; 799 800 begin 801 if No (L) then 802 return False; 803 804 -- In the following test we protect the call to Comes_From_Source 805 -- against lines containing previously reported syntax errors. 806 807 elsif (Etyp = E_Loop or else 808 Etyp = E_Name or else 809 Etyp = E_Suspicious_Is or else 810 Etyp = E_Bad_Is) 811 and then Comes_From_Source (L) 812 then 813 return True; 814 815 else 816 return False; 817 end if; 818 end Explicit_Start_Label; 819 820 ------------------------ 821 -- Output_End_Deleted -- 822 ------------------------ 823 824 procedure Output_End_Deleted is 825 begin 826 if End_Type = E_Loop then 827 Error_Msg_SC ("no LOOP for this `END LOOP`!"); 828 829 elsif End_Type = E_Case then 830 Error_Msg_SC ("no CASE for this `END CASE`"); 831 832 elsif End_Type = E_If then 833 Error_Msg_SC ("no IF for this `END IF`!"); 834 835 elsif End_Type = E_Record then 836 Error_Msg_SC ("no RECORD for this `END RECORD`!"); 837 838 elsif End_Type = E_Return then 839 Error_Msg_SC ("no RETURN for this `END RETURN`!"); 840 841 elsif End_Type = E_Select then 842 Error_Msg_SC ("no SELECT for this `END SELECT`!"); 843 844 else 845 Error_Msg_SC ("no BEGIN for this END!"); 846 end if; 847 end Output_End_Deleted; 848 849 ------------------------- 850 -- Output_End_Expected -- 851 ------------------------- 852 853 procedure Output_End_Expected (Ins : Boolean) is 854 End_Type : SS_End_Type; 855 856 begin 857 -- Suppress message if this was a potentially junk entry (e.g. a record 858 -- entry where no record keyword was present). 859 860 if Scope.Table (Scope.Last).Junk then 861 return; 862 end if; 863 864 End_Type := Scope.Table (Scope.Last).Etyp; 865 Error_Msg_Col := Scope.Table (Scope.Last).Ecol; 866 Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc; 867 868 if Explicit_Start_Label (Scope.Last) then 869 Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl; 870 else 871 Error_Msg_Node_1 := Empty; 872 end if; 873 874 -- Suppress message if error was posted on opening label 875 876 if Error_Msg_Node_1 > Empty_Or_Error 877 and then Error_Posted (Error_Msg_Node_1) 878 then 879 return; 880 end if; 881 882 if End_Type = E_Case then 883 Error_Msg_SC -- CODEFIX 884 ("`END CASE;` expected@ for CASE#!"); 885 886 elsif End_Type = E_If then 887 Error_Msg_SC -- CODEFIX 888 ("`END IF;` expected@ for IF#!"); 889 890 elsif End_Type = E_Loop then 891 if Error_Msg_Node_1 = Empty then 892 Error_Msg_SC -- CODEFIX 893 ("`END LOOP;` expected@ for LOOP#!"); 894 else 895 Error_Msg_SC -- CODEFIX 896 ("`END LOOP &;` expected@!"); 897 end if; 898 899 elsif End_Type = E_Record then 900 Error_Msg_SC -- CODEFIX 901 ("`END RECORD;` expected@ for RECORD#!"); 902 903 elsif End_Type = E_Return then 904 Error_Msg_SC -- CODEFIX 905 ("`END RETURN;` expected@ for RETURN#!"); 906 907 elsif End_Type = E_Select then 908 Error_Msg_SC -- CODEFIX 909 ("`END SELECT;` expected@ for SELECT#!"); 910 911 -- All remaining cases are cases with a name (we do not treat the 912 -- suspicious is cases specially for a replaced end, only for an 913 -- inserted end). 914 915 elsif End_Type = E_Name or else not Ins then 916 if Error_Msg_Node_1 = Empty then 917 Error_Msg_SC -- CODEFIX 918 ("`END;` expected@ for BEGIN#!"); 919 else 920 Error_Msg_SC -- CODEFIX 921 ("`END &;` expected@!"); 922 end if; 923 924 -- The other possibility is a missing END for a subprogram with a 925 -- suspicious IS (that probably should have been a semicolon). The 926 -- missing IS confirms the suspicion! 927 928 else -- End_Type = E_Suspicious_Is or E_Bad_Is 929 Scope.Table (Scope.Last).Etyp := E_Bad_Is; 930 end if; 931 end Output_End_Expected; 932 933 ------------------------ 934 -- Output_End_Missing -- 935 ------------------------ 936 937 procedure Output_End_Missing is 938 End_Type : SS_End_Type; 939 940 begin 941 -- Suppress message if this was a potentially junk entry (e.g. a record 942 -- entry where no record keyword was present). 943 944 if Scope.Table (Scope.Last).Junk then 945 return; 946 end if; 947 948 End_Type := Scope.Table (Scope.Last).Etyp; 949 Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc; 950 951 if Explicit_Start_Label (Scope.Last) then 952 Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl; 953 else 954 Error_Msg_Node_1 := Empty; 955 end if; 956 957 if End_Type = E_Case then 958 Error_Msg_BC ("missing `END CASE;` for CASE#!"); 959 960 elsif End_Type = E_If then 961 Error_Msg_BC ("missing `END IF;` for IF#!"); 962 963 elsif End_Type = E_Loop then 964 if Error_Msg_Node_1 = Empty then 965 Error_Msg_BC ("missing `END LOOP;` for LOOP#!"); 966 else 967 Error_Msg_BC ("missing `END LOOP &;`!"); 968 end if; 969 970 elsif End_Type = E_Record then 971 Error_Msg_SC 972 ("missing `END RECORD;` for RECORD#!"); 973 974 elsif End_Type = E_Return then 975 Error_Msg_SC 976 ("missing `END RETURN;` for RETURN#!"); 977 978 elsif End_Type = E_Select then 979 Error_Msg_BC 980 ("missing `END SELECT;` for SELECT#!"); 981 982 elsif End_Type = E_Name then 983 if Error_Msg_Node_1 = Empty then 984 Error_Msg_BC ("missing `END;` for BEGIN#!"); 985 else 986 Error_Msg_BC ("missing `END &;`!"); 987 end if; 988 989 else -- End_Type = E_Suspicious_Is or E_Bad_Is 990 Scope.Table (Scope.Last).Etyp := E_Bad_Is; 991 end if; 992 end Output_End_Missing; 993 994 --------------------- 995 -- Pop_End_Context -- 996 --------------------- 997 998 procedure Pop_End_Context is 999 1000 Pretty_Good : Boolean; 1001 -- This flag is set True if the END sequence is syntactically incorrect, 1002 -- but is (from a heuristic point of view), pretty likely to be simply 1003 -- a misspelling of the intended END. 1004 1005 Outer_Match : Boolean; 1006 -- This flag is set True if we decide that the current END sequence 1007 -- belongs to some outer level entry in the scope stack, and thus 1008 -- we will NOT eat it up in matching the current expected END. 1009 1010 begin 1011 -- If not at END, then output END expected message 1012 1013 if End_Type = E_Dummy then 1014 Output_End_Missing; 1015 Pop_Scope_Stack; 1016 End_Action := Insert_And_Accept; 1017 return; 1018 1019 -- Otherwise we do have an END present 1020 1021 else 1022 -- A special check. If we have END; followed by an end of file, 1023 -- WITH or SEPARATE, then if we are not at the outer level, then 1024 -- we have a syntax error. Consider the example: 1025 1026 -- ... 1027 -- declare 1028 -- X : Integer; 1029 -- begin 1030 -- X := Father (A); 1031 -- Process (X, X); 1032 -- end; 1033 -- with Package1; 1034 -- ... 1035 1036 -- Now the END; here is a syntactically correct closer for the 1037 -- declare block, but if we eat it up, then we obviously have 1038 -- a missing END for the outer context (since WITH can only appear 1039 -- at the outer level. 1040 1041 -- In this situation, we always reserve the END; for the outer level, 1042 -- even if it is in the wrong column. This is because it's much more 1043 -- useful to have the error message point to the DECLARE than to the 1044 -- package header in this case. 1045 1046 -- We also reserve an end with a name before the end of file if the 1047 -- name is the one we expect at the outer level. 1048 1049 if (Token = Tok_EOF or else 1050 Token = Tok_With or else 1051 Token = Tok_Separate) 1052 and then End_Type >= E_Name 1053 and then (not End_Labl_Present 1054 or else Same_Label (End_Labl, Scope.Table (1).Labl)) 1055 and then Scope.Last > 1 1056 then 1057 Restore_Scan_State (Scan_State); -- to END 1058 Output_End_Expected (Ins => True); 1059 Pop_Scope_Stack; 1060 End_Action := Insert_And_Accept; 1061 return; 1062 end if; 1063 1064 -- Otherwise we go through the normal END evaluation procedure 1065 1066 Evaluate_End_Entry (Scope.Last); 1067 1068 -- If top entry in stack is syntactically correct, then we have 1069 -- scanned it out and everything is fine. This is the required 1070 -- action to properly process correct Ada programs. 1071 1072 if Syntax_OK then 1073 1074 -- Complain if checking columns and END is not in right column. 1075 -- Right in this context means exactly right, or on the same 1076 -- line as the opener. 1077 1078 if RM_Column_Check then 1079 if End_Column /= Scope.Table (Scope.Last).Ecol 1080 and then Current_Line_Start > Scope.Table (Scope.Last).Sloc 1081 1082 -- A special case, for END RECORD, we are also allowed to 1083 -- line up with the TYPE keyword opening the declaration. 1084 1085 and then (Scope.Table (Scope.Last).Etyp /= E_Record 1086 or else Get_Column_Number (End_Sloc) /= 1087 Get_Column_Number (Type_Token_Location)) 1088 then 1089 Error_Msg_Col := Scope.Table (Scope.Last).Ecol; 1090 Error_Msg 1091 ("(style) END in wrong column, should be@", End_Sloc); 1092 end if; 1093 end if; 1094 1095 -- One final check. If the end had a label, check for an exact 1096 -- duplicate of this end sequence, and if so, skip it with an 1097 -- appropriate message. 1098 1099 if End_Labl_Present and then Token = Tok_End then 1100 declare 1101 Scan_State : Saved_Scan_State; 1102 End_Loc : constant Source_Ptr := Token_Ptr; 1103 Nxt_Labl : Node_Id; 1104 Dup_Found : Boolean := False; 1105 1106 begin 1107 Save_Scan_State (Scan_State); 1108 1109 Scan; -- past END 1110 1111 if Token = Tok_Identifier 1112 or else Token = Tok_Operator_Symbol 1113 then 1114 Nxt_Labl := P_Designator; 1115 1116 -- We only consider it an error if the label is a match 1117 -- and would be wrong for the level one above us, and 1118 -- the indentation is the same. 1119 1120 if Token = Tok_Semicolon 1121 and then Same_Label (End_Labl, Nxt_Labl) 1122 and then End_Column = Start_Column 1123 and then 1124 (Scope.Last = 1 1125 or else 1126 (not Explicit_Start_Label (Scope.Last - 1)) 1127 or else 1128 (not Same_Label 1129 (End_Labl, 1130 Scope.Table (Scope.Last - 1).Labl))) 1131 then 1132 T_Semicolon; 1133 Error_Msg ("duplicate end line ignored", End_Loc); 1134 Dup_Found := True; 1135 end if; 1136 end if; 1137 1138 if not Dup_Found then 1139 Restore_Scan_State (Scan_State); 1140 end if; 1141 end; 1142 end if; 1143 1144 -- All OK, so return to caller indicating END is OK 1145 1146 Pop_Scope_Stack; 1147 End_Action := Accept_As_Scanned; 1148 return; 1149 end if; 1150 1151 -- If that check failed, then we definitely have an error. The issue 1152 -- is how to choose among three possible courses of action: 1153 1154 -- 1. Ignore the current END text completely, scanning past it, 1155 -- deciding that it belongs neither to the current context, 1156 -- nor to any outer context. 1157 1158 -- 2. Accept the current END text, scanning past it, and issuing 1159 -- an error message that it does not have the right form. 1160 1161 -- 3. Leave the current END text in place, NOT scanning past it, 1162 -- issuing an error message indicating the END expected for the 1163 -- current context. In this case, the END is available to match 1164 -- some outer END context. 1165 1166 -- From a correct functioning point of view, it does not make any 1167 -- difference which of these three approaches we take, the program 1168 -- will work correctly in any case. However, making an accurate 1169 -- choice among these alternatives, i.e. choosing the one that 1170 -- corresponds to what the programmer had in mind, does make a 1171 -- significant difference in the quality of error recovery. 1172 1173 Restore_Scan_State (Scan_State); -- to END 1174 1175 -- First we see how good the current END entry is with respect to 1176 -- what we expect. It is considered pretty good if the token is OK, 1177 -- and either the label or the column matches. An END for RECORD is 1178 -- always considered to be pretty good in the record case. This is 1179 -- because not only does a record disallow a nested structure, but 1180 -- also it is unlikely that such nesting could occur by accident. 1181 1182 Pretty_Good := (Token_OK and (Column_OK or Label_OK)) 1183 or else Scope.Table (Scope.Last).Etyp = E_Record; 1184 1185 -- Next check, if there is a deeper entry in the stack which 1186 -- has a very high probability of being acceptable, then insert 1187 -- the END entry we want, leaving the higher level entry for later 1188 1189 for J in reverse 1 .. Scope.Last - 1 loop 1190 Evaluate_End_Entry (J); 1191 1192 -- To even consider the deeper entry to be immediately acceptable, 1193 -- it must be syntactically correct. Furthermore it must either 1194 -- have a correct label, or the correct column. If the current 1195 -- entry was a close match (Pretty_Good set), then we are even 1196 -- more strict in accepting the outer level one: even if it has 1197 -- the right label, it must have the right column as well. 1198 1199 if Syntax_OK then 1200 if Pretty_Good then 1201 Outer_Match := Label_OK and Column_OK; 1202 else 1203 Outer_Match := Label_OK or Column_OK; 1204 end if; 1205 else 1206 Outer_Match := False; 1207 end if; 1208 1209 -- If the outer entry does convincingly match the END text, then 1210 -- back up the scan to the start of the END sequence, issue an 1211 -- error message indicating the END we expected, and return with 1212 -- Token pointing to the END (case 3 from above discussion). 1213 1214 if Outer_Match then 1215 Output_End_Missing; 1216 Pop_Scope_Stack; 1217 End_Action := Insert_And_Accept; 1218 return; 1219 end if; 1220 end loop; 1221 1222 -- Here we have a situation in which the current END entry is 1223 -- syntactically incorrect, but there is no deeper entry in the 1224 -- END stack which convincingly matches it. 1225 1226 -- If the END text was judged to be a Pretty_Good match for the 1227 -- expected token or if it appears left of the expected column, 1228 -- then we will accept it as the one we want, scanning past it, even 1229 -- though it is not completely right (we issue a message showing what 1230 -- we expected it to be). This is action 2 from the discussion above. 1231 -- There is one other special case to consider: the LOOP case. 1232 -- Consider the example: 1233 1234 -- Lbl: loop 1235 -- null; 1236 -- end loop; 1237 1238 -- Here the column lines up with Lbl, so END LOOP is to the right, 1239 -- but it is still acceptable. LOOP is the one case where alignment 1240 -- practices vary substantially in practice. 1241 1242 if Pretty_Good 1243 or else End_Column <= Scope.Table (Scope.Last).Ecol 1244 or else (End_Type = Scope.Table (Scope.Last).Etyp 1245 and then End_Type = E_Loop) 1246 then 1247 Output_End_Expected (Ins => False); 1248 Pop_Scope_Stack; 1249 End_Action := Skip_And_Accept; 1250 return; 1251 1252 -- Here we have the case where the END is to the right of the 1253 -- expected column and does not have a correct label to convince 1254 -- us that it nevertheless belongs to the current scope. For this 1255 -- we consider that it probably belongs not to the current context, 1256 -- but to some inner context that was not properly recognized (due to 1257 -- other syntax errors), and for which no proper scope stack entry 1258 -- was made. The proper action in this case is to delete the END text 1259 -- and return False to the caller as a signal to keep on looking for 1260 -- an acceptable END. This is action 1 from the discussion above. 1261 1262 else 1263 Output_End_Deleted; 1264 End_Action := Skip_And_Reject; 1265 return; 1266 end if; 1267 end if; 1268 end Pop_End_Context; 1269 1270 ---------------- 1271 -- Same_Label -- 1272 ---------------- 1273 1274 function Same_Label (Label1, Label2 : Node_Id) return Boolean is 1275 begin 1276 if Nkind (Label1) in N_Has_Chars 1277 and then Nkind (Label2) in N_Has_Chars 1278 then 1279 return Chars (Label1) = Chars (Label2); 1280 1281 elsif Nkind (Label1) = N_Selected_Component 1282 and then Nkind (Label2) = N_Selected_Component 1283 then 1284 return Same_Label (Prefix (Label1), Prefix (Label2)) and then 1285 Same_Label (Selector_Name (Label1), Selector_Name (Label2)); 1286 1287 elsif Nkind (Label1) = N_Designator 1288 and then Nkind (Label2) = N_Defining_Program_Unit_Name 1289 then 1290 return Same_Label (Name (Label1), Name (Label2)) and then 1291 Same_Label (Identifier (Label1), Defining_Identifier (Label2)); 1292 1293 else 1294 return False; 1295 end if; 1296 end Same_Label; 1297 1298end Endh; 1299