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