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