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