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