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