gcc/ada/prj-dect.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              P R J . D E C T                             --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2006, 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 2,  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 COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Err_Vars;    use Err_Vars;
  28 with Namet;       use Namet;
  29 with Opt;         use Opt;
  30 with Prj.Err;     use Prj.Err;
  31 with Prj.Strt;    use Prj.Strt;
  32 with Prj.Tree;    use Prj.Tree;
  33 with Snames;
  34 with Prj.Attr;    use Prj.Attr;
  35 with Prj.Attr.PM; use Prj.Attr.PM;
  36 with Uintp;       use Uintp;
  37
  38 package body Prj.Dect is
  39
  40    type Zone is (In_Project, In_Package, In_Case_Construction);
  41    --  Used to indicate if we are parsing a package (In_Package),
  42    --  a case construction (In_Case_Construction) or none of those two
  43    --  (In_Project).
  44
  45    procedure Parse_Attribute_Declaration
  46      (In_Tree           : Project_Node_Tree_Ref;
  47       Attribute         : out Project_Node_Id;
  48       First_Attribute   : Attribute_Node_Id;
  49       Current_Project   : Project_Node_Id;
  50       Current_Package   : Project_Node_Id;
  51       Packages_To_Check : String_List_Access);
  52    --  Parse an attribute declaration
  53
  54    procedure Parse_Case_Construction
  55      (In_Tree           : Project_Node_Tree_Ref;
  56       Case_Construction : out Project_Node_Id;
  57       First_Attribute   : Attribute_Node_Id;
  58       Current_Project   : Project_Node_Id;
  59       Current_Package   : Project_Node_Id;
  60       Packages_To_Check : String_List_Access);
  61    --  Parse a case construction
  62
  63    procedure Parse_Declarative_Items
  64      (In_Tree           : Project_Node_Tree_Ref;
  65       Declarations      : out Project_Node_Id;
  66       In_Zone           : Zone;
  67       First_Attribute   : Attribute_Node_Id;
  68       Current_Project   : Project_Node_Id;
  69       Current_Package   : Project_Node_Id;
  70       Packages_To_Check : String_List_Access);
  71    --  Parse declarative items. Depending on In_Zone, some declarative
  72    --  items may be forbiden.
  73
  74    procedure Parse_Package_Declaration
  75      (In_Tree             : Project_Node_Tree_Ref;
  76       Package_Declaration : out Project_Node_Id;
  77       Current_Project     : Project_Node_Id;
  78       Packages_To_Check   : String_List_Access);
  79    --  Parse a package declaration
  80
  81    procedure Parse_String_Type_Declaration
  82      (In_Tree         : Project_Node_Tree_Ref;
  83       String_Type     : out Project_Node_Id;
  84       Current_Project : Project_Node_Id);
  85    --  type <name> is ( <literal_string> { , <literal_string> } ) ;
  86
  87    procedure Parse_Variable_Declaration
  88      (In_Tree         : Project_Node_Tree_Ref;
  89       Variable        : out Project_Node_Id;
  90       Current_Project : Project_Node_Id;
  91       Current_Package : Project_Node_Id);
  92    --  Parse a variable assignment
  93    --  <variable_Name> := <expression>; OR
  94    --  <variable_Name> : <string_type_Name> := <string_expression>;
  95
  96    -----------
  97    -- Parse --
  98    -----------
  99
 100    procedure Parse
 101      (In_Tree           : Project_Node_Tree_Ref;
 102       Declarations      : out Project_Node_Id;
 103       Current_Project   : Project_Node_Id;
 104       Extends           : Project_Node_Id;
 105       Packages_To_Check : String_List_Access)
 106    is
 107       First_Declarative_Item : Project_Node_Id := Empty_Node;
 108
 109    begin
 110       Declarations :=
 111         Default_Project_Node
 112           (Of_Kind => N_Project_Declaration, In_Tree => In_Tree);
 113       Set_Location_Of (Declarations, In_Tree, To => Token_Ptr);
 114       Set_Extended_Project_Of (Declarations, In_Tree, To => Extends);
 115       Set_Project_Declaration_Of (Current_Project, In_Tree, Declarations);
 116       Parse_Declarative_Items
 117         (Declarations      => First_Declarative_Item,
 118          In_Tree           => In_Tree,
 119          In_Zone           => In_Project,
 120          First_Attribute   => Prj.Attr.Attribute_First,
 121          Current_Project   => Current_Project,
 122          Current_Package   => Empty_Node,
 123          Packages_To_Check => Packages_To_Check);
 124       Set_First_Declarative_Item_Of
 125         (Declarations, In_Tree, To => First_Declarative_Item);
 126    end Parse;
 127
 128    ---------------------------------
 129    -- Parse_Attribute_Declaration --
 130    ---------------------------------
 131
 132    procedure Parse_Attribute_Declaration
 133      (In_Tree           : Project_Node_Tree_Ref;
 134       Attribute         : out Project_Node_Id;
 135       First_Attribute   : Attribute_Node_Id;
 136       Current_Project   : Project_Node_Id;
 137       Current_Package   : Project_Node_Id;
 138       Packages_To_Check : String_List_Access)
 139    is
 140       Current_Attribute      : Attribute_Node_Id := First_Attribute;
 141       Full_Associative_Array : Boolean           := False;
 142       Attribute_Name         : Name_Id           := No_Name;
 143       Optional_Index         : Boolean           := False;
 144       Pkg_Id                 : Package_Node_Id   := Empty_Package;
 145       Ignore                 : Boolean           := False;
 146
 147    begin
 148       Attribute :=
 149         Default_Project_Node
 150           (Of_Kind => N_Attribute_Declaration, In_Tree => In_Tree);
 151       Set_Location_Of (Attribute, In_Tree, To => Token_Ptr);
 152       Set_Previous_Line_Node (Attribute);
 153
 154       --  Scan past "for"
 155
 156       Scan (In_Tree);
 157
 158       --  Body may be an attribute name
 159
 160       if Token = Tok_Body then
 161          Token := Tok_Identifier;
 162          Token_Name := Snames.Name_Body;
 163       end if;
 164
 165       Expect (Tok_Identifier, "identifier");
 166
 167       if Token = Tok_Identifier then
 168          Attribute_Name := Token_Name;
 169          Set_Name_Of (Attribute, In_Tree, To => Token_Name);
 170          Set_Location_Of (Attribute, In_Tree, To => Token_Ptr);
 171
 172          --  Find the attribute
 173
 174          Current_Attribute :=
 175            Attribute_Node_Id_Of (Token_Name, First_Attribute);
 176
 177          --  If the attribute cannot be found, create the attribute if inside
 178          --  an unknown package.
 179
 180          if Current_Attribute = Empty_Attribute then
 181             if Current_Package /= Empty_Node
 182               and then Expression_Kind_Of (Current_Package, In_Tree) = Ignored
 183             then
 184                Pkg_Id := Package_Id_Of (Current_Package, In_Tree);
 185                Add_Attribute (Pkg_Id, Token_Name, Current_Attribute);
 186
 187             else
 188                --  If not a valid attribute name, issue an error if inside
 189                --  a package that need to be checked.
 190
 191                Ignore := Current_Package /= Empty_Node and then
 192                           Packages_To_Check /= All_Packages;
 193
 194                if Ignore then
 195
 196                   --  Check that we are not in a package to check
 197
 198                   Get_Name_String (Name_Of (Current_Package, In_Tree));
 199
 200                   for Index in Packages_To_Check'Range loop
 201                      if Name_Buffer (1 .. Name_Len) =
 202                        Packages_To_Check (Index).all
 203                      then
 204                         Ignore := False;
 205                         exit;
 206                      end if;
 207                   end loop;
 208                end if;
 209
 210                if not Ignore then
 211                   Error_Msg_Name_1 := Token_Name;
 212                   Error_Msg ("undefined attribute {", Token_Ptr);
 213                end if;
 214             end if;
 215
 216          --  Set, if appropriate the index case insensitivity flag
 217
 218          elsif Attribute_Kind_Of (Current_Attribute) in
 219                  Case_Insensitive_Associative_Array ..
 220                  Optional_Index_Case_Insensitive_Associative_Array
 221          then
 222             Set_Case_Insensitive (Attribute, In_Tree, To => True);
 223          end if;
 224
 225          Scan (In_Tree); --  past the attribute name
 226       end if;
 227
 228       --  Change obsolete names of attributes to the new names
 229
 230       if Current_Package /= Empty_Node
 231         and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored
 232       then
 233          case Name_Of (Attribute, In_Tree) is
 234          when Snames.Name_Specification =>
 235             Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec);
 236
 237          when Snames.Name_Specification_Suffix =>
 238             Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec_Suffix);
 239
 240          when Snames.Name_Implementation =>
 241             Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body);
 242
 243          when Snames.Name_Implementation_Suffix =>
 244             Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body_Suffix);
 245
 246          when others =>
 247             null;
 248          end case;
 249       end if;
 250
 251       --  Associative array attributes
 252
 253       if Token = Tok_Left_Paren then
 254
 255          --  If the attribute is not an associative array attribute, report
 256          --  an error. If this information is still unknown, set the kind
 257          --  to Associative_Array.
 258
 259          if Current_Attribute /= Empty_Attribute
 260            and then Attribute_Kind_Of (Current_Attribute) = Single
 261          then
 262             Error_Msg ("the attribute """ &
 263                        Get_Name_String
 264                           (Attribute_Name_Of (Current_Attribute)) &
 265                        """ cannot be an associative array",
 266                        Location_Of (Attribute, In_Tree));
 267
 268          elsif Attribute_Kind_Of (Current_Attribute) = Unknown then
 269             Set_Attribute_Kind_Of (Current_Attribute, To => Associative_Array);
 270          end if;
 271
 272          Scan (In_Tree); --  past the left parenthesis
 273          Expect (Tok_String_Literal, "literal string");
 274
 275          if Token = Tok_String_Literal then
 276             Set_Associative_Array_Index_Of (Attribute, In_Tree, Token_Name);
 277             Scan (In_Tree); --  past the literal string index
 278
 279             if Token = Tok_At then
 280                case Attribute_Kind_Of (Current_Attribute) is
 281                   when Optional_Index_Associative_Array |
 282                        Optional_Index_Case_Insensitive_Associative_Array =>
 283                      Scan (In_Tree);
 284                      Expect (Tok_Integer_Literal, "integer literal");
 285
 286                      if Token = Tok_Integer_Literal then
 287
 288                         --  Set the source index value from given literal
 289
 290                         declare
 291                            Index : constant Int :=
 292                                      UI_To_Int (Int_Literal_Value);
 293                         begin
 294                            if Index = 0 then
 295                               Error_Msg ("index cannot be zero", Token_Ptr);
 296                            else
 297                               Set_Source_Index_Of
 298                                 (Attribute, In_Tree, To => Index);
 299                            end if;
 300                         end;
 301
 302                         Scan (In_Tree);
 303                      end if;
 304
 305                   when others =>
 306                      Error_Msg ("index not allowed here", Token_Ptr);
 307                      Scan (In_Tree);
 308
 309                      if Token = Tok_Integer_Literal then
 310                         Scan (In_Tree);
 311                      end if;
 312                end case;
 313             end if;
 314          end if;
 315
 316          Expect (Tok_Right_Paren, "`)`");
 317
 318          if Token = Tok_Right_Paren then
 319             Scan (In_Tree); --  past the right parenthesis
 320          end if;
 321
 322       else
 323          --  If it is an associative array attribute and there are no left
 324          --  parenthesis, then this is a full associative array declaration.
 325          --  Flag it as such for later processing of its value.
 326
 327          if Current_Attribute /= Empty_Attribute
 328            and then
 329              Attribute_Kind_Of (Current_Attribute) /= Single
 330          then
 331             if Attribute_Kind_Of (Current_Attribute) = Unknown then
 332                Set_Attribute_Kind_Of (Current_Attribute, To => Single);
 333
 334             else
 335                Full_Associative_Array := True;
 336             end if;
 337          end if;
 338       end if;
 339
 340       --  Set the expression kind of the attribute
 341
 342       if Current_Attribute /= Empty_Attribute then
 343          Set_Expression_Kind_Of
 344            (Attribute, In_Tree, To => Variable_Kind_Of (Current_Attribute));
 345          Optional_Index := Optional_Index_Of (Current_Attribute);
 346       end if;
 347
 348       Expect (Tok_Use, "USE");
 349
 350       if Token = Tok_Use then
 351          Scan (In_Tree);
 352
 353          if Full_Associative_Array then
 354
 355             --  Expect <project>'<same_attribute_name>, or
 356             --  <project>.<same_package_name>'<same_attribute_name>
 357
 358             declare
 359                The_Project : Project_Node_Id := Empty_Node;
 360                --  The node of the project where the associative array is
 361                --  declared.
 362
 363                The_Package : Project_Node_Id := Empty_Node;
 364                --  The node of the package where the associative array is
 365                --  declared, if any.
 366
 367                Project_Name : Name_Id := No_Name;
 368                --  The name of the project where the associative array is
 369                --  declared.
 370
 371                Location : Source_Ptr := No_Location;
 372                --  The location of the project name
 373
 374             begin
 375                Expect (Tok_Identifier, "identifier");
 376
 377                if Token = Tok_Identifier then
 378                   Location := Token_Ptr;
 379
 380                   --  Find the project node in the imported project or
 381                   --  in the project being extended.
 382
 383                   The_Project := Imported_Or_Extended_Project_Of
 384                                    (Current_Project, In_Tree, Token_Name);
 385
 386                   if The_Project = Empty_Node then
 387                      Error_Msg ("unknown project", Location);
 388                      Scan (In_Tree); --  past the project name
 389
 390                   else
 391                      Project_Name := Token_Name;
 392                      Scan (In_Tree); --  past the project name
 393
 394                      --  If this is inside a package, a dot followed by the
 395                      --  name of the package must followed the project name.
 396
 397                      if Current_Package /= Empty_Node then
 398                         Expect (Tok_Dot, "`.`");
 399
 400                         if Token /= Tok_Dot then
 401                            The_Project := Empty_Node;
 402
 403                         else
 404                            Scan (In_Tree); --  past the dot
 405                            Expect (Tok_Identifier, "identifier");
 406
 407                            if Token /= Tok_Identifier then
 408                               The_Project := Empty_Node;
 409
 410                            --  If it is not the same package name, issue error
 411
 412                            elsif
 413                              Token_Name /= Name_Of (Current_Package, In_Tree)
 414                            then
 415                               The_Project := Empty_Node;
 416                               Error_Msg
 417                                 ("not the same package as " &
 418                                  Get_Name_String
 419                                    (Name_Of (Current_Package, In_Tree)),
 420                                  Token_Ptr);
 421
 422                            else
 423                               The_Package :=
 424                                 First_Package_Of (The_Project, In_Tree);
 425
 426                               --  Look for the package node
 427
 428                               while The_Package /= Empty_Node
 429                                 and then
 430                                 Name_Of (The_Package, In_Tree) /= Token_Name
 431                               loop
 432                                  The_Package :=
 433                                    Next_Package_In_Project
 434                                      (The_Package, In_Tree);
 435                               end loop;
 436
 437                               --  If the package cannot be found in the
 438                               --  project, issue an error.
 439
 440                               if The_Package = Empty_Node then
 441                                  The_Project := Empty_Node;
 442                                  Error_Msg_Name_2 := Project_Name;
 443                                  Error_Msg_Name_1 := Token_Name;
 444                                  Error_Msg
 445                                    ("package % not declared in project %",
 446                                    Token_Ptr);
 447                               end if;
 448
 449                               Scan (In_Tree); --  past the package name
 450                            end if;
 451                         end if;
 452                      end if;
 453                   end if;
 454                end if;
 455
 456                if The_Project /= Empty_Node then
 457
 458                   --  Looking for '<same attribute name>
 459
 460                   Expect (Tok_Apostrophe, "`''`");
 461
 462                   if Token /= Tok_Apostrophe then
 463                      The_Project := Empty_Node;
 464
 465                   else
 466                      Scan (In_Tree); --  past the apostrophe
 467                      Expect (Tok_Identifier, "identifier");
 468
 469                      if Token /= Tok_Identifier then
 470                         The_Project := Empty_Node;
 471
 472                      else
 473                         --  If it is not the same attribute name, issue error
 474
 475                         if Token_Name /= Attribute_Name then
 476                            The_Project := Empty_Node;
 477                            Error_Msg_Name_1 := Attribute_Name;
 478                            Error_Msg ("invalid name, should be %", Token_Ptr);
 479                         end if;
 480
 481                         Scan (In_Tree); --  past the attribute name
 482                      end if;
 483                   end if;
 484                end if;
 485
 486                if The_Project = Empty_Node then
 487
 488                   --  If there were any problem, set the attribute id to null,
 489                   --  so that the node will not be recorded.
 490
 491                   Current_Attribute := Empty_Attribute;
 492
 493                else
 494                   --  Set the appropriate field in the node.
 495                   --  Note that the index and the expression are nil. This
 496                   --  characterizes full associative array attribute
 497                   --  declarations.
 498
 499                   Set_Associative_Project_Of (Attribute, In_Tree, The_Project);
 500                   Set_Associative_Package_Of (Attribute, In_Tree, The_Package);
 501                end if;
 502             end;
 503
 504          --  Other attribute declarations (not full associative array)
 505
 506          else
 507             declare
 508                Expression_Location : constant Source_Ptr := Token_Ptr;
 509                --  The location of the first token of the expression
 510
 511                Expression          : Project_Node_Id     := Empty_Node;
 512                --  The expression, value for the attribute declaration
 513
 514             begin
 515                --  Get the expression value and set it in the attribute node
 516
 517                Parse_Expression
 518                  (In_Tree         => In_Tree,
 519                   Expression      => Expression,
 520                   Current_Project => Current_Project,
 521                   Current_Package => Current_Package,
 522                   Optional_Index  => Optional_Index);
 523                Set_Expression_Of (Attribute, In_Tree, To => Expression);
 524
 525                --  If the expression is legal, but not of the right kind
 526                --  for the attribute, issue an error.
 527
 528                if Current_Attribute /= Empty_Attribute
 529                  and then Expression /= Empty_Node
 530                  and then Variable_Kind_Of (Current_Attribute) /=
 531                  Expression_Kind_Of (Expression, In_Tree)
 532                then
 533                   if  Variable_Kind_Of (Current_Attribute) = Undefined then
 534                      Set_Variable_Kind_Of
 535                        (Current_Attribute,
 536                         To => Expression_Kind_Of (Expression, In_Tree));
 537
 538                   else
 539                      Error_Msg
 540                        ("wrong expression kind for attribute """ &
 541                         Get_Name_String
 542                           (Attribute_Name_Of (Current_Attribute)) &
 543                         """",
 544                         Expression_Location);
 545                   end if;
 546                end if;
 547             end;
 548          end if;
 549       end if;
 550
 551       --  If the attribute was not recognized, return an empty node.
 552       --  It may be that it is not in a package to check, and the node will
 553       --  not be added to the tree.
 554
 555       if Current_Attribute = Empty_Attribute then
 556          Attribute := Empty_Node;
 557       end if;
 558
 559       Set_End_Of_Line (Attribute);
 560       Set_Previous_Line_Node (Attribute);
 561    end Parse_Attribute_Declaration;
 562
 563    -----------------------------
 564    -- Parse_Case_Construction --
 565    -----------------------------
 566
 567    procedure Parse_Case_Construction
 568      (In_Tree           : Project_Node_Tree_Ref;
 569       Case_Construction : out Project_Node_Id;
 570       First_Attribute   : Attribute_Node_Id;
 571       Current_Project   : Project_Node_Id;
 572       Current_Package   : Project_Node_Id;
 573       Packages_To_Check : String_List_Access)
 574    is
 575       Current_Item    : Project_Node_Id := Empty_Node;
 576       Next_Item       : Project_Node_Id := Empty_Node;
 577       First_Case_Item : Boolean := True;
 578
 579       Variable_Location : Source_Ptr := No_Location;
 580
 581       String_Type : Project_Node_Id := Empty_Node;
 582
 583       Case_Variable : Project_Node_Id := Empty_Node;
 584
 585       First_Declarative_Item : Project_Node_Id := Empty_Node;
 586
 587       First_Choice           : Project_Node_Id := Empty_Node;
 588
 589       When_Others            : Boolean := False;
 590       --  Set to True when there is a "when others =>" clause
 591
 592    begin
 593       Case_Construction  :=
 594         Default_Project_Node
 595           (Of_Kind => N_Case_Construction, In_Tree => In_Tree);
 596       Set_Location_Of (Case_Construction, In_Tree, To => Token_Ptr);
 597
 598       --  Scan past "case"
 599
 600       Scan (In_Tree);
 601
 602       --  Get the switch variable
 603
 604       Expect (Tok_Identifier, "identifier");
 605
 606       if Token = Tok_Identifier then
 607          Variable_Location := Token_Ptr;
 608          Parse_Variable_Reference
 609            (In_Tree         => In_Tree,
 610             Variable        => Case_Variable,
 611             Current_Project => Current_Project,
 612             Current_Package => Current_Package);
 613          Set_Case_Variable_Reference_Of
 614            (Case_Construction, In_Tree, To => Case_Variable);
 615
 616       else
 617          if Token /= Tok_Is then
 618             Scan (In_Tree);
 619          end if;
 620       end if;
 621
 622       if Case_Variable /= Empty_Node then
 623          String_Type := String_Type_Of (Case_Variable, In_Tree);
 624
 625          if String_Type = Empty_Node then
 626             Error_Msg ("variable """ &
 627                        Get_Name_String (Name_Of (Case_Variable, In_Tree)) &
 628                        """ is not typed",
 629                        Variable_Location);
 630          end if;
 631       end if;
 632
 633       Expect (Tok_Is, "IS");
 634
 635       if Token = Tok_Is then
 636          Set_End_Of_Line (Case_Construction);
 637          Set_Previous_Line_Node (Case_Construction);
 638          Set_Next_End_Node (Case_Construction);
 639
 640          --  Scan past "is"
 641
 642          Scan (In_Tree);
 643       end if;
 644
 645       Start_New_Case_Construction (In_Tree, String_Type);
 646
 647       When_Loop :
 648
 649       while Token = Tok_When loop
 650
 651          if First_Case_Item then
 652             Current_Item :=
 653               Default_Project_Node
 654                 (Of_Kind => N_Case_Item, In_Tree => In_Tree);
 655             Set_First_Case_Item_Of
 656               (Case_Construction, In_Tree, To => Current_Item);
 657             First_Case_Item := False;
 658
 659          else
 660             Next_Item :=
 661               Default_Project_Node
 662                 (Of_Kind => N_Case_Item, In_Tree => In_Tree);
 663             Set_Next_Case_Item (Current_Item, In_Tree, To => Next_Item);
 664             Current_Item := Next_Item;
 665          end if;
 666
 667          Set_Location_Of (Current_Item, In_Tree, To => Token_Ptr);
 668
 669          --  Scan past "when"
 670
 671          Scan (In_Tree);
 672
 673          if Token = Tok_Others then
 674             When_Others := True;
 675
 676             --  Scan past "others"
 677
 678             Scan (In_Tree);
 679
 680             Expect (Tok_Arrow, "`=>`");
 681             Set_End_Of_Line (Current_Item);
 682             Set_Previous_Line_Node (Current_Item);
 683
 684             --  Empty_Node in Field1 of a Case_Item indicates
 685             --  the "when others =>" branch.
 686
 687             Set_First_Choice_Of (Current_Item, In_Tree, To => Empty_Node);
 688
 689             Parse_Declarative_Items
 690               (In_Tree           => In_Tree,
 691                Declarations      => First_Declarative_Item,
 692                In_Zone           => In_Case_Construction,
 693                First_Attribute   => First_Attribute,
 694                Current_Project   => Current_Project,
 695                Current_Package   => Current_Package,
 696                Packages_To_Check => Packages_To_Check);
 697
 698             --  "when others =>" must be the last branch, so save the
 699             --  Case_Item and exit
 700
 701             Set_First_Declarative_Item_Of
 702               (Current_Item, In_Tree, To => First_Declarative_Item);
 703             exit When_Loop;
 704
 705          else
 706             Parse_Choice_List
 707               (In_Tree      => In_Tree,
 708                First_Choice => First_Choice);
 709             Set_First_Choice_Of (Current_Item, In_Tree, To => First_Choice);
 710
 711             Expect (Tok_Arrow, "`=>`");
 712             Set_End_Of_Line (Current_Item);
 713             Set_Previous_Line_Node (Current_Item);
 714
 715             Parse_Declarative_Items
 716               (In_Tree           => In_Tree,
 717                Declarations      => First_Declarative_Item,
 718                In_Zone           => In_Case_Construction,
 719                First_Attribute   => First_Attribute,
 720                Current_Project   => Current_Project,
 721                Current_Package   => Current_Package,
 722                Packages_To_Check => Packages_To_Check);
 723
 724             Set_First_Declarative_Item_Of
 725               (Current_Item, In_Tree, To => First_Declarative_Item);
 726
 727          end if;
 728       end loop When_Loop;
 729
 730       End_Case_Construction
 731         (Check_All_Labels => not When_Others and not Quiet_Output,
 732          Case_Location    => Location_Of (Case_Construction, In_Tree));
 733
 734       Expect (Tok_End, "`END CASE`");
 735       Remove_Next_End_Node;
 736
 737       if Token = Tok_End then
 738
 739          --  Scan past "end"
 740
 741          Scan (In_Tree);
 742
 743          Expect (Tok_Case, "CASE");
 744
 745       end if;
 746
 747       --  Scan past "case"
 748
 749       Scan (In_Tree);
 750
 751       Expect (Tok_Semicolon, "`;`");
 752       Set_Previous_End_Node (Case_Construction);
 753
 754    end Parse_Case_Construction;
 755
 756    -----------------------------
 757    -- Parse_Declarative_Items --
 758    -----------------------------
 759
 760    procedure Parse_Declarative_Items
 761      (In_Tree           : Project_Node_Tree_Ref;
 762       Declarations      : out Project_Node_Id;
 763       In_Zone           : Zone;
 764       First_Attribute   : Attribute_Node_Id;
 765       Current_Project   : Project_Node_Id;
 766       Current_Package   : Project_Node_Id;
 767       Packages_To_Check : String_List_Access)
 768    is
 769       Current_Declarative_Item : Project_Node_Id := Empty_Node;
 770       Next_Declarative_Item    : Project_Node_Id := Empty_Node;
 771       Current_Declaration      : Project_Node_Id := Empty_Node;
 772       Item_Location            : Source_Ptr      := No_Location;
 773
 774    begin
 775       Declarations := Empty_Node;
 776
 777       loop
 778          --  We are always positioned at the token that precedes
 779          --  the first token of the declarative element.
 780          --  Scan past it
 781
 782          Scan (In_Tree);
 783
 784          Item_Location := Token_Ptr;
 785
 786          case Token is
 787             when Tok_Identifier =>
 788
 789                if In_Zone = In_Case_Construction then
 790                   Error_Msg ("a variable cannot be declared here",
 791                              Token_Ptr);
 792                end if;
 793
 794                Parse_Variable_Declaration
 795                  (In_Tree,
 796                   Current_Declaration,
 797                   Current_Project => Current_Project,
 798                   Current_Package => Current_Package);
 799
 800                Set_End_Of_Line (Current_Declaration);
 801                Set_Previous_Line_Node (Current_Declaration);
 802
 803             when Tok_For =>
 804
 805                Parse_Attribute_Declaration
 806                  (In_Tree           => In_Tree,
 807                   Attribute         => Current_Declaration,
 808                   First_Attribute   => First_Attribute,
 809                   Current_Project   => Current_Project,
 810                   Current_Package   => Current_Package,
 811                   Packages_To_Check => Packages_To_Check);
 812
 813                Set_End_Of_Line (Current_Declaration);
 814                Set_Previous_Line_Node (Current_Declaration);
 815
 816             when Tok_Null =>
 817
 818                Scan (In_Tree); --  past "null"
 819
 820             when Tok_Package =>
 821
 822                --  Package declaration
 823
 824                if In_Zone /= In_Project then
 825                   Error_Msg ("a package cannot be declared here", Token_Ptr);
 826                end if;
 827
 828                Parse_Package_Declaration
 829                  (In_Tree             => In_Tree,
 830                   Package_Declaration => Current_Declaration,
 831                   Current_Project     => Current_Project,
 832                   Packages_To_Check   => Packages_To_Check);
 833
 834                Set_Previous_End_Node (Current_Declaration);
 835
 836             when Tok_Type =>
 837
 838                --  Type String Declaration
 839
 840                if In_Zone /= In_Project then
 841                   Error_Msg ("a string type cannot be declared here",
 842                              Token_Ptr);
 843                end if;
 844
 845                Parse_String_Type_Declaration
 846                  (In_Tree         => In_Tree,
 847                   String_Type     => Current_Declaration,
 848                   Current_Project => Current_Project);
 849
 850                Set_End_Of_Line (Current_Declaration);
 851                Set_Previous_Line_Node (Current_Declaration);
 852
 853             when Tok_Case =>
 854
 855                --  Case construction
 856
 857                Parse_Case_Construction
 858                  (In_Tree           => In_Tree,
 859                   Case_Construction => Current_Declaration,
 860                   First_Attribute   => First_Attribute,
 861                   Current_Project   => Current_Project,
 862                   Current_Package   => Current_Package,
 863                   Packages_To_Check => Packages_To_Check);
 864
 865                Set_Previous_End_Node (Current_Declaration);
 866
 867             when others =>
 868                exit;
 869
 870                --  We are leaving Parse_Declarative_Items positionned
 871                --  at the first token after the list of declarative items.
 872                --  It could be "end" (for a project, a package declaration or
 873                --  a case construction) or "when" (for a case construction)
 874
 875          end case;
 876
 877          Expect (Tok_Semicolon, "`;` after declarative items");
 878
 879          --  Insert an N_Declarative_Item in the tree, but only if
 880          --  Current_Declaration is not an empty node.
 881
 882          if Current_Declaration /= Empty_Node then
 883             if Current_Declarative_Item = Empty_Node then
 884                Current_Declarative_Item :=
 885                  Default_Project_Node
 886                    (Of_Kind => N_Declarative_Item, In_Tree => In_Tree);
 887                Declarations  := Current_Declarative_Item;
 888
 889             else
 890                Next_Declarative_Item :=
 891                  Default_Project_Node
 892                    (Of_Kind => N_Declarative_Item, In_Tree => In_Tree);
 893                Set_Next_Declarative_Item
 894                  (Current_Declarative_Item, In_Tree,
 895                   To => Next_Declarative_Item);
 896                Current_Declarative_Item := Next_Declarative_Item;
 897             end if;
 898
 899             Set_Current_Item_Node
 900               (Current_Declarative_Item, In_Tree,
 901                To => Current_Declaration);
 902             Set_Location_Of
 903               (Current_Declarative_Item, In_Tree, To => Item_Location);
 904          end if;
 905       end loop;
 906    end Parse_Declarative_Items;
 907
 908    -------------------------------
 909    -- Parse_Package_Declaration --
 910    -------------------------------
 911
 912    procedure Parse_Package_Declaration
 913      (In_Tree             : Project_Node_Tree_Ref;
 914       Package_Declaration : out Project_Node_Id;
 915       Current_Project     : Project_Node_Id;
 916       Packages_To_Check   : String_List_Access)
 917    is
 918       First_Attribute        : Attribute_Node_Id := Empty_Attribute;
 919       Current_Package        : Package_Node_Id   := Empty_Package;
 920       First_Declarative_Item : Project_Node_Id   := Empty_Node;
 921
 922       Package_Location       : constant Source_Ptr := Token_Ptr;
 923
 924    begin
 925       Package_Declaration :=
 926         Default_Project_Node
 927           (Of_Kind => N_Package_Declaration, In_Tree => In_Tree);
 928       Set_Location_Of (Package_Declaration, In_Tree, To => Package_Location);
 929
 930       --  Scan past "package"
 931
 932       Scan (In_Tree);
 933       Expect (Tok_Identifier, "identifier");
 934
 935       if Token = Tok_Identifier then
 936          Set_Name_Of (Package_Declaration, In_Tree, To => Token_Name);
 937
 938          Current_Package := Package_Node_Id_Of (Token_Name);
 939
 940          if Current_Package  /= Empty_Package then
 941             First_Attribute := First_Attribute_Of (Current_Package);
 942
 943          else
 944             if not Quiet_Output then
 945                Error_Msg ("?""" &
 946                           Get_Name_String
 947                             (Name_Of (Package_Declaration, In_Tree)) &
 948                           """ is not a known package name",
 949                           Token_Ptr);
 950             end if;
 951
 952             --  Set the package declaration to "ignored" so that it is not
 953             --  processed by Prj.Proc.Process.
 954
 955             Set_Expression_Kind_Of (Package_Declaration, In_Tree, Ignored);
 956
 957             --  Add the unknown package in the list of packages
 958
 959             Add_Unknown_Package (Token_Name, Current_Package);
 960          end if;
 961
 962          Set_Package_Id_Of
 963            (Package_Declaration, In_Tree, To => Current_Package);
 964
 965          declare
 966             Current : Project_Node_Id :=
 967                         First_Package_Of (Current_Project, In_Tree);
 968
 969          begin
 970             while Current /= Empty_Node
 971               and then Name_Of (Current, In_Tree) /= Token_Name
 972             loop
 973                Current := Next_Package_In_Project (Current, In_Tree);
 974             end loop;
 975
 976             if Current /= Empty_Node then
 977                Error_Msg
 978                  ("package """ &
 979                   Get_Name_String (Name_Of (Package_Declaration, In_Tree)) &
 980                   """ is declared twice in the same project",
 981                   Token_Ptr);
 982
 983             else
 984                --  Add the package to the project list
 985
 986                Set_Next_Package_In_Project
 987                  (Package_Declaration, In_Tree,
 988                   To => First_Package_Of (Current_Project, In_Tree));
 989                Set_First_Package_Of
 990                  (Current_Project, In_Tree, To => Package_Declaration);
 991             end if;
 992          end;
 993
 994          --  Scan past the package name
 995
 996          Scan (In_Tree);
 997       end if;
 998
 999       if Token = Tok_Renames then
1000
1001          --  Scan past "renames"
1002
1003          Scan (In_Tree);
1004
1005          Expect (Tok_Identifier, "identifier");
1006
1007          if Token = Tok_Identifier then
1008             declare
1009                Project_Name : constant Name_Id := Token_Name;
1010
1011                Clause       : Project_Node_Id :=
1012                               First_With_Clause_Of (Current_Project, In_Tree);
1013                The_Project  : Project_Node_Id := Empty_Node;
1014                Extended     : constant Project_Node_Id :=
1015                                 Extended_Project_Of
1016                                   (Project_Declaration_Of
1017                                     (Current_Project, In_Tree),
1018                                    In_Tree);
1019             begin
1020                while Clause /= Empty_Node loop
1021                   --  Only non limited imported projects may be used in a
1022                   --  renames declaration.
1023
1024                   The_Project :=
1025                     Non_Limited_Project_Node_Of (Clause, In_Tree);
1026                   exit when The_Project /= Empty_Node
1027                     and then Name_Of (The_Project, In_Tree) = Project_Name;
1028                   Clause := Next_With_Clause_Of (Clause, In_Tree);
1029                end loop;
1030
1031                if Clause = Empty_Node then
1032                   --  As we have not found the project in the imports, we check
1033                   --  if it's the name of an eventual extended project.
1034
1035                   if Extended /= Empty_Node
1036                     and then Name_Of (Extended, In_Tree) = Project_Name
1037                   then
1038                      Set_Project_Of_Renamed_Package_Of
1039                        (Package_Declaration, In_Tree, To => Extended);
1040                   else
1041                      Error_Msg_Name_1 := Project_Name;
1042                      Error_Msg
1043                        ("% is not an imported or extended project", Token_Ptr);
1044                   end if;
1045                else
1046                   Set_Project_Of_Renamed_Package_Of
1047                     (Package_Declaration, In_Tree, To => The_Project);
1048                end if;
1049             end;
1050
1051             Scan (In_Tree);
1052             Expect (Tok_Dot, "`.`");
1053
1054             if Token = Tok_Dot then
1055                Scan (In_Tree);
1056                Expect (Tok_Identifier, "identifier");
1057
1058                if Token = Tok_Identifier then
1059                   if Name_Of (Package_Declaration, In_Tree) /= Token_Name then
1060                      Error_Msg ("not the same package name", Token_Ptr);
1061                   elsif
1062                     Project_Of_Renamed_Package_Of
1063                       (Package_Declaration, In_Tree) /= Empty_Node
1064                   then
1065                      declare
1066                         Current : Project_Node_Id :=
1067                                     First_Package_Of
1068                                       (Project_Of_Renamed_Package_Of
1069                                            (Package_Declaration, In_Tree),
1070                                        In_Tree);
1071
1072                      begin
1073                         while Current /= Empty_Node
1074                           and then Name_Of (Current, In_Tree) /= Token_Name
1075                         loop
1076                            Current :=
1077                              Next_Package_In_Project (Current, In_Tree);
1078                         end loop;
1079
1080                         if Current = Empty_Node then
1081                            Error_Msg
1082                              ("""" &
1083                               Get_Name_String (Token_Name) &
1084                               """ is not a package declared by the project",
1085                               Token_Ptr);
1086                         end if;
1087                      end;
1088                   end if;
1089
1090                   Scan (In_Tree);
1091                end if;
1092             end if;
1093          end if;
1094
1095          Expect (Tok_Semicolon, "`;`");
1096          Set_End_Of_Line (Package_Declaration);
1097          Set_Previous_Line_Node (Package_Declaration);
1098
1099       elsif Token = Tok_Is then
1100          Set_End_Of_Line (Package_Declaration);
1101          Set_Previous_Line_Node (Package_Declaration);
1102          Set_Next_End_Node (Package_Declaration);
1103
1104          Parse_Declarative_Items
1105            (In_Tree           => In_Tree,
1106             Declarations      => First_Declarative_Item,
1107             In_Zone           => In_Package,
1108             First_Attribute   => First_Attribute,
1109             Current_Project   => Current_Project,
1110             Current_Package   => Package_Declaration,
1111             Packages_To_Check => Packages_To_Check);
1112
1113          Set_First_Declarative_Item_Of
1114            (Package_Declaration, In_Tree, To => First_Declarative_Item);
1115
1116          Expect (Tok_End, "END");
1117
1118          if Token = Tok_End then
1119
1120             --  Scan past "end"
1121
1122             Scan (In_Tree);
1123          end if;
1124
1125          --  We should have the name of the package after "end"
1126
1127          Expect (Tok_Identifier, "identifier");
1128
1129          if Token = Tok_Identifier
1130            and then Name_Of (Package_Declaration, In_Tree) /= No_Name
1131            and then Token_Name /= Name_Of (Package_Declaration, In_Tree)
1132          then
1133             Error_Msg_Name_1 := Name_Of (Package_Declaration, In_Tree);
1134             Error_Msg ("expected {", Token_Ptr);
1135          end if;
1136
1137          if Token /= Tok_Semicolon then
1138
1139             --  Scan past the package name
1140
1141             Scan (In_Tree);
1142          end if;
1143
1144          Expect (Tok_Semicolon, "`;`");
1145          Remove_Next_End_Node;
1146
1147       else
1148          Error_Msg ("expected IS or RENAMES", Token_Ptr);
1149       end if;
1150
1151    end Parse_Package_Declaration;
1152
1153    -----------------------------------
1154    -- Parse_String_Type_Declaration --
1155    -----------------------------------
1156
1157    procedure Parse_String_Type_Declaration
1158      (In_Tree         : Project_Node_Tree_Ref;
1159       String_Type     : out Project_Node_Id;
1160       Current_Project : Project_Node_Id)
1161    is
1162       Current      : Project_Node_Id := Empty_Node;
1163       First_String : Project_Node_Id := Empty_Node;
1164
1165    begin
1166       String_Type :=
1167         Default_Project_Node
1168           (Of_Kind => N_String_Type_Declaration, In_Tree => In_Tree);
1169
1170       Set_Location_Of (String_Type, In_Tree, To => Token_Ptr);
1171
1172       --  Scan past "type"
1173
1174       Scan (In_Tree);
1175
1176       Expect (Tok_Identifier, "identifier");
1177
1178       if Token = Tok_Identifier then
1179          Set_Name_Of (String_Type, In_Tree, To => Token_Name);
1180
1181          Current := First_String_Type_Of (Current_Project, In_Tree);
1182          while Current /= Empty_Node
1183            and then
1184            Name_Of (Current, In_Tree) /= Token_Name
1185          loop
1186             Current := Next_String_Type (Current, In_Tree);
1187          end loop;
1188
1189          if Current /= Empty_Node then
1190             Error_Msg ("duplicate string type name """ &
1191                        Get_Name_String (Token_Name) &
1192                        """",
1193                        Token_Ptr);
1194          else
1195             Current := First_Variable_Of (Current_Project, In_Tree);
1196             while Current /= Empty_Node
1197               and then Name_Of (Current, In_Tree) /= Token_Name
1198             loop
1199                Current := Next_Variable (Current, In_Tree);
1200             end loop;
1201
1202             if Current /= Empty_Node then
1203                Error_Msg ("""" &
1204                           Get_Name_String (Token_Name) &
1205                           """ is already a variable name", Token_Ptr);
1206             else
1207                Set_Next_String_Type
1208                  (String_Type, In_Tree,
1209                   To => First_String_Type_Of (Current_Project, In_Tree));
1210                Set_First_String_Type_Of
1211                  (Current_Project, In_Tree, To => String_Type);
1212             end if;
1213          end if;
1214
1215          --  Scan past the name
1216
1217          Scan (In_Tree);
1218       end if;
1219
1220       Expect (Tok_Is, "IS");
1221
1222       if Token = Tok_Is then
1223          Scan (In_Tree);
1224       end if;
1225
1226       Expect (Tok_Left_Paren, "`(`");
1227
1228       if Token = Tok_Left_Paren then
1229          Scan (In_Tree);
1230       end if;
1231
1232       Parse_String_Type_List
1233         (In_Tree => In_Tree, First_String => First_String);
1234       Set_First_Literal_String (String_Type, In_Tree, To => First_String);
1235
1236       Expect (Tok_Right_Paren, "`)`");
1237
1238       if Token = Tok_Right_Paren then
1239          Scan (In_Tree);
1240       end if;
1241
1242    end Parse_String_Type_Declaration;
1243
1244    --------------------------------
1245    -- Parse_Variable_Declaration --
1246    --------------------------------
1247
1248    procedure Parse_Variable_Declaration
1249      (In_Tree         : Project_Node_Tree_Ref;
1250       Variable        : out Project_Node_Id;
1251       Current_Project : Project_Node_Id;
1252       Current_Package : Project_Node_Id)
1253    is
1254       Expression_Location      : Source_Ptr;
1255       String_Type_Name         : Name_Id := No_Name;
1256       Project_String_Type_Name : Name_Id := No_Name;
1257       Type_Location            : Source_Ptr := No_Location;
1258       Project_Location         : Source_Ptr := No_Location;
1259       Expression               : Project_Node_Id := Empty_Node;
1260       Variable_Name            : constant Name_Id := Token_Name;
1261       OK                       : Boolean := True;
1262
1263    begin
1264       Variable :=
1265         Default_Project_Node
1266           (Of_Kind => N_Variable_Declaration, In_Tree => In_Tree);
1267       Set_Name_Of (Variable, In_Tree, To => Variable_Name);
1268       Set_Location_Of (Variable, In_Tree, To => Token_Ptr);
1269
1270       --  Scan past the variable name
1271
1272       Scan (In_Tree);
1273
1274       if Token = Tok_Colon then
1275
1276          --  Typed string variable declaration
1277
1278          Scan (In_Tree);
1279          Set_Kind_Of (Variable, In_Tree, N_Typed_Variable_Declaration);
1280          Expect (Tok_Identifier, "identifier");
1281
1282          OK := Token = Tok_Identifier;
1283
1284          if OK then
1285             String_Type_Name := Token_Name;
1286             Type_Location := Token_Ptr;
1287             Scan (In_Tree);
1288
1289             if Token = Tok_Dot then
1290                Project_String_Type_Name := String_Type_Name;
1291                Project_Location := Type_Location;
1292
1293                --  Scan past the dot
1294
1295                Scan (In_Tree);
1296                Expect (Tok_Identifier, "identifier");
1297
1298                if Token = Tok_Identifier then
1299                   String_Type_Name := Token_Name;
1300                   Type_Location := Token_Ptr;
1301                   Scan (In_Tree);
1302                else
1303                   OK := False;
1304                end if;
1305             end if;
1306
1307             if OK then
1308                declare
1309                   Current : Project_Node_Id :=
1310                               First_String_Type_Of (Current_Project, In_Tree);
1311
1312                begin
1313                   if Project_String_Type_Name /= No_Name then
1314                      declare
1315                         The_Project_Name_And_Node : constant
1316                           Tree_Private_Part.Project_Name_And_Node :=
1317                           Tree_Private_Part.Projects_Htable.Get
1318                             (In_Tree.Projects_HT, Project_String_Type_Name);
1319
1320                         use Tree_Private_Part;
1321
1322                      begin
1323                         if The_Project_Name_And_Node =
1324                           Tree_Private_Part.No_Project_Name_And_Node
1325                         then
1326                            Error_Msg ("unknown project """ &
1327                                       Get_Name_String
1328                                          (Project_String_Type_Name) &
1329                                       """",
1330                                       Project_Location);
1331                            Current := Empty_Node;
1332                         else
1333                            Current :=
1334                              First_String_Type_Of
1335                                (The_Project_Name_And_Node.Node, In_Tree);
1336                         end if;
1337                      end;
1338                   end if;
1339
1340                   while Current /= Empty_Node
1341                     and then Name_Of (Current, In_Tree) /= String_Type_Name
1342                   loop
1343                      Current := Next_String_Type (Current, In_Tree);
1344                   end loop;
1345
1346                   if Current = Empty_Node then
1347                      Error_Msg ("unknown string type """ &
1348                                 Get_Name_String (String_Type_Name) &
1349                                 """",
1350                                 Type_Location);
1351                      OK := False;
1352                   else
1353                      Set_String_Type_Of
1354                        (Variable, In_Tree, To => Current);
1355                   end if;
1356                end;
1357             end if;
1358          end if;
1359       end if;
1360
1361       Expect (Tok_Colon_Equal, "`:=`");
1362
1363       OK := OK and (Token = Tok_Colon_Equal);
1364
1365       if Token = Tok_Colon_Equal then
1366          Scan (In_Tree);
1367       end if;
1368
1369       --  Get the single string or string list value
1370
1371       Expression_Location := Token_Ptr;
1372
1373       Parse_Expression
1374         (In_Tree         => In_Tree,
1375          Expression      => Expression,
1376          Current_Project => Current_Project,
1377          Current_Package => Current_Package,
1378          Optional_Index  => False);
1379       Set_Expression_Of (Variable, In_Tree, To => Expression);
1380
1381       if Expression /= Empty_Node then
1382          --  A typed string must have a single string value, not a list
1383
1384          if Kind_Of (Variable, In_Tree) = N_Typed_Variable_Declaration
1385            and then Expression_Kind_Of (Expression, In_Tree) = List
1386          then
1387             Error_Msg
1388               ("expression must be a single string", Expression_Location);
1389          end if;
1390
1391          Set_Expression_Kind_Of
1392            (Variable, In_Tree,
1393             To => Expression_Kind_Of (Expression, In_Tree));
1394       end if;
1395
1396       if OK then
1397          declare
1398             The_Variable : Project_Node_Id := Empty_Node;
1399
1400          begin
1401             if Current_Package /= Empty_Node then
1402                The_Variable := First_Variable_Of (Current_Package, In_Tree);
1403             elsif Current_Project /= Empty_Node then
1404                The_Variable :=  First_Variable_Of (Current_Project, In_Tree);
1405             end if;
1406
1407             while The_Variable /= Empty_Node
1408               and then Name_Of (The_Variable, In_Tree) /= Variable_Name
1409             loop
1410                The_Variable := Next_Variable (The_Variable, In_Tree);
1411             end loop;
1412
1413             if The_Variable = Empty_Node then
1414                if Current_Package /= Empty_Node then
1415                   Set_Next_Variable
1416                     (Variable, In_Tree,
1417                      To => First_Variable_Of (Current_Package, In_Tree));
1418                   Set_First_Variable_Of
1419                     (Current_Package, In_Tree, To => Variable);
1420
1421                elsif Current_Project /= Empty_Node then
1422                   Set_Next_Variable
1423                     (Variable, In_Tree,
1424                      To => First_Variable_Of (Current_Project, In_Tree));
1425                   Set_First_Variable_Of
1426                     (Current_Project, In_Tree, To => Variable);
1427                end if;
1428
1429             else
1430                if Expression_Kind_Of (Variable, In_Tree) /= Undefined then
1431                   if
1432                     Expression_Kind_Of (The_Variable, In_Tree) = Undefined
1433                   then
1434                      Set_Expression_Kind_Of
1435                        (The_Variable, In_Tree,
1436                         To => Expression_Kind_Of (Variable, In_Tree));
1437
1438                   else
1439                      if Expression_Kind_Of (The_Variable, In_Tree) /=
1440                        Expression_Kind_Of (Variable, In_Tree)
1441                      then
1442                         Error_Msg ("wrong expression kind for variable """ &
1443                                    Get_Name_String
1444                                      (Name_Of (The_Variable, In_Tree)) &
1445                                      """",
1446                                    Expression_Location);
1447                      end if;
1448                   end if;
1449                end if;
1450             end if;
1451          end;
1452       end if;
1453
1454    end Parse_Variable_Declaration;
1455
1456 end Prj.Dect;