File : par-ch5.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              P A R . C H 5                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25 
  26 pragma Style_Checks (All_Checks);
  27 --  Turn off subprogram body ordering check. Subprograms are in order by RM
  28 --  section rather than alphabetical.
  29 
  30 with Sinfo.CN; use Sinfo.CN;
  31 
  32 separate (Par)
  33 package body Ch5 is
  34 
  35    --  Local functions, used only in this chapter
  36 
  37    function P_Case_Statement                     return Node_Id;
  38    function P_Case_Statement_Alternative         return Node_Id;
  39    function P_Exit_Statement                     return Node_Id;
  40    function P_Goto_Statement                     return Node_Id;
  41    function P_If_Statement                       return Node_Id;
  42    function P_Label                              return Node_Id;
  43    function P_Null_Statement                     return Node_Id;
  44 
  45    function P_Assignment_Statement (LHS : Node_Id) return Node_Id;
  46    --  Parse assignment statement. On entry, the caller has scanned the left
  47    --  hand side (passed in as Lhs), and the colon-equal (or some symbol
  48    --  taken to be an error equivalent such as equal).
  49 
  50    function P_Begin_Statement (Block_Name : Node_Id := Empty) return Node_Id;
  51    --  Parse begin-end statement. If Block_Name is non-Empty on entry, it is
  52    --  the N_Identifier node for the label on the block. If Block_Name is
  53    --  Empty on entry (the default), then the block statement is unlabeled.
  54 
  55    function P_Declare_Statement (Block_Name : Node_Id := Empty) return Node_Id;
  56    --  Parse declare block. If Block_Name is non-Empty on entry, it is
  57    --  the N_Identifier node for the label on the block. If Block_Name is
  58    --  Empty on entry (the default), then the block statement is unlabeled.
  59 
  60    function P_For_Statement (Loop_Name : Node_Id := Empty) return Node_Id;
  61    --  Parse for statement. If Loop_Name is non-Empty on entry, it is
  62    --  the N_Identifier node for the label on the loop. If Loop_Name is
  63    --  Empty on entry (the default), then the for statement is unlabeled.
  64 
  65    function P_Iterator_Specification (Def_Id : Node_Id) return Node_Id;
  66    --  Parse an iterator specification. The defining identifier has already
  67    --  been scanned, as it is the common prefix between loop and iterator
  68    --  specification.
  69 
  70    function P_Loop_Statement (Loop_Name : Node_Id := Empty) return Node_Id;
  71    --  Parse loop statement. If Loop_Name is non-Empty on entry, it is
  72    --  the N_Identifier node for the label on the loop. If Loop_Name is
  73    --  Empty on entry (the default), then the loop statement is unlabeled.
  74 
  75    function P_While_Statement (Loop_Name : Node_Id := Empty) return Node_Id;
  76    --  Parse while statement. If Loop_Name is non-Empty on entry, it is
  77    --  the N_Identifier node for the label on the loop. If Loop_Name is
  78    --  Empty on entry (the default), then the while statement is unlabeled.
  79 
  80    function Set_Loop_Block_Name (L : Character) return Name_Id;
  81    --  Given a letter 'L' for a loop or 'B' for a block, returns a name
  82    --  of the form L_nn or B_nn where nn is a serial number obtained by
  83    --  incrementing the variable Loop_Block_Count.
  84 
  85    procedure Then_Scan;
  86    --  Scan past THEN token, testing for illegal junk after it
  87 
  88    ---------------------------------
  89    -- 5.1  Sequence of Statements --
  90    ---------------------------------
  91 
  92    --  SEQUENCE_OF_STATEMENTS ::= STATEMENT {STATEMENT} {LABEL}
  93    --  Note: the final label is an Ada 2012 addition.
  94 
  95    --  STATEMENT ::=
  96    --    {LABEL} SIMPLE_STATEMENT | {LABEL} COMPOUND_STATEMENT
  97 
  98    --  SIMPLE_STATEMENT ::=      NULL_STATEMENT
  99    --  | ASSIGNMENT_STATEMENT  | EXIT_STATEMENT
 100    --  | GOTO_STATEMENT        | PROCEDURE_CALL_STATEMENT
 101    --  | RETURN_STATEMENT      | ENTRY_CALL_STATEMENT
 102    --  | REQUEUE_STATEMENT     | DELAY_STATEMENT
 103    --  | ABORT_STATEMENT       | RAISE_STATEMENT
 104    --  | CODE_STATEMENT
 105 
 106    --  COMPOUND_STATEMENT ::=
 107    --    IF_STATEMENT         | CASE_STATEMENT
 108    --  | LOOP_STATEMENT       | BLOCK_STATEMENT
 109    --  | ACCEPT_STATEMENT     | SELECT_STATEMENT
 110 
 111    --  This procedure scans a sequence of statements. The caller sets SS_Flags
 112    --  to indicate acceptable termination conditions for the sequence:
 113 
 114    --    SS_Flags.Eftm Terminate on ELSIF
 115    --    SS_Flags.Eltm Terminate on ELSE
 116    --    SS_Flags.Extm Terminate on EXCEPTION
 117    --    SS_Flags.Ortm Terminate on OR
 118    --    SS_Flags.Tatm Terminate on THEN ABORT (Token = ABORT on return)
 119    --    SS_Flags.Whtm Terminate on WHEN
 120    --    SS_Flags.Unco Unconditional terminate after scanning one statement
 121 
 122    --  In addition, the scan is always terminated by encountering END or the
 123    --  end of file (EOF) condition. If one of the six above terminators is
 124    --  encountered with the corresponding SS_Flags flag not set, then the
 125    --  action taken is as follows:
 126 
 127    --    If the keyword occurs to the left of the expected column of the end
 128    --    for the current sequence (as recorded in the current end context),
 129    --    then it is assumed to belong to an outer context, and is considered
 130    --    to terminate the sequence of statements.
 131 
 132    --    If the keyword occurs to the right of, or in the expected column of
 133    --    the end for the current sequence, then an error message is output,
 134    --    the keyword together with its associated context is skipped, and
 135    --    the statement scan continues until another terminator is found.
 136 
 137    --  Note that the first action means that control can return to the caller
 138    --  with Token set to a terminator other than one of those specified by the
 139    --  SS parameter. The caller should treat such a case as equivalent to END.
 140 
 141    --  In addition, the flag SS_Flags.Sreq is set to True to indicate that at
 142    --  least one real statement (other than a pragma) is required in the
 143    --  statement sequence. During the processing of the sequence, this
 144    --  flag is manipulated to indicate the current status of the requirement
 145    --  for a statement. For example, it is turned off by the occurrence of a
 146    --  statement, and back on by a label (which requires a following statement)
 147 
 148    --  Error recovery: cannot raise Error_Resync. If an error occurs during
 149    --  parsing a statement, then the scan pointer is advanced past the next
 150    --  semicolon and the parse continues.
 151 
 152    function P_Sequence_Of_Statements (SS_Flags : SS_Rec) return List_Id is
 153 
 154       Statement_Required : Boolean;
 155       --  This flag indicates if a subsequent statement (other than a pragma)
 156       --  is required. It is initialized from the Sreq flag, and modified as
 157       --  statements are scanned (a statement turns it off, and a label turns
 158       --  it back on again since a statement must follow a label).
 159       --  Note : this final requirement is lifted in Ada 2012.
 160 
 161       Statement_Seen : Boolean;
 162       --  In Ada 2012, a label can end a sequence of statements, but the
 163       --  sequence cannot contain only labels. This flag is set whenever a
 164       --  label is encountered, to enforce this rule at the end of a sequence.
 165 
 166       Declaration_Found : Boolean := False;
 167       --  This flag is set True if a declaration is encountered, so that the
 168       --  error message about declarations in the statement part is only
 169       --  given once for a given sequence of statements.
 170 
 171       Scan_State_Label : Saved_Scan_State;
 172       Scan_State       : Saved_Scan_State;
 173 
 174       Statement_List : List_Id;
 175       Block_Label    : Name_Id;
 176       Id_Node        : Node_Id;
 177       Name_Node      : Node_Id;
 178 
 179       procedure Junk_Declaration;
 180       --  Procedure called to handle error of declaration encountered in
 181       --  statement sequence.
 182 
 183       procedure Test_Statement_Required;
 184       --  Flag error if Statement_Required flag set
 185 
 186       ----------------------
 187       -- Junk_Declaration --
 188       ----------------------
 189 
 190       procedure Junk_Declaration is
 191       begin
 192          if (not Declaration_Found) or All_Errors_Mode then
 193             Error_Msg_SC -- CODEFIX
 194               ("declarations must come before BEGIN");
 195             Declaration_Found := True;
 196          end if;
 197 
 198          Skip_Declaration (Statement_List);
 199       end Junk_Declaration;
 200 
 201       -----------------------------
 202       -- Test_Statement_Required --
 203       -----------------------------
 204 
 205       procedure Test_Statement_Required is
 206          function All_Pragmas return Boolean;
 207          --  Return True if statement list is all pragmas
 208 
 209          -----------------
 210          -- All_Pragmas --
 211          -----------------
 212 
 213          function All_Pragmas return Boolean is
 214             S : Node_Id;
 215          begin
 216             S := First (Statement_List);
 217             while Present (S) loop
 218                if Nkind (S) /= N_Pragma then
 219                   return False;
 220                else
 221                   Next (S);
 222                end if;
 223             end loop;
 224 
 225             return True;
 226          end All_Pragmas;
 227 
 228       --  Start of processing for Test_Statement_Required
 229 
 230       begin
 231          if Statement_Required then
 232 
 233             --  Check no statement required after label in Ada 2012, and that
 234             --  it is OK to have nothing but pragmas in a statement sequence.
 235 
 236             if Ada_Version >= Ada_2012
 237               and then not Is_Empty_List (Statement_List)
 238               and then
 239                 ((Nkind (Last (Statement_List)) = N_Label
 240                    and then Statement_Seen)
 241                 or else All_Pragmas)
 242             then
 243                --  This Ada 2012 construct not allowed in a compiler unit
 244 
 245                Check_Compiler_Unit ("null statement list", Token_Ptr);
 246 
 247                declare
 248                   Null_Stm : constant Node_Id :=
 249                                Make_Null_Statement (Token_Ptr);
 250                begin
 251                   Set_Comes_From_Source (Null_Stm, False);
 252                   Append_To (Statement_List, Null_Stm);
 253                end;
 254 
 255             --  If not Ada 2012, or not special case above, give error message
 256 
 257             else
 258                Error_Msg_BC -- CODEFIX
 259                  ("statement expected");
 260             end if;
 261          end if;
 262       end Test_Statement_Required;
 263 
 264    --  Start of processing for P_Sequence_Of_Statements
 265 
 266    begin
 267       Statement_List := New_List;
 268       Statement_Required := SS_Flags.Sreq;
 269       Statement_Seen     := False;
 270 
 271       loop
 272          Ignore (Tok_Semicolon);
 273 
 274          begin
 275             if Style_Check then
 276                Style.Check_Indentation;
 277             end if;
 278 
 279             --  Deal with reserved identifier (in assignment or call)
 280 
 281             if Is_Reserved_Identifier then
 282                Save_Scan_State (Scan_State); -- at possible bad identifier
 283                Scan; -- and scan past it
 284 
 285                --  We have an reserved word which is spelled in identifier
 286                --  style, so the question is whether it really is intended
 287                --  to be an identifier.
 288 
 289                if
 290                   --  If followed by a semicolon, then it is an identifier,
 291                   --  with the exception of the cases tested for below.
 292 
 293                   (Token = Tok_Semicolon
 294                     and then Prev_Token /= Tok_Return
 295                     and then Prev_Token /= Tok_Null
 296                     and then Prev_Token /= Tok_Raise
 297                     and then Prev_Token /= Tok_End
 298                     and then Prev_Token /= Tok_Exit)
 299 
 300                   --  If followed by colon, colon-equal, or dot, then we
 301                   --  definitely  have an identifier (could not be reserved)
 302 
 303                   or else Token = Tok_Colon
 304                   or else Token = Tok_Colon_Equal
 305                   or else Token = Tok_Dot
 306 
 307                   --  Left paren means we have an identifier except for those
 308                   --  reserved words that can legitimately be followed by a
 309                   --  left paren.
 310 
 311                   or else
 312                     (Token = Tok_Left_Paren
 313                       and then Prev_Token /= Tok_Case
 314                       and then Prev_Token /= Tok_Delay
 315                       and then Prev_Token /= Tok_If
 316                       and then Prev_Token /= Tok_Elsif
 317                       and then Prev_Token /= Tok_Return
 318                       and then Prev_Token /= Tok_When
 319                       and then Prev_Token /= Tok_While
 320                       and then Prev_Token /= Tok_Separate)
 321                then
 322                   --  Here we have an apparent reserved identifier and the
 323                   --  token past it is appropriate to this usage (and would
 324                   --  be a definite error if this is not an identifier). What
 325                   --  we do is to use P_Identifier to fix up the identifier,
 326                   --  and then fall into the normal processing.
 327 
 328                   Restore_Scan_State (Scan_State); -- back to the ID
 329                   Scan_Reserved_Identifier (Force_Msg => False);
 330 
 331                   --  Not a reserved identifier after all (or at least we can't
 332                   --  be sure that it is), so reset the scan and continue.
 333 
 334                else
 335                   Restore_Scan_State (Scan_State); -- back to the reserved word
 336                end if;
 337             end if;
 338 
 339             --  Now look to see what kind of statement we have
 340 
 341             case Token is
 342 
 343                --  Case of end or EOF
 344 
 345                when Tok_End | Tok_EOF =>
 346 
 347                   --  These tokens always terminate the statement sequence
 348 
 349                   Test_Statement_Required;
 350                   exit;
 351 
 352                --  Case of ELSIF
 353 
 354                when Tok_Elsif =>
 355 
 356                   --  Terminate if Eftm set or if the ELSIF is to the left
 357                   --  of the expected column of the end for this sequence
 358 
 359                   if SS_Flags.Eftm
 360                      or else Start_Column < Scope.Table (Scope.Last).Ecol
 361                   then
 362                      Test_Statement_Required;
 363                      exit;
 364 
 365                   --  Otherwise complain and skip past ELSIF Condition then
 366 
 367                   else
 368                      Error_Msg_SC ("ELSIF not allowed here");
 369                      Scan; -- past ELSIF
 370                      Discard_Junk_Node (P_Expression_No_Right_Paren);
 371                      Then_Scan;
 372                      Statement_Required := False;
 373                   end if;
 374 
 375                --  Case of ELSE
 376 
 377                when Tok_Else =>
 378 
 379                   --  Terminate if Eltm set or if the else is to the left
 380                   --  of the expected column of the end for this sequence
 381 
 382                   if SS_Flags.Eltm
 383                      or else Start_Column < Scope.Table (Scope.Last).Ecol
 384                   then
 385                      Test_Statement_Required;
 386                      exit;
 387 
 388                   --  Otherwise complain and skip past else
 389 
 390                   else
 391                      Error_Msg_SC ("ELSE not allowed here");
 392                      Scan; -- past ELSE
 393                      Statement_Required := False;
 394                   end if;
 395 
 396                --  Case of exception
 397 
 398                when Tok_Exception =>
 399                   Test_Statement_Required;
 400 
 401                   --  If Extm not set and the exception is not to the left of
 402                   --  the expected column of the end for this sequence, then we
 403                   --  assume it belongs to the current sequence, even though it
 404                   --  is not permitted.
 405 
 406                   if not SS_Flags.Extm and then
 407                      Start_Column >= Scope.Table (Scope.Last).Ecol
 408 
 409                   then
 410                      Error_Msg_SC ("exception handler not permitted here");
 411                      Scan; -- past EXCEPTION
 412                      Discard_Junk_List (Parse_Exception_Handlers);
 413                   end if;
 414 
 415                   --  Always return, in the case where we scanned out handlers
 416                   --  that we did not expect, Parse_Exception_Handlers returned
 417                   --  with Token being either end or EOF, so we are OK.
 418 
 419                   exit;
 420 
 421                --  Case of OR
 422 
 423                when Tok_Or =>
 424 
 425                   --  Terminate if Ortm set or if the or is to the left of the
 426                   --  expected column of the end for this sequence.
 427 
 428                   if SS_Flags.Ortm
 429                      or else Start_Column < Scope.Table (Scope.Last).Ecol
 430                   then
 431                      Test_Statement_Required;
 432                      exit;
 433 
 434                   --  Otherwise complain and skip past or
 435 
 436                   else
 437                      Error_Msg_SC ("OR not allowed here");
 438                      Scan; -- past or
 439                      Statement_Required := False;
 440                   end if;
 441 
 442                --  Case of THEN (deal also with THEN ABORT)
 443 
 444                when Tok_Then =>
 445                   Save_Scan_State (Scan_State); -- at THEN
 446                   Scan; -- past THEN
 447 
 448                   --  Terminate if THEN ABORT allowed (ATC case)
 449 
 450                   exit when SS_Flags.Tatm and then Token = Tok_Abort;
 451 
 452                   --  Otherwise we treat THEN as some kind of mess where we did
 453                   --  not see the associated IF, but we pick up assuming it had
 454                   --  been there.
 455 
 456                   Restore_Scan_State (Scan_State); -- to THEN
 457                   Append_To (Statement_List, P_If_Statement);
 458                   Statement_Required := False;
 459 
 460                --  Case of WHEN (error because we are not in a case)
 461 
 462                when Tok_When | Tok_Others =>
 463 
 464                   --  Terminate if Whtm set or if the WHEN is to the left of
 465                   --  the expected column of the end for this sequence.
 466 
 467                   if SS_Flags.Whtm
 468                      or else Start_Column < Scope.Table (Scope.Last).Ecol
 469                   then
 470                      Test_Statement_Required;
 471                      exit;
 472 
 473                   --  Otherwise complain and skip when Choice {| Choice} =>
 474 
 475                   else
 476                      Error_Msg_SC ("WHEN not allowed here");
 477                      Scan; -- past when
 478                      Discard_Junk_List (P_Discrete_Choice_List);
 479                      TF_Arrow;
 480                      Statement_Required := False;
 481                   end if;
 482 
 483                --  Cases of statements starting with an identifier
 484 
 485                when Tok_Identifier =>
 486                   Check_Bad_Layout;
 487 
 488                   --  Save scan pointers and line number in case block label
 489 
 490                   Id_Node := Token_Node;
 491                   Block_Label := Token_Name;
 492                   Save_Scan_State (Scan_State_Label); -- at possible label
 493                   Scan; -- past Id
 494 
 495                   --  Check for common case of assignment, since it occurs
 496                   --  frequently, and we want to process it efficiently.
 497 
 498                   if Token = Tok_Colon_Equal then
 499                      Scan; -- past the colon-equal
 500                      Append_To (Statement_List,
 501                        P_Assignment_Statement (Id_Node));
 502                      Statement_Required := False;
 503 
 504                   --  Check common case of procedure call, another case that
 505                   --  we want to speed up as much as possible.
 506 
 507                   elsif Token = Tok_Semicolon then
 508                      Change_Name_To_Procedure_Call_Statement (Id_Node);
 509                      Append_To (Statement_List, Id_Node);
 510                      Scan; -- past semicolon
 511                      Statement_Required := False;
 512 
 513                      --  Here is the special test for a suspicious label, more
 514                      --  accurately a suspicious name, which we think perhaps
 515                      --  should have been a label. If next token is one of
 516                      --  LOOP, FOR, WHILE, DECLARE, BEGIN, then make an entry
 517                      --  in the suspicious label table.
 518 
 519                      if Token = Tok_Loop    or else
 520                         Token = Tok_For     or else
 521                         Token = Tok_While   or else
 522                         Token = Tok_Declare or else
 523                         Token = Tok_Begin
 524                      then
 525                         Suspicious_Labels.Append
 526                           ((Proc_Call     => Id_Node,
 527                             Semicolon_Loc => Prev_Token_Ptr,
 528                             Start_Token   => Token_Ptr));
 529                      end if;
 530 
 531                   --  Check for case of "go to" in place of "goto"
 532 
 533                   elsif Token = Tok_Identifier
 534                     and then Block_Label = Name_Go
 535                     and then Token_Name = Name_To
 536                   then
 537                      Error_Msg_SP -- CODEFIX
 538                        ("goto is one word");
 539                      Append_To (Statement_List, P_Goto_Statement);
 540                      Statement_Required := False;
 541 
 542                   --  Check common case of = used instead of :=, just so we
 543                   --  give a better error message for this special misuse.
 544 
 545                   elsif Token = Tok_Equal then
 546                      T_Colon_Equal; -- give := expected message
 547                      Append_To (Statement_List,
 548                        P_Assignment_Statement (Id_Node));
 549                      Statement_Required := False;
 550 
 551                   --  Check case of loop label or block label
 552 
 553                   elsif Token = Tok_Colon
 554                     or else (Token in Token_Class_Labeled_Stmt
 555                               and then not Token_Is_At_Start_Of_Line)
 556                   then
 557                      T_Colon; -- past colon (if there, or msg for missing one)
 558 
 559                      --  Test for more than one label
 560 
 561                      loop
 562                         exit when Token /= Tok_Identifier;
 563                         Save_Scan_State (Scan_State); -- at second Id
 564                         Scan; -- past Id
 565 
 566                         if Token = Tok_Colon then
 567                            Error_Msg_SP
 568                               ("only one label allowed on block or loop");
 569                            Scan; -- past colon on extra label
 570 
 571                            --  Use the second label as the "real" label
 572 
 573                            Scan_State_Label := Scan_State;
 574 
 575                            --  We will set Error_name as the Block_Label since
 576                            --  we really don't know which of the labels might
 577                            --  be used at the end of the loop or block.
 578 
 579                            Block_Label := Error_Name;
 580 
 581                         --  If Id with no colon, then backup to point to the
 582                         --  Id and we will issue the message below when we try
 583                         --  to scan out the statement as some other form.
 584 
 585                         else
 586                            Restore_Scan_State (Scan_State); -- to second Id
 587                            exit;
 588                         end if;
 589                      end loop;
 590 
 591                      --  Loop_Statement (labeled Loop_Statement)
 592 
 593                      if Token = Tok_Loop then
 594                         Append_To (Statement_List,
 595                           P_Loop_Statement (Id_Node));
 596 
 597                      --  While statement (labeled loop statement with WHILE)
 598 
 599                      elsif Token = Tok_While then
 600                         Append_To (Statement_List,
 601                           P_While_Statement (Id_Node));
 602 
 603                      --  Declare statement (labeled block statement with
 604                      --  DECLARE part)
 605 
 606                      elsif Token = Tok_Declare then
 607                         Append_To (Statement_List,
 608                           P_Declare_Statement (Id_Node));
 609 
 610                      --  Begin statement (labeled block statement with no
 611                      --  DECLARE part)
 612 
 613                      elsif Token = Tok_Begin then
 614                         Append_To (Statement_List,
 615                           P_Begin_Statement (Id_Node));
 616 
 617                      --  For statement (labeled loop statement with FOR)
 618 
 619                      elsif Token = Tok_For then
 620                         Append_To (Statement_List,
 621                           P_For_Statement (Id_Node));
 622 
 623                      --  Improper statement follows label. If we have an
 624                      --  expression token, then assume the colon was part
 625                      --  of a misplaced declaration.
 626 
 627                      elsif Token not in Token_Class_Eterm then
 628                         Restore_Scan_State (Scan_State_Label);
 629                         Junk_Declaration;
 630 
 631                      --  Otherwise complain we have inappropriate statement
 632 
 633                      else
 634                         Error_Msg_AP
 635                           ("loop or block statement must follow label");
 636                      end if;
 637 
 638                      Statement_Required := False;
 639 
 640                   --  Here we have an identifier followed by something
 641                   --  other than a colon, semicolon or assignment symbol.
 642                   --  The only valid possibility is a name extension symbol
 643 
 644                   elsif Token in Token_Class_Namext then
 645                      Restore_Scan_State (Scan_State_Label); -- to Id
 646                      Name_Node := P_Name;
 647 
 648                      --  Skip junk right parens in this context
 649 
 650                      Ignore (Tok_Right_Paren);
 651 
 652                      --  Check context following call
 653 
 654                      if Token = Tok_Colon_Equal then
 655                         Scan; -- past colon equal
 656                         Append_To (Statement_List,
 657                           P_Assignment_Statement (Name_Node));
 658                         Statement_Required := False;
 659 
 660                      --  Check common case of = used instead of :=
 661 
 662                      elsif Token = Tok_Equal then
 663                         T_Colon_Equal; -- give := expected message
 664                         Append_To (Statement_List,
 665                           P_Assignment_Statement (Name_Node));
 666                         Statement_Required := False;
 667 
 668                      --  Check apostrophe cases
 669 
 670                      elsif Token = Tok_Apostrophe then
 671                         Append_To (Statement_List,
 672                           P_Code_Statement (Name_Node));
 673                         Statement_Required := False;
 674 
 675                      --  The only other valid item after a name is ; which
 676                      --  means that the item we just scanned was a call.
 677 
 678                      elsif Token = Tok_Semicolon then
 679                         Change_Name_To_Procedure_Call_Statement (Name_Node);
 680                         Append_To (Statement_List, Name_Node);
 681                         Scan; -- past semicolon
 682                         Statement_Required := False;
 683 
 684                      --  A slash following an identifier or a selected
 685                      --  component in this situation is most likely a period
 686                      --  (see location of keys on keyboard).
 687 
 688                      elsif Token = Tok_Slash
 689                        and then (Nkind (Name_Node) = N_Identifier
 690                                    or else
 691                                  Nkind (Name_Node) = N_Selected_Component)
 692                      then
 693                         Error_Msg_SC -- CODEFIX
 694                           ("""/"" should be "".""");
 695                         Statement_Required := False;
 696                         raise Error_Resync;
 697 
 698                      --  Else we have a missing semicolon
 699 
 700                      else
 701                         TF_Semicolon;
 702 
 703                         --  Normal processing as though semicolon were present
 704 
 705                         Change_Name_To_Procedure_Call_Statement (Name_Node);
 706                         Append_To (Statement_List, Name_Node);
 707                         Statement_Required := False;
 708                      end if;
 709 
 710                   --  If junk after identifier, check if identifier is an
 711                   --  instance of an incorrectly spelled keyword. If so, we
 712                   --  do nothing. The Bad_Spelling_Of will have reset Token
 713                   --  to the appropriate keyword, so the next time round the
 714                   --  loop we will process the modified token. Note that we
 715                   --  check for ELSIF before ELSE here. That's not accidental.
 716                   --  We don't want to identify a misspelling of ELSE as
 717                   --  ELSIF, and in particular we do not want to treat ELSEIF
 718                   --  as ELSE IF.
 719 
 720                   else
 721                      Restore_Scan_State (Scan_State_Label); -- to identifier
 722 
 723                      if Bad_Spelling_Of (Tok_Abort)
 724                        or else Bad_Spelling_Of (Tok_Accept)
 725                        or else Bad_Spelling_Of (Tok_Case)
 726                        or else Bad_Spelling_Of (Tok_Declare)
 727                        or else Bad_Spelling_Of (Tok_Delay)
 728                        or else Bad_Spelling_Of (Tok_Elsif)
 729                        or else Bad_Spelling_Of (Tok_Else)
 730                        or else Bad_Spelling_Of (Tok_End)
 731                        or else Bad_Spelling_Of (Tok_Exception)
 732                        or else Bad_Spelling_Of (Tok_Exit)
 733                        or else Bad_Spelling_Of (Tok_For)
 734                        or else Bad_Spelling_Of (Tok_Goto)
 735                        or else Bad_Spelling_Of (Tok_If)
 736                        or else Bad_Spelling_Of (Tok_Loop)
 737                        or else Bad_Spelling_Of (Tok_Or)
 738                        or else Bad_Spelling_Of (Tok_Pragma)
 739                        or else Bad_Spelling_Of (Tok_Raise)
 740                        or else Bad_Spelling_Of (Tok_Requeue)
 741                        or else Bad_Spelling_Of (Tok_Return)
 742                        or else Bad_Spelling_Of (Tok_Select)
 743                        or else Bad_Spelling_Of (Tok_When)
 744                        or else Bad_Spelling_Of (Tok_While)
 745                      then
 746                         null;
 747 
 748                      --  If not a bad spelling, then we really have junk
 749 
 750                      else
 751                         Scan; -- past identifier again
 752 
 753                         --  If next token is first token on line, then we
 754                         --  consider that we were missing a semicolon after
 755                         --  the identifier, and process it as a procedure
 756                         --  call with no parameters.
 757 
 758                         if Token_Is_At_Start_Of_Line then
 759                            Change_Name_To_Procedure_Call_Statement (Id_Node);
 760                            Append_To (Statement_List, Id_Node);
 761                            T_Semicolon; -- to give error message
 762                            Statement_Required := False;
 763 
 764                         --  Otherwise we give a missing := message and
 765                         --  simply abandon the junk that is there now.
 766 
 767                         else
 768                            T_Colon_Equal; -- give := expected message
 769                            raise Error_Resync;
 770                         end if;
 771 
 772                      end if;
 773                   end if;
 774 
 775                --  Statement starting with operator symbol. This could be
 776                --  a call, a name starting an assignment, or a qualified
 777                --  expression.
 778 
 779                when Tok_Operator_Symbol =>
 780                   Check_Bad_Layout;
 781                   Name_Node := P_Name;
 782 
 783                   --  An attempt at a range attribute or a qualified expression
 784                   --  must be illegal here (a code statement cannot possibly
 785                   --  allow qualification by a function name).
 786 
 787                   if Token = Tok_Apostrophe then
 788                      Error_Msg_SC ("apostrophe illegal here");
 789                      raise Error_Resync;
 790                   end if;
 791 
 792                   --  Scan possible assignment if we have a name
 793 
 794                   if Expr_Form = EF_Name
 795                     and then Token = Tok_Colon_Equal
 796                   then
 797                      Scan; -- past colon equal
 798                      Append_To (Statement_List,
 799                        P_Assignment_Statement (Name_Node));
 800                   else
 801                      Change_Name_To_Procedure_Call_Statement (Name_Node);
 802                      Append_To (Statement_List, Name_Node);
 803                   end if;
 804 
 805                   TF_Semicolon;
 806                   Statement_Required := False;
 807 
 808                --  Label starting with << which must precede real statement
 809                --  Note: in Ada 2012, the label may end the sequence.
 810 
 811                when Tok_Less_Less =>
 812                   if Present (Last (Statement_List))
 813                     and then Nkind (Last (Statement_List)) /= N_Label
 814                   then
 815                      Statement_Seen := True;
 816                   end if;
 817 
 818                   Append_To (Statement_List, P_Label);
 819                   Statement_Required := True;
 820 
 821                --  Pragma appearing as a statement in a statement sequence
 822 
 823                when Tok_Pragma =>
 824                   Check_Bad_Layout;
 825                   Append_To (Statement_List, P_Pragma);
 826 
 827                --  Abort_Statement
 828 
 829                when Tok_Abort =>
 830                   Check_Bad_Layout;
 831                   Append_To (Statement_List, P_Abort_Statement);
 832                   Statement_Required := False;
 833 
 834                --  Accept_Statement
 835 
 836                when Tok_Accept =>
 837                   Check_Bad_Layout;
 838                   Append_To (Statement_List, P_Accept_Statement);
 839                   Statement_Required := False;
 840 
 841                --  Begin_Statement (Block_Statement with no declare, no label)
 842 
 843                when Tok_Begin =>
 844                   Check_Bad_Layout;
 845                   Append_To (Statement_List, P_Begin_Statement);
 846                   Statement_Required := False;
 847 
 848                --  Case_Statement
 849 
 850                when Tok_Case =>
 851                   Check_Bad_Layout;
 852                   Append_To (Statement_List, P_Case_Statement);
 853                   Statement_Required := False;
 854 
 855                --  Block_Statement with DECLARE and no label
 856 
 857                when Tok_Declare =>
 858                   Check_Bad_Layout;
 859                   Append_To (Statement_List, P_Declare_Statement);
 860                   Statement_Required := False;
 861 
 862                --  Delay_Statement
 863 
 864                when Tok_Delay =>
 865                   Check_Bad_Layout;
 866                   Append_To (Statement_List, P_Delay_Statement);
 867                   Statement_Required := False;
 868 
 869                --  Exit_Statement
 870 
 871                when Tok_Exit =>
 872                   Check_Bad_Layout;
 873                   Append_To (Statement_List, P_Exit_Statement);
 874                   Statement_Required := False;
 875 
 876                --  Loop_Statement with FOR and no label
 877 
 878                when Tok_For =>
 879                   Check_Bad_Layout;
 880                   Append_To (Statement_List, P_For_Statement);
 881                   Statement_Required := False;
 882 
 883                --  Goto_Statement
 884 
 885                when Tok_Goto =>
 886                   Check_Bad_Layout;
 887                   Append_To (Statement_List, P_Goto_Statement);
 888                   Statement_Required := False;
 889 
 890                --  If_Statement
 891 
 892                when Tok_If =>
 893                   Check_Bad_Layout;
 894                   Append_To (Statement_List, P_If_Statement);
 895                   Statement_Required := False;
 896 
 897                --  Loop_Statement
 898 
 899                when Tok_Loop =>
 900                   Check_Bad_Layout;
 901                   Append_To (Statement_List, P_Loop_Statement);
 902                   Statement_Required := False;
 903 
 904                --  Null_Statement
 905 
 906                when Tok_Null =>
 907                   Check_Bad_Layout;
 908                   Append_To (Statement_List, P_Null_Statement);
 909                   Statement_Required := False;
 910 
 911                --  Raise_Statement
 912 
 913                when Tok_Raise =>
 914                   Check_Bad_Layout;
 915                   Append_To (Statement_List, P_Raise_Statement);
 916                   Statement_Required := False;
 917 
 918                --  Requeue_Statement
 919 
 920                when Tok_Requeue =>
 921                   Check_Bad_Layout;
 922                   Append_To (Statement_List, P_Requeue_Statement);
 923                   Statement_Required := False;
 924 
 925                --  Return_Statement
 926 
 927                when Tok_Return =>
 928                   Check_Bad_Layout;
 929                   Append_To (Statement_List, P_Return_Statement);
 930                   Statement_Required := False;
 931 
 932                --  Select_Statement
 933 
 934                when Tok_Select =>
 935                   Check_Bad_Layout;
 936                   Append_To (Statement_List, P_Select_Statement);
 937                   Statement_Required := False;
 938 
 939                --  While_Statement (Block_Statement with while and no loop)
 940 
 941                when Tok_While =>
 942                   Check_Bad_Layout;
 943                   Append_To (Statement_List, P_While_Statement);
 944                   Statement_Required := False;
 945 
 946                --  Anything else is some kind of junk, signal an error message
 947                --  and then raise Error_Resync, to merge with the normal
 948                --  handling of a bad statement.
 949 
 950                when others =>
 951 
 952                   if Token in Token_Class_Declk then
 953                      Junk_Declaration;
 954 
 955                   else
 956                      Error_Msg_BC -- CODEFIX
 957                        ("statement expected");
 958                      raise Error_Resync;
 959                   end if;
 960             end case;
 961 
 962          --  On error resynchronization, skip past next semicolon, and, since
 963          --  we are still in the statement loop, look for next statement. We
 964          --  set Statement_Required False to avoid an unnecessary error message
 965          --  complaining that no statement was found (i.e. we consider the
 966          --  junk to satisfy the requirement for a statement being present).
 967 
 968          exception
 969             when Error_Resync =>
 970                Resync_Past_Semicolon_Or_To_Loop_Or_Then;
 971                Statement_Required := False;
 972          end;
 973 
 974          exit when SS_Flags.Unco;
 975 
 976       end loop;
 977 
 978       return Statement_List;
 979 
 980    end P_Sequence_Of_Statements;
 981 
 982    --------------------
 983    -- 5.1  Statement --
 984    --------------------
 985 
 986    ---------------------------
 987    -- 5.1  Simple Statement --
 988    ---------------------------
 989 
 990    --  Parsed by P_Sequence_Of_Statements (5.1)
 991 
 992    -----------------------------
 993    -- 5.1  Compound Statement --
 994    -----------------------------
 995 
 996    --  Parsed by P_Sequence_Of_Statements (5.1)
 997 
 998    -------------------------
 999    -- 5.1  Null Statement --
1000    -------------------------
1001 
1002    --  NULL_STATEMENT ::= null;
1003 
1004    --  The caller has already checked that the current token is null
1005 
1006    --  Error recovery: cannot raise Error_Resync
1007 
1008    function P_Null_Statement return Node_Id is
1009       Null_Stmt_Node : Node_Id;
1010 
1011    begin
1012       Null_Stmt_Node := New_Node (N_Null_Statement, Token_Ptr);
1013       Scan; -- past NULL
1014       TF_Semicolon;
1015       return Null_Stmt_Node;
1016    end P_Null_Statement;
1017 
1018    ----------------
1019    -- 5.1  Label --
1020    ----------------
1021 
1022    --  LABEL ::= <<label_STATEMENT_IDENTIFIER>>
1023 
1024    --  STATEMENT_IDENTIFIER ::= DIRECT_NAME
1025 
1026    --  The IDENTIFIER of a STATEMENT_IDENTIFIER shall be an identifier
1027    --  (not an OPERATOR_SYMBOL)
1028 
1029    --  The caller has already checked that the current token is <<
1030 
1031    --  Error recovery: can raise Error_Resync
1032 
1033    function P_Label return Node_Id is
1034       Label_Node : Node_Id;
1035 
1036    begin
1037       Label_Node := New_Node (N_Label, Token_Ptr);
1038       Scan; -- past <<
1039       Set_Identifier (Label_Node, P_Identifier (C_Greater_Greater));
1040       T_Greater_Greater;
1041       Append_Elmt (Label_Node, Label_List);
1042       return Label_Node;
1043    end P_Label;
1044 
1045    -------------------------------
1046    -- 5.1  Statement Identifier --
1047    -------------------------------
1048 
1049    --  Statement label is parsed by P_Label (5.1)
1050 
1051    --  Loop label is parsed by P_Loop_Statement (5.5), P_For_Statement (5.5)
1052    --   or P_While_Statement (5.5)
1053 
1054    --  Block label is parsed by P_Begin_Statement (5.6) or
1055    --   P_Declare_Statement (5.6)
1056 
1057    -------------------------------
1058    -- 5.2  Assignment Statement --
1059    -------------------------------
1060 
1061    --  ASSIGNMENT_STATEMENT ::=
1062    --    variable_NAME := EXPRESSION;
1063 
1064    --  Error recovery: can raise Error_Resync
1065 
1066    function P_Assignment_Statement (LHS : Node_Id) return Node_Id is
1067       Assign_Node : Node_Id;
1068 
1069    begin
1070       Assign_Node := New_Node (N_Assignment_Statement, Prev_Token_Ptr);
1071       Set_Name (Assign_Node, LHS);
1072       Set_Expression (Assign_Node, P_Expression_No_Right_Paren);
1073       TF_Semicolon;
1074       return Assign_Node;
1075    end P_Assignment_Statement;
1076 
1077    -----------------------
1078    -- 5.3  If Statement --
1079    -----------------------
1080 
1081    --  IF_STATEMENT ::=
1082    --    if CONDITION then
1083    --      SEQUENCE_OF_STATEMENTS
1084    --    {elsif CONDITION then
1085    --      SEQUENCE_OF_STATEMENTS}
1086    --    [else
1087    --      SEQUENCE_OF_STATEMENTS]
1088    --    end if;
1089 
1090    --  The caller has checked that the initial token is IF (or in the error
1091    --  case of a mysterious THEN, the initial token may simply be THEN, in
1092    --  which case, no condition (or IF) was scanned).
1093 
1094    --  Error recovery: can raise Error_Resync
1095 
1096    function P_If_Statement return Node_Id is
1097       If_Node    : Node_Id;
1098       Elsif_Node : Node_Id;
1099       Loc        : Source_Ptr;
1100 
1101       procedure Add_Elsif_Part;
1102       --  An internal procedure used to scan out a single ELSIF part. On entry
1103       --  the ELSIF (or an ELSE which has been determined should be ELSIF) is
1104       --  scanned out and is in Prev_Token.
1105 
1106       procedure Check_If_Column;
1107       --  An internal procedure used to check that THEN, ELSE, or ELSIF
1108       --  appear in the right place if column checking is enabled (i.e. if
1109       --  they are the first token on the line, then they must appear in
1110       --  the same column as the opening IF).
1111 
1112       procedure Check_Then_Column;
1113       --  This procedure carries out the style checks for a THEN token
1114       --  Note that the caller has set Loc to the Source_Ptr value for
1115       --  the previous IF or ELSIF token.
1116 
1117       function Else_Should_Be_Elsif return Boolean;
1118       --  An internal routine used to do a special error recovery check when
1119       --  an ELSE is encountered. It determines if the ELSE should be treated
1120       --  as an ELSIF. A positive decision (TRUE returned, is made if the ELSE
1121       --  is followed by a sequence of tokens, starting on the same line as
1122       --  the ELSE, which are not expression terminators, followed by a THEN.
1123       --  On entry, the ELSE has been scanned out.
1124 
1125       procedure Add_Elsif_Part is
1126       begin
1127          if No (Elsif_Parts (If_Node)) then
1128             Set_Elsif_Parts (If_Node, New_List);
1129          end if;
1130 
1131          Elsif_Node := New_Node (N_Elsif_Part, Prev_Token_Ptr);
1132          Loc := Prev_Token_Ptr;
1133          Set_Condition (Elsif_Node, P_Condition);
1134          Check_Then_Column;
1135          Then_Scan;
1136          Set_Then_Statements
1137            (Elsif_Node, P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq));
1138          Append (Elsif_Node, Elsif_Parts (If_Node));
1139       end Add_Elsif_Part;
1140 
1141       procedure Check_If_Column is
1142       begin
1143          if RM_Column_Check and then Token_Is_At_Start_Of_Line
1144            and then Start_Column /= Scope.Table (Scope.Last).Ecol
1145          then
1146             Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
1147             Error_Msg_SC ("(style) this token should be@");
1148          end if;
1149       end Check_If_Column;
1150 
1151       procedure Check_Then_Column is
1152       begin
1153          if Token = Tok_Then then
1154             Check_If_Column;
1155 
1156             if Style_Check then
1157                Style.Check_Then (Loc);
1158             end if;
1159          end if;
1160       end Check_Then_Column;
1161 
1162       function Else_Should_Be_Elsif return Boolean is
1163          Scan_State : Saved_Scan_State;
1164 
1165       begin
1166          if Token_Is_At_Start_Of_Line then
1167             return False;
1168 
1169          else
1170             Save_Scan_State (Scan_State);
1171 
1172             loop
1173                if Token in Token_Class_Eterm then
1174                   Restore_Scan_State (Scan_State);
1175                   return False;
1176                else
1177                   Scan; -- past non-expression terminating token
1178 
1179                   if Token = Tok_Then then
1180                      Restore_Scan_State (Scan_State);
1181                      return True;
1182                   end if;
1183                end if;
1184             end loop;
1185          end if;
1186       end Else_Should_Be_Elsif;
1187 
1188    --  Start of processing for P_If_Statement
1189 
1190    begin
1191       If_Node := New_Node (N_If_Statement, Token_Ptr);
1192 
1193       Push_Scope_Stack;
1194       Scope.Table (Scope.Last).Etyp := E_If;
1195       Scope.Table (Scope.Last).Ecol := Start_Column;
1196       Scope.Table (Scope.Last).Sloc := Token_Ptr;
1197       Scope.Table (Scope.Last).Labl := Error;
1198       Scope.Table (Scope.Last).Node := If_Node;
1199 
1200       if Token = Tok_If then
1201          Loc := Token_Ptr;
1202          Scan; -- past IF
1203          Set_Condition (If_Node, P_Condition);
1204 
1205          --  Deal with misuse of IF expression => used instead
1206          --  of WHEN expression =>
1207 
1208          if Token = Tok_Arrow then
1209             Error_Msg_SC -- CODEFIX
1210               ("THEN expected");
1211             Scan; -- past the arrow
1212             Pop_Scope_Stack; -- remove unneeded entry
1213             raise Error_Resync;
1214          end if;
1215 
1216          Check_Then_Column;
1217 
1218       else
1219          Error_Msg_SC ("no IF for this THEN");
1220          Set_Condition (If_Node, Error);
1221       end if;
1222 
1223       Then_Scan;
1224 
1225       Set_Then_Statements
1226         (If_Node, P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq));
1227 
1228       --  This loop scans out else and elsif parts
1229 
1230       loop
1231          if Token = Tok_Elsif then
1232             Check_If_Column;
1233 
1234             if Present (Else_Statements (If_Node)) then
1235                Error_Msg_SP ("ELSIF cannot appear after ELSE");
1236             end if;
1237 
1238             Scan; -- past ELSIF
1239             Add_Elsif_Part;
1240 
1241          elsif Token = Tok_Else then
1242             Check_If_Column;
1243             Scan; -- past ELSE
1244 
1245             if Else_Should_Be_Elsif then
1246                Error_Msg_SP -- CODEFIX
1247                  ("ELSE should be ELSIF");
1248                Add_Elsif_Part;
1249 
1250             else
1251                --  Here we have an else that really is an else
1252 
1253                if Present (Else_Statements (If_Node)) then
1254                   Error_Msg_SP ("only one ELSE part allowed");
1255                   Append_List
1256                     (P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq),
1257                      Else_Statements (If_Node));
1258                else
1259                   Set_Else_Statements
1260                     (If_Node, P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq));
1261                end if;
1262             end if;
1263 
1264          --  If anything other than ELSE or ELSIF, exit the loop. The token
1265          --  had better be END (and in fact it had better be END IF), but
1266          --  we will let End_Statements take care of checking that.
1267 
1268          else
1269             exit;
1270          end if;
1271       end loop;
1272 
1273       End_Statements;
1274       return If_Node;
1275 
1276    end P_If_Statement;
1277 
1278    --------------------
1279    -- 5.3  Condition --
1280    --------------------
1281 
1282    --  CONDITION ::= boolean_EXPRESSION
1283 
1284    function P_Condition return Node_Id is
1285    begin
1286       return P_Condition (P_Expression_No_Right_Paren);
1287    end P_Condition;
1288 
1289    function P_Condition (Cond : Node_Id) return Node_Id is
1290    begin
1291       --  It is never possible for := to follow a condition, so if we get
1292       --  a := we assume it is a mistyped equality. Note that we do not try
1293       --  to reconstruct the tree correctly in this case, but we do at least
1294       --  give an accurate error message.
1295 
1296       if Token = Tok_Colon_Equal then
1297          while Token = Tok_Colon_Equal loop
1298             Error_Msg_SC -- CODEFIX
1299               (""":="" should be ""=""");
1300             Scan; -- past junk :=
1301             Discard_Junk_Node (P_Expression_No_Right_Paren);
1302          end loop;
1303 
1304          return Cond;
1305 
1306       --  Otherwise check for redundant parentheses
1307 
1308       --  If the condition is a conditional or a quantified expression, it is
1309       --  parenthesized in the context of a condition, because of a separate
1310       --  syntax rule.
1311 
1312       else
1313          if Style_Check and then Paren_Count (Cond) > 0 then
1314             if not Nkind_In (Cond, N_If_Expression,
1315                                    N_Case_Expression,
1316                                    N_Quantified_Expression)
1317               or else Paren_Count (Cond) > 1
1318             then
1319                Style.Check_Xtra_Parens (First_Sloc (Cond));
1320             end if;
1321          end if;
1322 
1323          --  And return the result
1324 
1325          return Cond;
1326       end if;
1327    end P_Condition;
1328 
1329    -------------------------
1330    -- 5.4  Case Statement --
1331    -------------------------
1332 
1333    --  CASE_STATEMENT ::=
1334    --    case EXPRESSION is
1335    --      CASE_STATEMENT_ALTERNATIVE
1336    --      {CASE_STATEMENT_ALTERNATIVE}
1337    --    end case;
1338 
1339    --  The caller has checked that the first token is CASE
1340 
1341    --  Can raise Error_Resync
1342 
1343    function P_Case_Statement return Node_Id is
1344       Case_Node         : Node_Id;
1345       Alternatives_List : List_Id;
1346       First_When_Loc    : Source_Ptr;
1347 
1348    begin
1349       Case_Node := New_Node (N_Case_Statement, Token_Ptr);
1350 
1351       Push_Scope_Stack;
1352       Scope.Table (Scope.Last).Etyp := E_Case;
1353       Scope.Table (Scope.Last).Ecol := Start_Column;
1354       Scope.Table (Scope.Last).Sloc := Token_Ptr;
1355       Scope.Table (Scope.Last).Labl := Error;
1356       Scope.Table (Scope.Last).Node := Case_Node;
1357 
1358       Scan; -- past CASE
1359       Set_Expression (Case_Node, P_Expression_No_Right_Paren);
1360       TF_Is;
1361 
1362       --  Prepare to parse case statement alternatives
1363 
1364       Alternatives_List := New_List;
1365       P_Pragmas_Opt (Alternatives_List);
1366       First_When_Loc := Token_Ptr;
1367 
1368       --  Loop through case statement alternatives
1369 
1370       loop
1371          --  If we have a WHEN or OTHERS, then that's fine keep going. Note
1372          --  that it is a semantic check to ensure the proper use of OTHERS
1373 
1374          if Token = Tok_When or else Token = Tok_Others then
1375             Append (P_Case_Statement_Alternative, Alternatives_List);
1376 
1377          --  If we have an END, then probably we are at the end of the case
1378          --  but we only exit if Check_End thinks the END was reasonable.
1379 
1380          elsif Token = Tok_End then
1381             exit when Check_End;
1382 
1383          --  Here if token is other than WHEN, OTHERS or END. We definitely
1384          --  have an error, but the question is whether or not to get out of
1385          --  the case statement. We don't want to get out early, or we will
1386          --  get a slew of junk error messages for subsequent when tokens.
1387 
1388          --  If the token is not at the start of the line, or if it is indented
1389          --  with respect to the current case statement, then the best guess is
1390          --  that we are still supposed to be inside the case statement. We
1391          --  complain about the missing WHEN, and discard the junk statements.
1392 
1393          elsif not Token_Is_At_Start_Of_Line
1394            or else Start_Column > Scope.Table (Scope.Last).Ecol
1395          then
1396             Error_Msg_BC ("WHEN (case statement alternative) expected");
1397 
1398             --  Here is a possibility for infinite looping if we don't make
1399             --  progress. So try to process statements, otherwise exit
1400 
1401             declare
1402                Error_Ptr : constant Source_Ptr := Scan_Ptr;
1403             begin
1404                Discard_Junk_List (P_Sequence_Of_Statements (SS_Whtm));
1405                exit when Scan_Ptr = Error_Ptr and then Check_End;
1406             end;
1407 
1408          --  Here we have a junk token at the start of the line and it is
1409          --  not indented. If Check_End thinks there is a missing END, then
1410          --  we will get out of the case, otherwise we keep going.
1411 
1412          else
1413             exit when Check_End;
1414          end if;
1415       end loop;
1416 
1417       --  Make sure we have at least one alternative
1418 
1419       if No (First_Non_Pragma (Alternatives_List)) then
1420          Error_Msg
1421             ("WHEN expected, must have at least one alternative in case",
1422              First_When_Loc);
1423          return Error;
1424 
1425       else
1426          Set_Alternatives (Case_Node, Alternatives_List);
1427          return Case_Node;
1428       end if;
1429    end P_Case_Statement;
1430 
1431    -------------------------------------
1432    -- 5.4  Case Statement Alternative --
1433    -------------------------------------
1434 
1435    --  CASE_STATEMENT_ALTERNATIVE ::=
1436    --    when DISCRETE_CHOICE_LIST =>
1437    --      SEQUENCE_OF_STATEMENTS
1438 
1439    --  The caller has checked that the initial token is WHEN or OTHERS
1440    --  Error recovery: can raise Error_Resync
1441 
1442    function P_Case_Statement_Alternative return Node_Id is
1443       Case_Alt_Node : Node_Id;
1444 
1445    begin
1446       if Style_Check then
1447          Style.Check_Indentation;
1448       end if;
1449 
1450       Case_Alt_Node := New_Node (N_Case_Statement_Alternative, Token_Ptr);
1451       T_When; -- past WHEN (or give error in OTHERS case)
1452       Set_Discrete_Choices (Case_Alt_Node, P_Discrete_Choice_List);
1453       TF_Arrow;
1454       Set_Statements (Case_Alt_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm));
1455       return Case_Alt_Node;
1456    end P_Case_Statement_Alternative;
1457 
1458    -------------------------
1459    -- 5.5  Loop Statement --
1460    -------------------------
1461 
1462    --  LOOP_STATEMENT ::=
1463    --    [LOOP_STATEMENT_IDENTIFIER:]
1464    --      [ITERATION_SCHEME] loop
1465    --        SEQUENCE_OF_STATEMENTS
1466    --      end loop [loop_IDENTIFIER];
1467 
1468    --  ITERATION_SCHEME ::=
1469    --    while CONDITION
1470    --  | for LOOP_PARAMETER_SPECIFICATION
1471 
1472    --  The parsing of loop statements is handled by one of three functions
1473    --  P_Loop_Statement, P_For_Statement or P_While_Statement depending
1474    --  on the initial keyword in the construct (excluding the identifier)
1475 
1476    --  P_Loop_Statement
1477 
1478    --  This function parses the case where no iteration scheme is present
1479 
1480    --  The caller has checked that the initial token is LOOP. The parameter
1481    --  is the node identifiers for the loop label if any (or is set to Empty
1482    --  if there is no loop label).
1483 
1484    --  Error recovery : cannot raise Error_Resync
1485 
1486    function P_Loop_Statement (Loop_Name : Node_Id := Empty) return Node_Id is
1487       Loop_Node    : Node_Id;
1488       Created_Name : Node_Id;
1489 
1490    begin
1491       Push_Scope_Stack;
1492       Scope.Table (Scope.Last).Labl := Loop_Name;
1493       Scope.Table (Scope.Last).Ecol := Start_Column;
1494       Scope.Table (Scope.Last).Sloc := Token_Ptr;
1495       Scope.Table (Scope.Last).Etyp := E_Loop;
1496 
1497       Loop_Node := New_Node (N_Loop_Statement, Token_Ptr);
1498       TF_Loop;
1499 
1500       if No (Loop_Name) then
1501          Created_Name :=
1502            Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L'));
1503          Set_Comes_From_Source (Created_Name, False);
1504          Set_Has_Created_Identifier (Loop_Node, True);
1505          Set_Identifier (Loop_Node, Created_Name);
1506          Scope.Table (Scope.Last).Labl := Created_Name;
1507       else
1508          Set_Identifier (Loop_Node, Loop_Name);
1509       end if;
1510 
1511       Append_Elmt (Loop_Node, Label_List);
1512       Set_Statements (Loop_Node, P_Sequence_Of_Statements (SS_Sreq));
1513       End_Statements (Loop_Node);
1514       return Loop_Node;
1515    end P_Loop_Statement;
1516 
1517    --  P_For_Statement
1518 
1519    --  This function parses a loop statement with a FOR iteration scheme
1520 
1521    --  The caller has checked that the initial token is FOR. The parameter
1522    --  is the node identifier for the block label if any (or is set to Empty
1523    --  if there is no block label).
1524 
1525    --  Note: the caller fills in the Identifier field if a label was present
1526 
1527    --  Error recovery: can raise Error_Resync
1528 
1529    function P_For_Statement (Loop_Name : Node_Id := Empty) return Node_Id is
1530       Loop_Node        : Node_Id;
1531       Iter_Scheme_Node : Node_Id;
1532       Loop_For_Flag    : Boolean;
1533       Created_Name     : Node_Id;
1534       Spec             : Node_Id;
1535 
1536    begin
1537       Push_Scope_Stack;
1538       Scope.Table (Scope.Last).Labl := Loop_Name;
1539       Scope.Table (Scope.Last).Ecol := Start_Column;
1540       Scope.Table (Scope.Last).Sloc := Token_Ptr;
1541       Scope.Table (Scope.Last).Etyp := E_Loop;
1542 
1543       Loop_For_Flag := (Prev_Token = Tok_Loop);
1544       Scan; -- past FOR
1545       Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr);
1546       Spec := P_Loop_Parameter_Specification;
1547 
1548       if Nkind (Spec) = N_Loop_Parameter_Specification then
1549          Set_Loop_Parameter_Specification (Iter_Scheme_Node, Spec);
1550       else
1551          Set_Iterator_Specification (Iter_Scheme_Node, Spec);
1552       end if;
1553 
1554       --  The following is a special test so that a miswritten for loop such
1555       --  as "loop for I in 1..10;" is handled nicely, without making an extra
1556       --  entry in the scope stack. We don't bother to actually fix up the
1557       --  tree in this case since it's not worth the effort. Instead we just
1558       --  eat up the loop junk, leaving the entry for what now looks like an
1559       --  unmodified loop intact.
1560 
1561       if Loop_For_Flag and then Token = Tok_Semicolon then
1562          Error_Msg_SC ("LOOP belongs here, not before FOR");
1563          Pop_Scope_Stack;
1564          return Error;
1565 
1566       --  Normal case
1567 
1568       else
1569          Loop_Node := New_Node (N_Loop_Statement, Token_Ptr);
1570 
1571          if No (Loop_Name) then
1572             Created_Name :=
1573               Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L'));
1574             Set_Comes_From_Source (Created_Name, False);
1575             Set_Has_Created_Identifier (Loop_Node, True);
1576             Set_Identifier (Loop_Node, Created_Name);
1577             Scope.Table (Scope.Last).Labl := Created_Name;
1578          else
1579             Set_Identifier (Loop_Node, Loop_Name);
1580          end if;
1581 
1582          TF_Loop;
1583          Set_Statements (Loop_Node, P_Sequence_Of_Statements (SS_Sreq));
1584          End_Statements (Loop_Node);
1585          Set_Iteration_Scheme (Loop_Node, Iter_Scheme_Node);
1586          Append_Elmt (Loop_Node, Label_List);
1587          return Loop_Node;
1588       end if;
1589    end P_For_Statement;
1590 
1591    --  P_While_Statement
1592 
1593    --  This procedure scans a loop statement with a WHILE iteration scheme
1594 
1595    --  The caller has checked that the initial token is WHILE. The parameter
1596    --  is the node identifier for the block label if any (or is set to Empty
1597    --  if there is no block label).
1598 
1599    --  Error recovery: cannot raise Error_Resync
1600 
1601    function P_While_Statement (Loop_Name : Node_Id := Empty) return Node_Id is
1602       Loop_Node        : Node_Id;
1603       Iter_Scheme_Node : Node_Id;
1604       Loop_While_Flag  : Boolean;
1605       Created_Name     : Node_Id;
1606 
1607    begin
1608       Push_Scope_Stack;
1609       Scope.Table (Scope.Last).Labl := Loop_Name;
1610       Scope.Table (Scope.Last).Ecol := Start_Column;
1611       Scope.Table (Scope.Last).Sloc := Token_Ptr;
1612       Scope.Table (Scope.Last).Etyp := E_Loop;
1613 
1614       Loop_While_Flag := (Prev_Token = Tok_Loop);
1615       Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr);
1616       Scan; -- past WHILE
1617       Set_Condition (Iter_Scheme_Node, P_Condition);
1618 
1619       --  The following is a special test so that a miswritten for loop such
1620       --  as "loop while I > 10;" is handled nicely, without making an extra
1621       --  entry in the scope stack. We don't bother to actually fix up the
1622       --  tree in this case since it's not worth the effort. Instead we just
1623       --  eat up the loop junk, leaving the entry for what now looks like an
1624       --  unmodified loop intact.
1625 
1626       if Loop_While_Flag and then Token = Tok_Semicolon then
1627          Error_Msg_SC ("LOOP belongs here, not before WHILE");
1628          Pop_Scope_Stack;
1629          return Error;
1630 
1631       --  Normal case
1632 
1633       else
1634          Loop_Node := New_Node (N_Loop_Statement, Token_Ptr);
1635          TF_Loop;
1636 
1637          if No (Loop_Name) then
1638             Created_Name :=
1639               Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L'));
1640             Set_Comes_From_Source (Created_Name, False);
1641             Set_Has_Created_Identifier (Loop_Node, True);
1642             Set_Identifier (Loop_Node, Created_Name);
1643             Scope.Table (Scope.Last).Labl := Created_Name;
1644          else
1645             Set_Identifier (Loop_Node, Loop_Name);
1646          end if;
1647 
1648          Set_Statements (Loop_Node, P_Sequence_Of_Statements (SS_Sreq));
1649          End_Statements (Loop_Node);
1650          Set_Iteration_Scheme (Loop_Node, Iter_Scheme_Node);
1651          Append_Elmt (Loop_Node, Label_List);
1652          return Loop_Node;
1653       end if;
1654    end P_While_Statement;
1655 
1656    ---------------------------------------
1657    -- 5.5  Loop Parameter Specification --
1658    ---------------------------------------
1659 
1660    --  LOOP_PARAMETER_SPECIFICATION ::=
1661    --    DEFINING_IDENTIFIER in [reverse] DISCRETE_SUBTYPE_DEFINITION
1662 
1663    --  Error recovery: cannot raise Error_Resync
1664 
1665    function P_Loop_Parameter_Specification return Node_Id is
1666       Loop_Param_Specification_Node : Node_Id;
1667 
1668       ID_Node    : Node_Id;
1669       Scan_State : Saved_Scan_State;
1670 
1671    begin
1672 
1673       Save_Scan_State (Scan_State);
1674       ID_Node := P_Defining_Identifier (C_In);
1675 
1676       --  If the next token is OF, it indicates an Ada 2012 iterator. If the
1677       --  next token is a colon, this is also an Ada 2012 iterator, including
1678       --  a subtype indication for the loop parameter. Otherwise we parse the
1679       --  construct as a loop parameter specification. Note that the form
1680       --  "for A in B" is ambiguous, and must be resolved semantically: if B
1681       --  is a discrete subtype this is a loop specification, but if it is an
1682       --  expression it is an iterator specification. Ambiguity is resolved
1683       --  during analysis of the loop parameter specification.
1684 
1685       if Token = Tok_Of or else Token = Tok_Colon then
1686          Error_Msg_Ada_2012_Feature ("iterator", Token_Ptr);
1687          return P_Iterator_Specification (ID_Node);
1688       end if;
1689 
1690       --  The span of the Loop_Parameter_Specification starts at the
1691       --  defining identifier.
1692 
1693       Loop_Param_Specification_Node :=
1694         New_Node (N_Loop_Parameter_Specification, Sloc (ID_Node));
1695       Set_Defining_Identifier (Loop_Param_Specification_Node, ID_Node);
1696 
1697       if Token = Tok_Left_Paren then
1698          Error_Msg_SC ("subscripted loop parameter not allowed");
1699          Restore_Scan_State (Scan_State);
1700          Discard_Junk_Node (P_Name);
1701 
1702       elsif Token = Tok_Dot then
1703          Error_Msg_SC ("selected loop parameter not allowed");
1704          Restore_Scan_State (Scan_State);
1705          Discard_Junk_Node (P_Name);
1706       end if;
1707 
1708       T_In;
1709 
1710       if Token = Tok_Reverse then
1711          Scan; -- past REVERSE
1712          Set_Reverse_Present (Loop_Param_Specification_Node, True);
1713       end if;
1714 
1715       Set_Discrete_Subtype_Definition
1716         (Loop_Param_Specification_Node, P_Discrete_Subtype_Definition);
1717       return Loop_Param_Specification_Node;
1718 
1719    exception
1720       when Error_Resync =>
1721          return Error;
1722    end P_Loop_Parameter_Specification;
1723 
1724    ----------------------------------
1725    -- 5.5.1 Iterator_Specification --
1726    ----------------------------------
1727 
1728    function P_Iterator_Specification (Def_Id : Node_Id) return Node_Id is
1729       Node1 : Node_Id;
1730 
1731    begin
1732       Node1 := New_Node (N_Iterator_Specification, Sloc (Def_Id));
1733       Set_Defining_Identifier (Node1, Def_Id);
1734 
1735       if Token = Tok_Colon then
1736          Scan;  --  past :
1737          Set_Subtype_Indication (Node1, P_Subtype_Indication);
1738       end if;
1739 
1740       if Token = Tok_Of then
1741          Set_Of_Present (Node1);
1742          Scan;  --  past OF
1743 
1744       elsif Token = Tok_In then
1745          Scan;  --  past IN
1746 
1747       elsif Prev_Token = Tok_In
1748         and then Present (Subtype_Indication (Node1))
1749       then
1750          --  Simplest recovery is to transform it into an element iterator.
1751          --  Error message on 'in" has already been emitted when parsing the
1752          --  optional constraint.
1753 
1754          Set_Of_Present (Node1);
1755          Error_Msg_N
1756            ("subtype indication is only legal on an element iterator",
1757               Subtype_Indication (Node1));
1758 
1759       else
1760          return Error;
1761       end if;
1762 
1763       if Token = Tok_Reverse then
1764          Scan; -- past REVERSE
1765          Set_Reverse_Present (Node1, True);
1766       end if;
1767 
1768       Set_Name (Node1, P_Name);
1769       return Node1;
1770    end P_Iterator_Specification;
1771 
1772    --------------------------
1773    -- 5.6  Block Statement --
1774    --------------------------
1775 
1776    --  BLOCK_STATEMENT ::=
1777    --    [block_STATEMENT_IDENTIFIER:]
1778    --      [declare
1779    --        DECLARATIVE_PART]
1780    --      begin
1781    --        HANDLED_SEQUENCE_OF_STATEMENTS
1782    --      end [block_IDENTIFIER];
1783 
1784    --  The parsing of block statements is handled by one of the two functions
1785    --  P_Declare_Statement or P_Begin_Statement depending on whether or not
1786    --  a declare section is present
1787 
1788    --  P_Declare_Statement
1789 
1790    --  This function parses a block statement with DECLARE present
1791 
1792    --  The caller has checked that the initial token is DECLARE
1793 
1794    --  Error recovery: cannot raise Error_Resync
1795 
1796    function P_Declare_Statement
1797      (Block_Name : Node_Id := Empty)
1798       return       Node_Id
1799    is
1800       Block_Node   : Node_Id;
1801       Created_Name : Node_Id;
1802 
1803    begin
1804       Block_Node := New_Node (N_Block_Statement, Token_Ptr);
1805 
1806       Push_Scope_Stack;
1807       Scope.Table (Scope.Last).Etyp := E_Name;
1808       Scope.Table (Scope.Last).Lreq := Present (Block_Name);
1809       Scope.Table (Scope.Last).Ecol := Start_Column;
1810       Scope.Table (Scope.Last).Labl := Block_Name;
1811       Scope.Table (Scope.Last).Sloc := Token_Ptr;
1812 
1813       Scan; -- past DECLARE
1814 
1815       if No (Block_Name) then
1816          Created_Name :=
1817            Make_Identifier (Sloc (Block_Node), Set_Loop_Block_Name ('B'));
1818          Set_Comes_From_Source (Created_Name, False);
1819          Set_Has_Created_Identifier (Block_Node, True);
1820          Set_Identifier (Block_Node, Created_Name);
1821          Scope.Table (Scope.Last).Labl := Created_Name;
1822       else
1823          Set_Identifier (Block_Node, Block_Name);
1824       end if;
1825 
1826       Append_Elmt (Block_Node, Label_List);
1827       Parse_Decls_Begin_End (Block_Node);
1828       return Block_Node;
1829    end P_Declare_Statement;
1830 
1831    --  P_Begin_Statement
1832 
1833    --  This function parses a block statement with no DECLARE present
1834 
1835    --  The caller has checked that the initial token is BEGIN
1836 
1837    --  Error recovery: cannot raise Error_Resync
1838 
1839    function P_Begin_Statement
1840      (Block_Name : Node_Id := Empty)
1841       return       Node_Id
1842    is
1843       Block_Node   : Node_Id;
1844       Created_Name : Node_Id;
1845 
1846    begin
1847       Block_Node := New_Node (N_Block_Statement, Token_Ptr);
1848 
1849       Push_Scope_Stack;
1850       Scope.Table (Scope.Last).Etyp := E_Name;
1851       Scope.Table (Scope.Last).Lreq := Present (Block_Name);
1852       Scope.Table (Scope.Last).Ecol := Start_Column;
1853       Scope.Table (Scope.Last).Labl := Block_Name;
1854       Scope.Table (Scope.Last).Sloc := Token_Ptr;
1855 
1856       if No (Block_Name) then
1857          Created_Name :=
1858            Make_Identifier (Sloc (Block_Node), Set_Loop_Block_Name ('B'));
1859          Set_Comes_From_Source (Created_Name, False);
1860          Set_Has_Created_Identifier (Block_Node, True);
1861          Set_Identifier (Block_Node, Created_Name);
1862          Scope.Table (Scope.Last).Labl := Created_Name;
1863       else
1864          Set_Identifier (Block_Node, Block_Name);
1865       end if;
1866 
1867       Append_Elmt (Block_Node, Label_List);
1868 
1869       Scope.Table (Scope.Last).Ecol := Start_Column;
1870       Scope.Table (Scope.Last).Sloc := Token_Ptr;
1871       Scan; -- past BEGIN
1872       Set_Handled_Statement_Sequence
1873         (Block_Node, P_Handled_Sequence_Of_Statements);
1874       End_Statements (Handled_Statement_Sequence (Block_Node));
1875       return Block_Node;
1876    end P_Begin_Statement;
1877 
1878    -------------------------
1879    -- 5.7  Exit Statement --
1880    -------------------------
1881 
1882    --  EXIT_STATEMENT ::=
1883    --    exit [loop_NAME] [when CONDITION];
1884 
1885    --  The caller has checked that the initial token is EXIT
1886 
1887    --  Error recovery: can raise Error_Resync
1888 
1889    function P_Exit_Statement return Node_Id is
1890       Exit_Node : Node_Id;
1891 
1892       function Missing_Semicolon_On_Exit return Boolean;
1893       --  This function deals with the following specialized situation
1894       --
1895       --    when 'x' =>
1896       --       exit [identifier]
1897       --    when 'y' =>
1898       --
1899       --  This looks like a messed up EXIT WHEN, when in fact the problem
1900       --  is a missing semicolon. It is called with Token pointing to the
1901       --  WHEN token, and returns True if a semicolon is missing before
1902       --  the WHEN as in the above example.
1903 
1904       -------------------------------
1905       -- Missing_Semicolon_On_Exit --
1906       -------------------------------
1907 
1908       function Missing_Semicolon_On_Exit return Boolean is
1909          State : Saved_Scan_State;
1910 
1911       begin
1912          if not Token_Is_At_Start_Of_Line then
1913             return False;
1914 
1915          elsif Scope.Table (Scope.Last).Etyp /= E_Case then
1916             return False;
1917 
1918          else
1919             Save_Scan_State (State);
1920             Scan; -- past WHEN
1921             Scan; -- past token after WHEN
1922 
1923             if Token = Tok_Arrow then
1924                Restore_Scan_State (State);
1925                return True;
1926             else
1927                Restore_Scan_State (State);
1928                return False;
1929             end if;
1930          end if;
1931       end Missing_Semicolon_On_Exit;
1932 
1933    --  Start of processing for P_Exit_Statement
1934 
1935    begin
1936       Exit_Node := New_Node (N_Exit_Statement, Token_Ptr);
1937       Scan; -- past EXIT
1938 
1939       if Token = Tok_Identifier then
1940          Set_Name (Exit_Node, P_Qualified_Simple_Name);
1941 
1942       elsif Style_Check then
1943          --  This EXIT has no name, so check that
1944          --  the innermost loop is unnamed too.
1945 
1946          Check_No_Exit_Name :
1947          for J in reverse 1 .. Scope.Last loop
1948             if Scope.Table (J).Etyp = E_Loop then
1949                if Present (Scope.Table (J).Labl)
1950                  and then Comes_From_Source (Scope.Table (J).Labl)
1951                then
1952                   --  Innermost loop in fact had a name, style check fails
1953 
1954                   Style.No_Exit_Name (Scope.Table (J).Labl);
1955                end if;
1956 
1957                exit Check_No_Exit_Name;
1958             end if;
1959          end loop Check_No_Exit_Name;
1960       end if;
1961 
1962       if Token = Tok_When and then not Missing_Semicolon_On_Exit then
1963          Scan; -- past WHEN
1964          Set_Condition (Exit_Node, P_Condition);
1965 
1966       --  Allow IF instead of WHEN, giving error message
1967 
1968       elsif Token = Tok_If then
1969          T_When;
1970          Scan; -- past IF used in place of WHEN
1971          Set_Condition (Exit_Node, P_Expression_No_Right_Paren);
1972       end if;
1973 
1974       TF_Semicolon;
1975       return Exit_Node;
1976    end P_Exit_Statement;
1977 
1978    -------------------------
1979    -- 5.8  Goto Statement --
1980    -------------------------
1981 
1982    --  GOTO_STATEMENT ::= goto label_NAME;
1983 
1984    --  The caller has checked that the initial token is GOTO  (or TO in the
1985    --  error case where GO and TO were incorrectly separated).
1986 
1987    --  Error recovery: can raise Error_Resync
1988 
1989    function P_Goto_Statement return Node_Id is
1990       Goto_Node : Node_Id;
1991 
1992    begin
1993       Goto_Node := New_Node (N_Goto_Statement, Token_Ptr);
1994       Scan; -- past GOTO (or TO)
1995       Set_Name (Goto_Node, P_Qualified_Simple_Name_Resync);
1996       Append_Elmt (Goto_Node, Goto_List);
1997       No_Constraint;
1998       TF_Semicolon;
1999       return Goto_Node;
2000    end P_Goto_Statement;
2001 
2002    ---------------------------
2003    -- Parse_Decls_Begin_End --
2004    ---------------------------
2005 
2006    --  This function parses the construct:
2007 
2008    --      DECLARATIVE_PART
2009    --    begin
2010    --      HANDLED_SEQUENCE_OF_STATEMENTS
2011    --    end [NAME];
2012 
2013    --  The caller has built the scope stack entry, and created the node to
2014    --  whose Declarations and Handled_Statement_Sequence fields are to be
2015    --  set. On return these fields are filled in (except in the case of a
2016    --  task body, where the handled statement sequence is optional, and may
2017    --  thus be Empty), and the scan is positioned past the End sequence.
2018 
2019    --  If the BEGIN is missing, then the parent node is used to help construct
2020    --  an appropriate missing BEGIN message. Possibilities for the parent are:
2021 
2022    --    N_Block_Statement     declare block
2023    --    N_Entry_Body          entry body
2024    --    N_Package_Body        package body (begin part optional)
2025    --    N_Subprogram_Body     procedure or function body
2026    --    N_Task_Body           task body
2027 
2028    --  Note: in the case of a block statement, there is definitely a DECLARE
2029    --  present (because a Begin statement without a DECLARE is handled by the
2030    --  P_Begin_Statement procedure, which does not call Parse_Decls_Begin_End.
2031 
2032    --  Error recovery: cannot raise Error_Resync
2033 
2034    procedure Parse_Decls_Begin_End (Parent : Node_Id) is
2035       Body_Decl    : Node_Id;
2036       Decls        : List_Id;
2037       Parent_Nkind : Node_Kind;
2038       Spec_Node    : Node_Id;
2039       HSS          : Node_Id;
2040 
2041       procedure Missing_Begin (Msg : String);
2042       --  Called to post a missing begin message. In the normal case this is
2043       --  posted at the start of the current token. A special case arises when
2044       --  P_Declarative_Items has previously found a missing begin, in which
2045       --  case we replace the original error message.
2046 
2047       procedure Set_Null_HSS (Parent : Node_Id);
2048       --  Construct an empty handled statement sequence and install in Parent
2049       --  Leaves HSS set to reference the newly constructed statement sequence.
2050 
2051       -------------------
2052       -- Missing_Begin --
2053       -------------------
2054 
2055       procedure Missing_Begin (Msg : String) is
2056       begin
2057          if Missing_Begin_Msg = No_Error_Msg then
2058             Error_Msg_BC (Msg);
2059          else
2060             Change_Error_Text (Missing_Begin_Msg, Msg);
2061 
2062             --  Purge any messages issued after than, since a missing begin
2063             --  can cause a lot of havoc, and it is better not to dump these
2064             --  cascaded messages on the user.
2065 
2066             Purge_Messages (Get_Location (Missing_Begin_Msg), Prev_Token_Ptr);
2067          end if;
2068       end Missing_Begin;
2069 
2070       ------------------
2071       -- Set_Null_HSS --
2072       ------------------
2073 
2074       procedure Set_Null_HSS (Parent : Node_Id) is
2075          Null_Stm : Node_Id;
2076 
2077       begin
2078          Null_Stm :=
2079            Make_Null_Statement (Token_Ptr);
2080          Set_Comes_From_Source (Null_Stm, False);
2081 
2082          HSS :=
2083            Make_Handled_Sequence_Of_Statements (Token_Ptr,
2084              Statements => New_List (Null_Stm));
2085          Set_Comes_From_Source (HSS, False);
2086 
2087          Set_Handled_Statement_Sequence (Parent, HSS);
2088       end Set_Null_HSS;
2089 
2090    --  Start of processing for Parse_Decls_Begin_End
2091 
2092    begin
2093       Decls := P_Declarative_Part;
2094 
2095       if Ada_Version = Ada_83 then
2096          Check_Later_Vs_Basic_Declarations (Decls, During_Parsing => True);
2097       end if;
2098 
2099       --  Here is where we deal with the case of IS used instead of semicolon.
2100       --  Specifically, if the last declaration in the declarative part is a
2101       --  subprogram body still marked as having a bad IS, then this is where
2102       --  we decide that the IS should really have been a semicolon and that
2103       --  the body should have been a declaration. Note that if the bad IS
2104       --  had turned out to be OK (i.e. a decent begin/end was found for it),
2105       --  then the Bad_Is_Detected flag would have been reset by now.
2106 
2107       Body_Decl := Last (Decls);
2108 
2109       if Present (Body_Decl)
2110         and then Nkind (Body_Decl) = N_Subprogram_Body
2111         and then Bad_Is_Detected (Body_Decl)
2112       then
2113          --  OK, we have the case of a bad IS, so we need to fix up the tree.
2114          --  What we have now is a subprogram body with attached declarations
2115          --  and a possible statement sequence.
2116 
2117          --  First step is to take the declarations that were part of the bogus
2118          --  subprogram body and append them to the outer declaration chain.
2119          --  In other words we append them past the body (which we will later
2120          --  convert into a declaration).
2121 
2122          Append_List (Declarations (Body_Decl), Decls);
2123 
2124          --  Now take the handled statement sequence of the bogus body and
2125          --  set it as the statement sequence for the outer construct. Note
2126          --  that it may be empty (we specially allowed a missing BEGIN for
2127          --  a subprogram body marked as having a bad IS -- see below).
2128 
2129          Set_Handled_Statement_Sequence (Parent,
2130            Handled_Statement_Sequence (Body_Decl));
2131 
2132          --  Next step is to convert the old body node to a declaration node
2133 
2134          Spec_Node := Specification (Body_Decl);
2135          Change_Node (Body_Decl, N_Subprogram_Declaration);
2136          Set_Specification (Body_Decl, Spec_Node);
2137 
2138          --  Final step is to put the declarations for the parent where
2139          --  they belong, and then fall through the IF to scan out the
2140          --  END statements.
2141 
2142          Set_Declarations (Parent, Decls);
2143 
2144       --  This is the normal case (i.e. any case except the bad IS case)
2145       --  If we have a BEGIN, then scan out the sequence of statements, and
2146       --  also reset the expected column for the END to match the BEGIN.
2147 
2148       else
2149          Set_Declarations (Parent, Decls);
2150 
2151          if Token = Tok_Begin then
2152             if Style_Check then
2153                Style.Check_Indentation;
2154             end if;
2155 
2156             Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
2157 
2158             if RM_Column_Check
2159               and then Token_Is_At_Start_Of_Line
2160               and then Start_Column /= Error_Msg_Col
2161             then
2162                Error_Msg_SC ("(style) BEGIN in wrong column, should be@");
2163 
2164             else
2165                Scope.Table (Scope.Last).Ecol := Start_Column;
2166             end if;
2167 
2168             Scope.Table (Scope.Last).Sloc := Token_Ptr;
2169             Scan; -- past BEGIN
2170             Set_Handled_Statement_Sequence (Parent,
2171               P_Handled_Sequence_Of_Statements);
2172 
2173          --  No BEGIN present
2174 
2175          else
2176             Parent_Nkind := Nkind (Parent);
2177 
2178             --  A special check for the missing IS case. If we have a
2179             --  subprogram body that was marked as having a suspicious
2180             --  IS, and the current token is END, then we simply confirm
2181             --  the suspicion, and do not require a BEGIN to be present
2182 
2183             if Parent_Nkind = N_Subprogram_Body
2184               and then Token  = Tok_End
2185               and then Scope.Table (Scope.Last).Etyp = E_Suspicious_Is
2186             then
2187                Scope.Table (Scope.Last).Etyp := E_Bad_Is;
2188 
2189             --  Otherwise BEGIN is not required for a package body, so we
2190             --  don't mind if it is missing, but we do construct a dummy
2191             --  one (so that we have somewhere to set End_Label).
2192 
2193             --  However if we have something other than a BEGIN which
2194             --  looks like it might be statements, then we signal a missing
2195             --  BEGIN for these cases as well. We define "something which
2196             --  looks like it might be statements" as a token other than
2197             --  END, EOF, or a token which starts declarations.
2198 
2199             elsif Parent_Nkind = N_Package_Body
2200               and then (Token = Tok_End
2201                           or else Token = Tok_EOF
2202                           or else Token in Token_Class_Declk)
2203             then
2204                Set_Null_HSS (Parent);
2205 
2206             --  These are cases in which a BEGIN is required and not present
2207 
2208             else
2209                Set_Null_HSS (Parent);
2210 
2211                --  Prepare to issue error message
2212 
2213                Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc;
2214                Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
2215 
2216                --  Now issue appropriate message
2217 
2218                if Parent_Nkind = N_Block_Statement then
2219                   Missing_Begin ("missing BEGIN for DECLARE#!");
2220 
2221                elsif Parent_Nkind = N_Entry_Body then
2222                   Missing_Begin ("missing BEGIN for ENTRY#!");
2223 
2224                elsif Parent_Nkind = N_Subprogram_Body then
2225                   if Nkind (Specification (Parent))
2226                                = N_Function_Specification
2227                   then
2228                      Missing_Begin ("missing BEGIN for function&#!");
2229                   else
2230                      Missing_Begin ("missing BEGIN for procedure&#!");
2231                   end if;
2232 
2233                --  The case for package body arises only when
2234                --  we have possible statement junk present.
2235 
2236                elsif Parent_Nkind = N_Package_Body then
2237                   Missing_Begin ("missing BEGIN for package body&#!");
2238 
2239                else
2240                   pragma Assert (Parent_Nkind = N_Task_Body);
2241                   Missing_Begin ("missing BEGIN for task body&#!");
2242                end if;
2243 
2244                --  Here we pick up the statements after the BEGIN that
2245                --  should have been present but was not. We don't insist
2246                --  on statements being present if P_Declarative_Part had
2247                --  already found a missing BEGIN, since it might have
2248                --  swallowed a lone statement into the declarative part.
2249 
2250                if Missing_Begin_Msg /= No_Error_Msg
2251                  and then Token = Tok_End
2252                then
2253                   null;
2254                else
2255                   Set_Handled_Statement_Sequence (Parent,
2256                     P_Handled_Sequence_Of_Statements);
2257                end if;
2258             end if;
2259          end if;
2260       end if;
2261 
2262       --  Here with declarations and handled statement sequence scanned
2263 
2264       if Present (Handled_Statement_Sequence (Parent)) then
2265          End_Statements (Handled_Statement_Sequence (Parent));
2266       else
2267          End_Statements;
2268       end if;
2269 
2270       --  We know that End_Statements removed an entry from the scope stack
2271       --  (because it is required to do so under all circumstances). We can
2272       --  therefore reference the entry it removed one past the stack top.
2273       --  What we are interested in is whether it was a case of a bad IS.
2274 
2275       if Scope.Table (Scope.Last + 1).Etyp = E_Bad_Is then
2276          Error_Msg -- CODEFIX
2277            ("|IS should be "";""", Scope.Table (Scope.Last + 1).S_Is);
2278          Set_Bad_Is_Detected (Parent, True);
2279       end if;
2280 
2281    end Parse_Decls_Begin_End;
2282 
2283    -------------------------
2284    -- Set_Loop_Block_Name --
2285    -------------------------
2286 
2287    function Set_Loop_Block_Name (L : Character) return Name_Id is
2288    begin
2289       Name_Buffer (1) := L;
2290       Name_Buffer (2) := '_';
2291       Name_Len := 2;
2292       Loop_Block_Count := Loop_Block_Count + 1;
2293       Add_Nat_To_Name_Buffer (Loop_Block_Count);
2294       return Name_Find;
2295    end Set_Loop_Block_Name;
2296 
2297    ---------------
2298    -- Then_Scan --
2299    ---------------
2300 
2301    procedure Then_Scan is
2302    begin
2303       TF_Then;
2304 
2305       while Token = Tok_Then loop
2306          Error_Msg_SC -- CODEFIX
2307            ("redundant THEN");
2308          TF_Then;
2309       end loop;
2310 
2311       if Token = Tok_And or else Token = Tok_Or then
2312          Error_Msg_SC ("unexpected logical operator");
2313          Scan; -- past logical operator
2314 
2315          if (Prev_Token = Tok_And and then Token = Tok_Then)
2316               or else
2317             (Prev_Token = Tok_Or  and then Token = Tok_Else)
2318          then
2319             Scan;
2320          end if;
2321 
2322          Discard_Junk_Node (P_Expression);
2323       end if;
2324 
2325       if Token = Tok_Then then
2326          Scan;
2327       end if;
2328    end Then_Scan;
2329 
2330 end Ch5;