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