gcc/ada/par-ch13.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P A R . C H 1 3                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2010, 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
  28 --  by RM section rather than alphabetical
  29
  30 separate (Par)
  31 package body Ch13 is
  32
  33    --  Local functions, used only in this chapter
  34
  35    function P_Component_Clause return Node_Id;
  36    function P_Mod_Clause return Node_Id;
  37
  38    -----------------------------------
  39    -- Aspect_Specifications_Present --
  40    -----------------------------------
  41
  42    function Aspect_Specifications_Present return Boolean is
  43       Scan_State : Saved_Scan_State;
  44       Result     : Boolean;
  45
  46    begin
  47       Save_Scan_State (Scan_State);
  48
  49       --  If we have a semicolon, test for semicolon followed by Aspect
  50       --  Specifications, in which case we decide the semicolon is accidental.
  51
  52       if Token = Tok_Semicolon then
  53          Scan; -- past semicolon
  54
  55          if Aspect_Specifications_Present then
  56             Error_Msg_SP ("|extra "";"" ignored");
  57             return True;
  58
  59          else
  60             Restore_Scan_State (Scan_State);
  61             return False;
  62          end if;
  63       end if;
  64
  65       --  Definitely must have WITH to consider aspect specs to be present
  66
  67       if Token /= Tok_With then
  68          return False;
  69       end if;
  70
  71       --  Have a WITH, see if it looks like an aspect specification
  72
  73       Save_Scan_State (Scan_State);
  74       Scan; -- past WITH
  75
  76       --  If no identifier, then consider that we definitely do not have an
  77       --  aspect specification.
  78
  79       if Token /= Tok_Identifier then
  80          Result := False;
  81
  82       --  In Ada 2012 mode, we are less strict, and we consider that we have
  83       --  an aspect specification if the identifier is an aspect name (even if
  84       --  not followed by =>) or the identifier is not an aspect name but is
  85       --  followed by =>. P_Aspect_Specifications will generate messages if the
  86       --  aspect specification is ill-formed.
  87
  88       elsif Ada_Version >= Ada_2012 then
  89          if Get_Aspect_Id (Token_Name) /= No_Aspect then
  90             Result := True;
  91          else
  92             Scan; -- past identifier
  93             Result := Token = Tok_Arrow;
  94          end if;
  95
  96       --  If earlier than Ada 2012, check for valid aspect identifier followed
  97       --  by an arrow, and consider that this is still an aspect specification
  98       --  so we give an appropriate message.
  99
 100       else
 101          if Get_Aspect_Id (Token_Name) = No_Aspect then
 102             Result := False;
 103
 104          else
 105             Scan; -- past aspect name
 106
 107             if Token /= Tok_Arrow then
 108                Result := False;
 109
 110             else
 111                Restore_Scan_State (Scan_State);
 112                Error_Msg_SC ("|aspect specification is an Ada 2012 feature");
 113                Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
 114                return True;
 115             end if;
 116          end if;
 117       end if;
 118
 119       Restore_Scan_State (Scan_State);
 120       return Result;
 121    end Aspect_Specifications_Present;
 122
 123    --------------------------------------------
 124    -- 13.1  Representation Clause (also I.7) --
 125    --------------------------------------------
 126
 127    --  REPRESENTATION_CLAUSE ::=
 128    --    ATTRIBUTE_DEFINITION_CLAUSE
 129    --  | ENUMERATION_REPRESENTATION_CLAUSE
 130    --  | RECORD_REPRESENTATION_CLAUSE
 131    --  | AT_CLAUSE
 132
 133    --  ATTRIBUTE_DEFINITION_CLAUSE ::=
 134    --    for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
 135    --  | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
 136
 137    --  Note: in Ada 83, the expression must be a simple expression
 138
 139    --  AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
 140
 141    --  Note: in Ada 83, the expression must be a simple expression
 142
 143    --  ENUMERATION_REPRESENTATION_CLAUSE ::=
 144    --    for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
 145
 146    --  ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
 147
 148    --  RECORD_REPRESENTATION_CLAUSE ::=
 149    --    for first_subtype_LOCAL_NAME use
 150    --      record [MOD_CLAUSE]
 151    --        {COMPONENT_CLAUSE}
 152    --      end record;
 153
 154    --  Note: for now we allow only a direct name as the local name in the
 155    --  above constructs. This probably needs changing later on ???
 156
 157    --  The caller has checked that the initial token is FOR
 158
 159    --  Error recovery: cannot raise Error_Resync, if an error occurs,
 160    --  the scan is repositioned past the next semicolon.
 161
 162    function P_Representation_Clause return Node_Id is
 163       For_Loc         : Source_Ptr;
 164       Name_Node       : Node_Id;
 165       Prefix_Node     : Node_Id;
 166       Attr_Name       : Name_Id;
 167       Identifier_Node : Node_Id;
 168       Rep_Clause_Node : Node_Id;
 169       Expr_Node       : Node_Id;
 170       Record_Items    : List_Id;
 171
 172    begin
 173       For_Loc := Token_Ptr;
 174       Scan; -- past FOR
 175
 176       --  Note that the name in a representation clause is always a simple
 177       --  name, even in the attribute case, see AI-300 which made this so!
 178
 179       Identifier_Node := P_Identifier (C_Use);
 180
 181       --  Check case of qualified name to give good error message
 182
 183       if Token = Tok_Dot then
 184          Error_Msg_SC
 185             ("representation clause requires simple name!");
 186
 187          loop
 188             exit when Token /= Tok_Dot;
 189             Scan; -- past dot
 190             Discard_Junk_Node (P_Identifier);
 191          end loop;
 192       end if;
 193
 194       --  Attribute Definition Clause
 195
 196       if Token = Tok_Apostrophe then
 197
 198          --  Allow local names of the form a'b'.... This enables
 199          --  us to parse class-wide streams attributes correctly.
 200
 201          Name_Node := Identifier_Node;
 202          while Token = Tok_Apostrophe loop
 203
 204             Scan; -- past apostrophe
 205
 206             Identifier_Node := Token_Node;
 207             Attr_Name := No_Name;
 208
 209             if Token = Tok_Identifier then
 210                Attr_Name := Token_Name;
 211
 212                if not Is_Attribute_Name (Attr_Name) then
 213                   Signal_Bad_Attribute;
 214                end if;
 215
 216                if Style_Check then
 217                   Style.Check_Attribute_Name (False);
 218                end if;
 219
 220             --  Here for case of attribute designator is not an identifier
 221
 222             else
 223                if Token = Tok_Delta then
 224                   Attr_Name := Name_Delta;
 225
 226                elsif Token = Tok_Digits then
 227                   Attr_Name := Name_Digits;
 228
 229                elsif Token = Tok_Access then
 230                   Attr_Name := Name_Access;
 231
 232                else
 233                   Error_Msg_AP ("attribute designator expected");
 234                   raise Error_Resync;
 235                end if;
 236
 237                if Style_Check then
 238                   Style.Check_Attribute_Name (True);
 239                end if;
 240             end if;
 241
 242             --  We come here with an OK attribute scanned, and the
 243             --  corresponding Attribute identifier node stored in Ident_Node.
 244
 245             Prefix_Node := Name_Node;
 246             Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
 247             Set_Prefix (Name_Node, Prefix_Node);
 248             Set_Attribute_Name (Name_Node, Attr_Name);
 249             Scan;
 250          end loop;
 251
 252          Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc);
 253          Set_Name (Rep_Clause_Node, Prefix_Node);
 254          Set_Chars (Rep_Clause_Node, Attr_Name);
 255          T_Use;
 256
 257          Expr_Node := P_Expression_No_Right_Paren;
 258          Check_Simple_Expression_In_Ada_83 (Expr_Node);
 259          Set_Expression (Rep_Clause_Node, Expr_Node);
 260
 261       else
 262          TF_Use;
 263          Rep_Clause_Node := Empty;
 264
 265          --  AT follows USE (At Clause)
 266
 267          if Token = Tok_At then
 268             Scan; -- past AT
 269             Rep_Clause_Node := New_Node (N_At_Clause, For_Loc);
 270             Set_Identifier (Rep_Clause_Node, Identifier_Node);
 271             Expr_Node := P_Expression_No_Right_Paren;
 272             Check_Simple_Expression_In_Ada_83 (Expr_Node);
 273             Set_Expression (Rep_Clause_Node, Expr_Node);
 274
 275          --  RECORD follows USE (Record Representation Clause)
 276
 277          elsif Token = Tok_Record then
 278             Record_Items := P_Pragmas_Opt;
 279             Rep_Clause_Node :=
 280               New_Node (N_Record_Representation_Clause, For_Loc);
 281             Set_Identifier (Rep_Clause_Node, Identifier_Node);
 282
 283             Push_Scope_Stack;
 284             Scope.Table (Scope.Last).Etyp := E_Record;
 285             Scope.Table (Scope.Last).Ecol := Start_Column;
 286             Scope.Table (Scope.Last).Sloc := Token_Ptr;
 287             Scan; -- past RECORD
 288             Record_Items := P_Pragmas_Opt;
 289
 290             --  Possible Mod Clause
 291
 292             if Token = Tok_At then
 293                Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause);
 294                Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items);
 295                Record_Items := P_Pragmas_Opt;
 296             end if;
 297
 298             if No (Record_Items) then
 299                Record_Items := New_List;
 300             end if;
 301
 302             Set_Component_Clauses (Rep_Clause_Node, Record_Items);
 303
 304             --  Loop through component clauses
 305
 306             loop
 307                if Token not in Token_Class_Name then
 308                   exit when Check_End;
 309                end if;
 310
 311                Append (P_Component_Clause, Record_Items);
 312                P_Pragmas_Opt (Record_Items);
 313             end loop;
 314
 315          --  Left paren follows USE (Enumeration Representation Clause)
 316
 317          elsif Token = Tok_Left_Paren then
 318             Rep_Clause_Node :=
 319               New_Node (N_Enumeration_Representation_Clause, For_Loc);
 320             Set_Identifier (Rep_Clause_Node, Identifier_Node);
 321             Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate);
 322
 323          --  Some other token follows FOR (invalid representation clause)
 324
 325          else
 326             Error_Msg_SC ("invalid representation clause");
 327             raise Error_Resync;
 328          end if;
 329       end if;
 330
 331       TF_Semicolon;
 332       return Rep_Clause_Node;
 333
 334    exception
 335       when Error_Resync =>
 336          Resync_Past_Semicolon;
 337          return Error;
 338
 339    end P_Representation_Clause;
 340
 341    ----------------------
 342    -- 13.1  Local Name --
 343    ----------------------
 344
 345    --  Local name is always parsed by its parent. In the case of its use in
 346    --  pragmas, the check for a local name is handled in Par.Prag and allows
 347    --  all the possible forms of local name. For the uses in chapter 13, we
 348    --  currently only allow a direct name, but this should probably change???
 349
 350    ---------------------------
 351    -- 13.1  At Clause (I.7) --
 352    ---------------------------
 353
 354    --  Parsed by P_Representation_Clause (13.1)
 355
 356    ---------------------------------------
 357    -- 13.3  Attribute Definition Clause --
 358    ---------------------------------------
 359
 360    --  Parsed by P_Representation_Clause (13.1)
 361
 362    ------------------------------
 363    -- 13.1  Aspect Specifation --
 364    ------------------------------
 365
 366    --  ASPECT_SPECIFICATION ::=
 367    --    with ASPECT_MARK [=> ASPECT_DEFINITION] {.
 368    --         ASPECT_MARK [=> ASPECT_DEFINITION] }
 369
 370    --  ASPECT_MARK ::= aspect_IDENTIFIER['Class]
 371
 372    --  ASPECT_DEFINITION ::= NAME | EXPRESSION
 373
 374    --  Error recovery: cannot raise Error_Resync
 375
 376    procedure P_Aspect_Specifications (Decl : Node_Id) is
 377       Aspects : List_Id;
 378       Aspect  : Node_Id;
 379       A_Id    : Aspect_Id;
 380       OK      : Boolean;
 381       Ptr     : Source_Ptr;
 382
 383    begin
 384       --  Check if aspect specification present
 385
 386       if not Aspect_Specifications_Present then
 387          TF_Semicolon;
 388          return;
 389       end if;
 390
 391       --  Aspect Specification is present
 392
 393       Ptr := Token_Ptr;
 394       Scan; -- past WITH
 395
 396       --  Here we have an aspect specification to scan, note that we don;t
 397       --  set the flag till later, because it may turn out that we have no
 398       --  valid aspects in the list.
 399
 400       Aspects := Empty_List;
 401       loop
 402          OK := True;
 403
 404          if Token /= Tok_Identifier then
 405             Error_Msg_SC ("aspect identifier expected");
 406             Resync_Past_Semicolon;
 407             return;
 408          end if;
 409
 410          --  We have an identifier (which should be an aspect identifier)
 411
 412          A_Id := Get_Aspect_Id (Token_Name);
 413          Aspect :=
 414            Make_Aspect_Specification (Token_Ptr,
 415              Identifier => Token_Node);
 416
 417          --  No valid aspect identifier present
 418
 419          if A_Id = No_Aspect then
 420             Error_Msg_SC ("aspect identifier expected");
 421
 422             if Token = Tok_Apostrophe then
 423                Scan; -- past '
 424                Scan; -- past presumably CLASS
 425             end if;
 426
 427             if Token = Tok_Arrow then
 428                Scan; -- Past arrow
 429                Set_Expression (Aspect, P_Expression);
 430                OK := False;
 431
 432             elsif Token = Tok_Comma then
 433                OK := False;
 434
 435             else
 436                Resync_Past_Semicolon;
 437                return;
 438             end if;
 439
 440          --  OK aspect scanned
 441
 442          else
 443             Scan; -- past identifier
 444
 445             --  Check for 'Class present
 446
 447             if Token = Tok_Apostrophe then
 448                if not Class_Aspect_OK (A_Id) then
 449                   Error_Msg_Node_1 := Identifier (Aspect);
 450                   Error_Msg_SC ("aspect& does not permit attribute here");
 451                   Scan; -- past apostophe
 452                   Scan; -- past presumed CLASS
 453                   OK := False;
 454
 455                else
 456                   Scan; -- past apostrophe
 457
 458                   if Token /= Tok_Identifier
 459                     or else Token_Name /= Name_Class
 460                   then
 461                      Error_Msg_SC ("Class attribute expected here");
 462                      OK := False;
 463
 464                      if Token = Tok_Identifier then
 465                         Scan; -- past identifier not CLASS
 466                      end if;
 467
 468                   else
 469                      Scan; -- past CLASS
 470                      Set_Class_Present (Aspect);
 471                   end if;
 472                end if;
 473             end if;
 474
 475             --  Test case of missing aspect definition
 476
 477             if Token = Tok_Comma or else Token = Tok_Semicolon then
 478                if Aspect_Argument (A_Id) /= Optional then
 479                   Error_Msg_Node_1 := Aspect;
 480                   Error_Msg_AP ("aspect& requires an aspect definition");
 481                   OK := False;
 482                end if;
 483
 484             --  Here we have an aspect definition
 485
 486             else
 487                if Token = Tok_Arrow then
 488                   Scan; -- past arrow
 489                else
 490                   T_Arrow;
 491                   OK := False;
 492                end if;
 493
 494                if Aspect_Argument (A_Id) = Name then
 495                   Set_Expression (Aspect, P_Name);
 496                else
 497                   Set_Expression (Aspect, P_Expression);
 498                end if;
 499             end if;
 500
 501             --  If OK clause scanned, add it to the list
 502
 503             if OK then
 504                Append (Aspect, Aspects);
 505             end if;
 506
 507             if Token = Tok_Comma then
 508                Scan; -- past comma
 509             else
 510                T_Semicolon;
 511                exit;
 512             end if;
 513          end if;
 514       end loop;
 515
 516       --  If aspects scanned, store them
 517
 518       if Is_Non_Empty_List (Aspects) then
 519          if Decl = Error then
 520             Error_Msg ("aspect specifications not allowed here", Ptr);
 521          else
 522             Set_Parent (Aspects, Decl);
 523             Set_Aspect_Specifications (Decl, Aspects);
 524          end if;
 525       end if;
 526    end P_Aspect_Specifications;
 527
 528    ---------------------------------------------
 529    -- 13.4  Enumeration Representation Clause --
 530    ---------------------------------------------
 531
 532    --  Parsed by P_Representation_Clause (13.1)
 533
 534    ---------------------------------
 535    -- 13.4  Enumeration Aggregate --
 536    ---------------------------------
 537
 538    --  Parsed by P_Representation_Clause (13.1)
 539
 540    ------------------------------------------
 541    -- 13.5.1  Record Representation Clause --
 542    ------------------------------------------
 543
 544    --  Parsed by P_Representation_Clause (13.1)
 545
 546    ------------------------------
 547    -- 13.5.1  Mod Clause (I.8) --
 548    ------------------------------
 549
 550    --  MOD_CLAUSE ::= at mod static_EXPRESSION;
 551
 552    --  Note: in Ada 83, the expression must be a simple expression
 553
 554    --  The caller has checked that the initial Token is AT
 555
 556    --  Error recovery: cannot raise Error_Resync
 557
 558    --  Note: the caller is responsible for setting the Pragmas_Before field
 559
 560    function P_Mod_Clause return Node_Id is
 561       Mod_Node  : Node_Id;
 562       Expr_Node : Node_Id;
 563
 564    begin
 565       Mod_Node := New_Node (N_Mod_Clause, Token_Ptr);
 566       Scan; -- past AT
 567       T_Mod;
 568       Expr_Node := P_Expression_No_Right_Paren;
 569       Check_Simple_Expression_In_Ada_83 (Expr_Node);
 570       Set_Expression (Mod_Node, Expr_Node);
 571       TF_Semicolon;
 572       return Mod_Node;
 573    end P_Mod_Clause;
 574
 575    ------------------------------
 576    -- 13.5.1  Component Clause --
 577    ------------------------------
 578
 579    --  COMPONENT_CLAUSE ::=
 580    --    COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
 581    --      range FIRST_BIT .. LAST_BIT;
 582
 583    --  COMPONENT_CLAUSE_COMPONENT_NAME ::=
 584    --    component_DIRECT_NAME
 585    --  | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
 586    --  | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
 587
 588    --  POSITION ::= static_EXPRESSION
 589
 590    --  Note: in Ada 83, the expression must be a simple expression
 591
 592    --  FIRST_BIT ::= static_SIMPLE_EXPRESSION
 593    --  LAST_BIT ::= static_SIMPLE_EXPRESSION
 594
 595    --  Note: the AARM V2.0 grammar has an error at this point, it uses
 596    --  EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT
 597
 598    --  Error recovery: cannot raise Error_Resync
 599
 600    function P_Component_Clause return Node_Id is
 601       Component_Node : Node_Id;
 602       Comp_Name      : Node_Id;
 603       Expr_Node      : Node_Id;
 604
 605    begin
 606       Component_Node := New_Node (N_Component_Clause, Token_Ptr);
 607       Comp_Name := P_Name;
 608
 609       if Nkind (Comp_Name) = N_Identifier
 610         or else Nkind (Comp_Name) = N_Attribute_Reference
 611       then
 612          Set_Component_Name (Component_Node, Comp_Name);
 613       else
 614          Error_Msg_N
 615            ("component name must be direct name or attribute", Comp_Name);
 616          Set_Component_Name (Component_Node, Error);
 617       end if;
 618
 619       Set_Sloc (Component_Node, Token_Ptr);
 620       T_At;
 621       Expr_Node := P_Expression_No_Right_Paren;
 622       Check_Simple_Expression_In_Ada_83 (Expr_Node);
 623       Set_Position (Component_Node, Expr_Node);
 624       T_Range;
 625       Expr_Node := P_Expression_No_Right_Paren;
 626       Check_Simple_Expression_In_Ada_83 (Expr_Node);
 627       Set_First_Bit (Component_Node, Expr_Node);
 628       T_Dot_Dot;
 629       Expr_Node := P_Expression_No_Right_Paren;
 630       Check_Simple_Expression_In_Ada_83 (Expr_Node);
 631       Set_Last_Bit (Component_Node, Expr_Node);
 632       TF_Semicolon;
 633       return Component_Node;
 634    end P_Component_Clause;
 635
 636    ----------------------
 637    -- 13.5.1  Position --
 638    ----------------------
 639
 640    --  Parsed by P_Component_Clause (13.5.1)
 641
 642    -----------------------
 643    -- 13.5.1  First Bit --
 644    -----------------------
 645
 646    --  Parsed by P_Component_Clause (13.5.1)
 647
 648    ----------------------
 649    -- 13.5.1  Last Bit --
 650    ----------------------
 651
 652    --  Parsed by P_Component_Clause (13.5.1)
 653
 654    --------------------------
 655    -- 13.8  Code Statement --
 656    --------------------------
 657
 658    --  CODE_STATEMENT ::= QUALIFIED_EXPRESSION
 659
 660    --  On entry the caller has scanned the SUBTYPE_MARK (passed in as the
 661    --  single argument, and the scan points to the apostrophe.
 662
 663    --  Error recovery: can raise Error_Resync
 664
 665    function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is
 666       Node1 : Node_Id;
 667
 668    begin
 669       Scan; -- past apostrophe
 670
 671       --  If left paren, then we have a possible code statement
 672
 673       if Token = Tok_Left_Paren then
 674          Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark));
 675          Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark));
 676          TF_Semicolon;
 677          return Node1;
 678
 679       --  Otherwise we have an illegal range attribute. Note that P_Name
 680       --  ensures that Token = Tok_Range is the only possibility left here.
 681
 682       else -- Token = Tok_Range
 683          Error_Msg_SC ("RANGE attribute illegal here!");
 684          raise Error_Resync;
 685       end if;
 686
 687    end P_Code_Statement;
 688
 689 end Ch13;