gcc/ada/prj-part.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P R J . P A R 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 with Opt;      use Opt;
  28 with Osint;    use Osint;
  29 with Output;   use Output;
  30 with Prj.Com;  use Prj.Com;
  31 with Prj.Dect;
  32 with Prj.Err;  use Prj.Err;
  33 with Prj.Ext;  use Prj.Ext;
  34 with Sinput;   use Sinput;
  35 with Sinput.P; use Sinput.P;
  36 with Snames;
  37 with Table;
  38
  39 with Ada.Characters.Handling;    use Ada.Characters.Handling;
  40 with Ada.Exceptions;             use Ada.Exceptions;
  41
  42 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  43
  44 with System.HTable;              use System.HTable;
  45
  46 package body Prj.Part is
  47
  48    Buffer      : String_Access;
  49    Buffer_Last : Natural := 0;
  50
  51    Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
  52
  53    ------------------------------------
  54    -- Local Packages and Subprograms --
  55    ------------------------------------
  56
  57    type With_Id is new Nat;
  58    No_With : constant With_Id := 0;
  59
  60    type With_Record is record
  61       Path         : Path_Name_Type;
  62       Location     : Source_Ptr;
  63       Limited_With : Boolean;
  64       Node         : Project_Node_Id;
  65       Next         : With_Id;
  66    end record;
  67    --  Information about an imported project, to be put in table Withs below
  68
  69    package Withs is new Table.Table
  70      (Table_Component_Type => With_Record,
  71       Table_Index_Type     => With_Id,
  72       Table_Low_Bound      => 1,
  73       Table_Initial        => 10,
  74       Table_Increment      => 100,
  75       Table_Name           => "Prj.Part.Withs");
  76    --  Table used to store temporarily paths and locations of imported
  77    --  projects. These imported projects will be effectively parsed later: just
  78    --  before parsing the current project for the non limited withed projects,
  79    --  after getting its name; after complete parsing of the current project
  80    --  for the limited withed projects.
  81
  82    type Names_And_Id is record
  83       Path_Name           : Path_Name_Type;
  84       Canonical_Path_Name : Path_Name_Type;
  85       Id                  : Project_Node_Id;
  86       Limited_With        : Boolean;
  87    end record;
  88
  89    package Project_Stack is new Table.Table
  90      (Table_Component_Type => Names_And_Id,
  91       Table_Index_Type     => Nat,
  92       Table_Low_Bound      => 1,
  93       Table_Initial        => 10,
  94       Table_Increment      => 100,
  95       Table_Name           => "Prj.Part.Project_Stack");
  96    --  This table is used to detect circular dependencies
  97    --  for imported and extended projects and to get the project ids of
  98    --  limited imported projects when there is a circularity with at least
  99    --  one limited imported project file.
 100
 101    package Virtual_Hash is new System.HTable.Simple_HTable
 102      (Header_Num => Header_Num,
 103       Element    => Project_Node_Id,
 104       No_Element => Empty_Node,
 105       Key        => Project_Node_Id,
 106       Hash       => Prj.Tree.Hash,
 107       Equal      => "=");
 108    --  Hash table to store the node id of the project for which a virtual
 109    --  extending project need to be created.
 110
 111    package Processed_Hash is new System.HTable.Simple_HTable
 112      (Header_Num => Header_Num,
 113       Element    => Boolean,
 114       No_Element => False,
 115       Key        => Project_Node_Id,
 116       Hash       => Prj.Tree.Hash,
 117       Equal      => "=");
 118    --  Hash table to store the project process when looking for project that
 119    --  need to have a virtual extending project, to avoid processing the same
 120    --  project twice.
 121
 122    package Projects_Paths is new System.HTable.Simple_HTable
 123      (Header_Num => Header_Num,
 124       Element    => Path_Name_Type,
 125       No_Element => No_Path,
 126       Key        => Name_Id,
 127       Hash       => Hash,
 128       Equal      => "=");
 129    --  Hash table to cache project path to avoid looking for them on the path
 130
 131    procedure Create_Virtual_Extending_Project
 132      (For_Project  : Project_Node_Id;
 133       Main_Project : Project_Node_Id;
 134       In_Tree      : Project_Node_Tree_Ref);
 135    --  Create a virtual extending project of For_Project. Main_Project is
 136    --  the extending all project.
 137    --
 138    --  The String_Value_Of is not set for the automatically added with
 139    --  clause and keeps the default value of No_Name. This enables Prj.PP
 140    --  to skip these automatically added with clauses to be processed.
 141
 142    procedure Look_For_Virtual_Projects_For
 143      (Proj                : Project_Node_Id;
 144       In_Tree             : Project_Node_Tree_Ref;
 145       Potentially_Virtual : Boolean);
 146    --  Look for projects that need to have a virtual extending project.
 147    --  This procedure is recursive. If called with Potentially_Virtual set to
 148    --  True, then Proj may need an virtual extending project; otherwise it
 149    --  does not (because it is already extended), but other projects that it
 150    --  imports may need to be virtually extended.
 151
 152    type Extension_Origin is (None, Extending_Simple, Extending_All);
 153    --  Type of parameter From_Extended for procedures Parse_Single_Project and
 154    --  Post_Parse_Context_Clause. Extending_All means that we are parsing the
 155    --  tree rooted at an extending all project.
 156
 157    procedure Parse_Single_Project
 158      (In_Tree           : Project_Node_Tree_Ref;
 159       Project           : out Project_Node_Id;
 160       Extends_All       : out Boolean;
 161       Path_Name         : String;
 162       Extended          : Boolean;
 163       From_Extended     : Extension_Origin;
 164       In_Limited        : Boolean;
 165       Packages_To_Check : String_List_Access;
 166       Depth             : Natural;
 167       Current_Dir       : String);
 168    --  Parse a project file. This is a recursive procedure: it calls itself for
 169    --  imported and extended projects. When From_Extended is not None, if the
 170    --  project has already been parsed and is an extended project A, return the
 171    --  ultimate (not extended) project that extends A. When In_Limited is True,
 172    --  the importing path includes at least one "limited with". When parsing
 173    --  configuration projects, do not allow a depth > 1.
 174
 175    procedure Pre_Parse_Context_Clause
 176      (In_Tree        : Project_Node_Tree_Ref;
 177       Context_Clause : out With_Id);
 178    --  Parse the context clause of a project. Store the paths and locations of
 179    --  the imported projects in table Withs. Does nothing if there is no
 180    --  context clause (if the current token is not "with" or "limited" followed
 181    --  by "with").
 182
 183    procedure Post_Parse_Context_Clause
 184      (Context_Clause    : With_Id;
 185       In_Tree           : Project_Node_Tree_Ref;
 186       Limited_Withs     : Boolean;
 187       Imported_Projects : in out Project_Node_Id;
 188       Project_Directory : Path_Name_Type;
 189       From_Extended     : Extension_Origin;
 190       In_Limited        : Boolean;
 191       Packages_To_Check : String_List_Access;
 192       Depth             : Natural;
 193       Current_Dir       : String);
 194    --  Parse the imported projects that have been stored in table Withs, if
 195    --  any. From_Extended is used for the call to Parse_Single_Project below.
 196    --  When In_Limited is True, the importing path includes at least one
 197    --  "limited with". When Limited_Withs is False, only non limited withed
 198    --  projects are parsed. When Limited_Withs is True, only limited withed
 199    --  projects are parsed.
 200
 201    function Project_Path_Name_Of
 202      (Project_File_Name : String;
 203       Directory         : String) return String;
 204    --  Returns the path name of a project file. Returns an empty string
 205    --  if project file cannot be found.
 206
 207    function Immediate_Directory_Of
 208      (Path_Name : Path_Name_Type) return Path_Name_Type;
 209    --  Get the directory of the file with the specified path name.
 210    --  This includes the directory separator as the last character.
 211    --  Returns "./" if Path_Name contains no directory separator.
 212
 213    function Project_Name_From (Path_Name : String) return Name_Id;
 214    --  Returns the name of the project that corresponds to its path name.
 215    --  Returns No_Name if the path name is invalid, because the corresponding
 216    --  project name does not have the syntax of an ada identifier.
 217
 218    --------------------------------------
 219    -- Create_Virtual_Extending_Project --
 220    --------------------------------------
 221
 222    procedure Create_Virtual_Extending_Project
 223      (For_Project  : Project_Node_Id;
 224       Main_Project : Project_Node_Id;
 225       In_Tree      : Project_Node_Tree_Ref)
 226    is
 227
 228       Virtual_Name : constant String :=
 229                        Virtual_Prefix &
 230                          Get_Name_String (Name_Of (For_Project, In_Tree));
 231       --  The name of the virtual extending project
 232
 233       Virtual_Name_Id : Name_Id;
 234       --  Virtual extending project name id
 235
 236       Virtual_Path_Id : Path_Name_Type;
 237       --  Fake path name of the virtual extending project. The directory is
 238       --  the same directory as the extending all project.
 239
 240       Virtual_Dir_Id  : constant Path_Name_Type :=
 241         Immediate_Directory_Of (Path_Name_Of (Main_Project, In_Tree));
 242       --  The directory of the extending all project
 243
 244       --  The source of the virtual extending project is something like:
 245
 246       --  project V$<project name> extends <project path> is
 247
 248       --     for Source_Dirs use ();
 249
 250       --  end V$<project name>;
 251
 252       --  The project directory cannot be specified during parsing; it will be
 253       --  put directly in the virtual extending project data during processing.
 254
 255       --  Nodes that made up the virtual extending project
 256
 257       Virtual_Project         : constant Project_Node_Id :=
 258                                   Default_Project_Node
 259                                     (In_Tree, N_Project);
 260       With_Clause             : constant Project_Node_Id :=
 261                                   Default_Project_Node
 262                                     (In_Tree, N_With_Clause);
 263       Project_Declaration     : constant Project_Node_Id :=
 264                                   Default_Project_Node
 265                                     (In_Tree, N_Project_Declaration);
 266       Source_Dirs_Declaration : constant Project_Node_Id :=
 267                                   Default_Project_Node
 268                                     (In_Tree, N_Declarative_Item);
 269       Source_Dirs_Attribute   : constant Project_Node_Id :=
 270                                   Default_Project_Node
 271                                     (In_Tree, N_Attribute_Declaration, List);
 272       Source_Dirs_Expression  : constant Project_Node_Id :=
 273                                   Default_Project_Node
 274                                     (In_Tree, N_Expression, List);
 275       Source_Dirs_Term        : constant Project_Node_Id :=
 276                                   Default_Project_Node
 277                                     (In_Tree, N_Term, List);
 278       Source_Dirs_List        : constant Project_Node_Id :=
 279                                   Default_Project_Node
 280                                     (In_Tree, N_Literal_String_List, List);
 281
 282    begin
 283       --  Get the virtual name id
 284
 285       Name_Len := Virtual_Name'Length;
 286       Name_Buffer (1 .. Name_Len) := Virtual_Name;
 287       Virtual_Name_Id := Name_Find;
 288
 289       --  Get the virtual path name
 290
 291       Get_Name_String (Path_Name_Of (Main_Project, In_Tree));
 292
 293       while Name_Len > 0
 294         and then Name_Buffer (Name_Len) /= Directory_Separator
 295         and then Name_Buffer (Name_Len) /= '/'
 296       loop
 297          Name_Len := Name_Len - 1;
 298       end loop;
 299
 300       Name_Buffer (Name_Len + 1 .. Name_Len + Virtual_Name'Length) :=
 301         Virtual_Name;
 302       Name_Len := Name_Len + Virtual_Name'Length;
 303       Virtual_Path_Id := Name_Find;
 304
 305       --  With clause
 306
 307       Set_Name_Of (With_Clause, In_Tree, Virtual_Name_Id);
 308       Set_Path_Name_Of (With_Clause, In_Tree, Virtual_Path_Id);
 309       Set_Project_Node_Of (With_Clause, In_Tree, Virtual_Project);
 310       Set_Next_With_Clause_Of
 311         (With_Clause, In_Tree, First_With_Clause_Of (Main_Project, In_Tree));
 312       Set_First_With_Clause_Of (Main_Project, In_Tree, With_Clause);
 313
 314       --  Virtual project node
 315
 316       Set_Name_Of (Virtual_Project, In_Tree, Virtual_Name_Id);
 317       Set_Path_Name_Of (Virtual_Project, In_Tree, Virtual_Path_Id);
 318       Set_Location_Of
 319         (Virtual_Project, In_Tree, Location_Of (Main_Project, In_Tree));
 320       Set_Directory_Of (Virtual_Project, In_Tree, Virtual_Dir_Id);
 321       Set_Project_Declaration_Of
 322         (Virtual_Project, In_Tree, Project_Declaration);
 323       Set_Extended_Project_Path_Of
 324         (Virtual_Project, In_Tree, Path_Name_Of (For_Project, In_Tree));
 325
 326       --  Project declaration
 327
 328       Set_First_Declarative_Item_Of
 329         (Project_Declaration, In_Tree, Source_Dirs_Declaration);
 330       Set_Extended_Project_Of (Project_Declaration, In_Tree, For_Project);
 331
 332       --  Source_Dirs declaration
 333
 334       Set_Current_Item_Node
 335         (Source_Dirs_Declaration, In_Tree, Source_Dirs_Attribute);
 336
 337       --  Source_Dirs attribute
 338
 339       Set_Name_Of (Source_Dirs_Attribute, In_Tree, Snames.Name_Source_Dirs);
 340       Set_Expression_Of
 341         (Source_Dirs_Attribute, In_Tree, Source_Dirs_Expression);
 342
 343       --  Source_Dirs expression
 344
 345       Set_First_Term (Source_Dirs_Expression, In_Tree, Source_Dirs_Term);
 346
 347       --  Source_Dirs term
 348
 349       Set_Current_Term (Source_Dirs_Term, In_Tree, Source_Dirs_List);
 350
 351       --  Source_Dirs empty list: nothing to do
 352
 353       --  Put virtual project into Projects_Htable
 354
 355       Prj.Tree.Tree_Private_Part.Projects_Htable.Set
 356         (T => In_Tree.Projects_HT,
 357          K => Virtual_Name_Id,
 358          E => (Name           => Virtual_Name_Id,
 359                Node           => Virtual_Project,
 360                Canonical_Path => No_Path,
 361                Extended       => False,
 362                Proj_Qualifier => Unspecified));
 363    end Create_Virtual_Extending_Project;
 364
 365    ----------------------------
 366    -- Immediate_Directory_Of --
 367    ----------------------------
 368
 369    function Immediate_Directory_Of
 370      (Path_Name : Path_Name_Type) return Path_Name_Type
 371    is
 372    begin
 373       Get_Name_String (Path_Name);
 374
 375       for Index in reverse 1 .. Name_Len loop
 376          if Name_Buffer (Index) = '/'
 377            or else Name_Buffer (Index) = Dir_Sep
 378          then
 379             --  Remove all chars after last directory separator from name
 380
 381             if Index > 1 then
 382                Name_Len := Index - 1;
 383
 384             else
 385                Name_Len := Index;
 386             end if;
 387
 388             return Name_Find;
 389          end if;
 390       end loop;
 391
 392       --  There is no directory separator in name. Return "./" or ".\"
 393
 394       Name_Len := 2;
 395       Name_Buffer (1) := '.';
 396       Name_Buffer (2) := Dir_Sep;
 397       return Name_Find;
 398    end Immediate_Directory_Of;
 399
 400    -----------------------------------
 401    -- Look_For_Virtual_Projects_For --
 402    -----------------------------------
 403
 404    procedure Look_For_Virtual_Projects_For
 405      (Proj                : Project_Node_Id;
 406       In_Tree             : Project_Node_Tree_Ref;
 407       Potentially_Virtual : Boolean)
 408    is
 409       Declaration : Project_Node_Id := Empty_Node;
 410       --  Node for the project declaration of Proj
 411
 412       With_Clause : Project_Node_Id := Empty_Node;
 413       --  Node for a with clause of Proj
 414
 415       Imported    : Project_Node_Id := Empty_Node;
 416       --  Node for a project imported by Proj
 417
 418       Extended    : Project_Node_Id := Empty_Node;
 419       --  Node for the eventual project extended by Proj
 420
 421    begin
 422       --  Nothing to do if Proj is not defined or if it has already been
 423       --  processed.
 424
 425       if Present (Proj) and then not Processed_Hash.Get (Proj) then
 426          --  Make sure the project will not be processed again
 427
 428          Processed_Hash.Set (Proj, True);
 429
 430          Declaration := Project_Declaration_Of (Proj, In_Tree);
 431
 432          if Present (Declaration) then
 433             Extended := Extended_Project_Of (Declaration, In_Tree);
 434          end if;
 435
 436          --  If this is a project that may need a virtual extending project
 437          --  and it is not itself an extending project, put it in the list.
 438
 439          if Potentially_Virtual and then No (Extended) then
 440             Virtual_Hash.Set (Proj, Proj);
 441          end if;
 442
 443          --  Now check the projects it imports
 444
 445          With_Clause := First_With_Clause_Of (Proj, In_Tree);
 446
 447          while Present (With_Clause) loop
 448             Imported := Project_Node_Of (With_Clause, In_Tree);
 449
 450             if Present (Imported) then
 451                Look_For_Virtual_Projects_For
 452                  (Imported, In_Tree, Potentially_Virtual => True);
 453             end if;
 454
 455             With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
 456          end loop;
 457
 458          --  Check also the eventual project extended by Proj. As this project
 459          --  is already extended, call recursively with Potentially_Virtual
 460          --  being False.
 461
 462          Look_For_Virtual_Projects_For
 463            (Extended, In_Tree, Potentially_Virtual => False);
 464       end if;
 465    end Look_For_Virtual_Projects_For;
 466
 467    -----------
 468    -- Parse --
 469    -----------
 470
 471    procedure Parse
 472      (In_Tree                : Project_Node_Tree_Ref;
 473       Project                : out Project_Node_Id;
 474       Project_File_Name      : String;
 475       Always_Errout_Finalize : Boolean;
 476       Packages_To_Check      : String_List_Access := All_Packages;
 477       Store_Comments         : Boolean := False;
 478       Current_Directory      : String := "")
 479    is
 480       Dummy : Boolean;
 481       pragma Warnings (Off, Dummy);
 482
 483       Real_Project_File_Name : String_Access :=
 484                                  Osint.To_Canonical_File_Spec
 485                                    (Project_File_Name);
 486
 487    begin
 488       if Real_Project_File_Name = null then
 489          Real_Project_File_Name := new String'(Project_File_Name);
 490       end if;
 491
 492       Project := Empty_Node;
 493
 494       Projects_Paths.Reset;
 495
 496       if Current_Verbosity >= Medium then
 497          Write_Str ("GPR_PROJECT_PATH=""");
 498          Write_Str (Project_Path);
 499          Write_Line ("""");
 500       end if;
 501
 502       declare
 503          Path_Name : constant String :=
 504                        Project_Path_Name_Of (Real_Project_File_Name.all,
 505                                              Directory   => Current_Directory);
 506
 507       begin
 508          Free (Real_Project_File_Name);
 509
 510          Prj.Err.Initialize;
 511          Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
 512          Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
 513
 514          --  Parse the main project file
 515
 516          if Path_Name = "" then
 517             Prj.Com.Fail
 518               ("project file """
 519                & Project_File_Name
 520                & """ not found in "
 521                & Project_Path);
 522             Project := Empty_Node;
 523             return;
 524          end if;
 525
 526          Parse_Single_Project
 527            (In_Tree           => In_Tree,
 528             Project           => Project,
 529             Extends_All       => Dummy,
 530             Path_Name         => Path_Name,
 531             Extended          => False,
 532             From_Extended     => None,
 533             In_Limited        => False,
 534             Packages_To_Check => Packages_To_Check,
 535             Depth             => 0,
 536             Current_Dir       => Current_Directory);
 537
 538          --  If Project is an extending-all project, create the eventual
 539          --  virtual extending projects and check that there are no illegally
 540          --  imported projects.
 541
 542          if Present (Project)
 543            and then Is_Extending_All (Project, In_Tree)
 544          then
 545             --  First look for projects that potentially need a virtual
 546             --  extending project.
 547
 548             Virtual_Hash.Reset;
 549             Processed_Hash.Reset;
 550
 551             --  Mark the extending all project as processed, to avoid checking
 552             --  the imported projects in case of a "limited with" on this
 553             --  extending all project.
 554
 555             Processed_Hash.Set (Project, True);
 556
 557             declare
 558                Declaration : constant Project_Node_Id :=
 559                                Project_Declaration_Of (Project, In_Tree);
 560             begin
 561                Look_For_Virtual_Projects_For
 562                  (Extended_Project_Of (Declaration, In_Tree), In_Tree,
 563                   Potentially_Virtual => False);
 564             end;
 565
 566             --  Now, check the projects directly imported by the main project.
 567             --  Remove from the potentially virtual any project extended by one
 568             --  of these imported projects. For non extending imported
 569             --  projects, check that they do not belong to the project tree of
 570             --  the project being "extended-all" by the main project.
 571
 572             declare
 573                With_Clause : Project_Node_Id;
 574                Imported    : Project_Node_Id := Empty_Node;
 575                Declaration : Project_Node_Id := Empty_Node;
 576
 577             begin
 578                With_Clause := First_With_Clause_Of (Project, In_Tree);
 579                while Present (With_Clause) loop
 580                   Imported := Project_Node_Of (With_Clause, In_Tree);
 581
 582                   if Present (Imported) then
 583                      Declaration := Project_Declaration_Of (Imported, In_Tree);
 584
 585                      if Extended_Project_Of (Declaration, In_Tree) /=
 586                                Empty_Node
 587                      then
 588                         loop
 589                            Imported :=
 590                              Extended_Project_Of (Declaration, In_Tree);
 591                            exit when No (Imported);
 592                            Virtual_Hash.Remove (Imported);
 593                            Declaration :=
 594                              Project_Declaration_Of (Imported, In_Tree);
 595                         end loop;
 596                      end if;
 597                   end if;
 598
 599                   With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
 600                end loop;
 601             end;
 602
 603             --  Now create all the virtual extending projects
 604
 605             declare
 606                Proj : Project_Node_Id := Virtual_Hash.Get_First;
 607             begin
 608                while Present (Proj) loop
 609                   Create_Virtual_Extending_Project (Proj, Project, In_Tree);
 610                   Proj := Virtual_Hash.Get_Next;
 611                end loop;
 612             end;
 613          end if;
 614
 615          --  If there were any kind of error during the parsing, serious
 616          --  or not, then the parsing fails.
 617
 618          if Err_Vars.Total_Errors_Detected > 0 then
 619             Project := Empty_Node;
 620          end if;
 621
 622          if No (Project) or else Always_Errout_Finalize then
 623             Prj.Err.Finalize;
 624          end if;
 625       end;
 626
 627    exception
 628       when X : others =>
 629
 630          --  Internal error
 631
 632          Write_Line (Exception_Information (X));
 633          Write_Str  ("Exception ");
 634          Write_Str  (Exception_Name (X));
 635          Write_Line (" raised, while processing project file");
 636          Project := Empty_Node;
 637    end Parse;
 638
 639    ------------------------------
 640    -- Pre_Parse_Context_Clause --
 641    ------------------------------
 642
 643    procedure Pre_Parse_Context_Clause
 644      (In_Tree        : Project_Node_Tree_Ref;
 645       Context_Clause : out With_Id)
 646    is
 647       Current_With_Clause : With_Id := No_With;
 648       Limited_With        : Boolean := False;
 649       Current_With        : With_Record;
 650       Current_With_Node   : Project_Node_Id := Empty_Node;
 651
 652    begin
 653       --  Assume no context clause
 654
 655       Context_Clause := No_With;
 656       With_Loop :
 657
 658       --  If Token is not WITH or LIMITED, there is no context clause, or we
 659       --  have exhausted the with clauses.
 660
 661       while Token = Tok_With or else Token = Tok_Limited loop
 662          Current_With_Node :=
 663            Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree);
 664          Limited_With := Token = Tok_Limited;
 665
 666          if In_Configuration then
 667             Error_Msg
 668               ("configuration project cannot import " &
 669                "other configuration projects",
 670                Token_Ptr);
 671          end if;
 672
 673          if Limited_With then
 674             Scan (In_Tree);  --  scan past LIMITED
 675             Expect (Tok_With, "WITH");
 676             exit With_Loop when Token /= Tok_With;
 677          end if;
 678
 679          Comma_Loop :
 680          loop
 681             Scan (In_Tree); -- past WITH or ","
 682
 683             Expect (Tok_String_Literal, "literal string");
 684
 685             if Token /= Tok_String_Literal then
 686                return;
 687             end if;
 688
 689             --  Store path and location in table Withs
 690
 691             Current_With :=
 692               (Path         => Path_Name_Type (Token_Name),
 693                Location     => Token_Ptr,
 694                Limited_With => Limited_With,
 695                Node         => Current_With_Node,
 696                Next         => No_With);
 697
 698             Withs.Increment_Last;
 699             Withs.Table (Withs.Last) := Current_With;
 700
 701             if Current_With_Clause = No_With then
 702                Context_Clause := Withs.Last;
 703
 704             else
 705                Withs.Table (Current_With_Clause).Next := Withs.Last;
 706             end if;
 707
 708             Current_With_Clause := Withs.Last;
 709
 710             Scan (In_Tree);
 711
 712             if Token = Tok_Semicolon then
 713                Set_End_Of_Line (Current_With_Node);
 714                Set_Previous_Line_Node (Current_With_Node);
 715
 716                --  End of (possibly multiple) with clause;
 717
 718                Scan (In_Tree); -- past the semicolon
 719                exit Comma_Loop;
 720
 721             elsif Token = Tok_Comma then
 722                Set_Is_Not_Last_In_List (Current_With_Node, In_Tree);
 723
 724             else
 725                Error_Msg ("expected comma or semi colon", Token_Ptr);
 726                exit Comma_Loop;
 727             end if;
 728
 729             Current_With_Node :=
 730               Default_Project_Node
 731                 (Of_Kind => N_With_Clause, In_Tree => In_Tree);
 732          end loop Comma_Loop;
 733       end loop With_Loop;
 734    end Pre_Parse_Context_Clause;
 735
 736    -------------------------------
 737    -- Post_Parse_Context_Clause --
 738    -------------------------------
 739
 740    procedure Post_Parse_Context_Clause
 741      (Context_Clause    : With_Id;
 742       In_Tree           : Project_Node_Tree_Ref;
 743       Limited_Withs     : Boolean;
 744       Imported_Projects : in out Project_Node_Id;
 745       Project_Directory : Path_Name_Type;
 746       From_Extended     : Extension_Origin;
 747       In_Limited        : Boolean;
 748       Packages_To_Check : String_List_Access;
 749       Depth             : Natural;
 750       Current_Dir       : String)
 751    is
 752       Current_With_Clause : With_Id := Context_Clause;
 753
 754       Current_Project  : Project_Node_Id := Imported_Projects;
 755       Previous_Project : Project_Node_Id := Empty_Node;
 756       Next_Project     : Project_Node_Id := Empty_Node;
 757
 758       Project_Directory_Path : constant String :=
 759                                  Get_Name_String (Project_Directory);
 760
 761       Current_With : With_Record;
 762       Extends_All  : Boolean := False;
 763
 764    begin
 765       --  Set Current_Project to the last project in the current list, if the
 766       --  list is not empty.
 767
 768       if Present (Current_Project) then
 769          while
 770            Present (Next_With_Clause_Of (Current_Project, In_Tree))
 771          loop
 772             Current_Project := Next_With_Clause_Of (Current_Project, In_Tree);
 773          end loop;
 774       end if;
 775
 776       while Current_With_Clause /= No_With loop
 777          Current_With := Withs.Table (Current_With_Clause);
 778          Current_With_Clause := Current_With.Next;
 779
 780          if Limited_Withs = Current_With.Limited_With then
 781             declare
 782                Original_Path : constant String :=
 783                                  Get_Name_String (Current_With.Path);
 784
 785                Imported_Path_Name : constant String :=
 786                                       Project_Path_Name_Of
 787                                         (Original_Path,
 788                                          Project_Directory_Path);
 789
 790                Resolved_Path : constant String :=
 791                                  Normalize_Pathname
 792                                    (Imported_Path_Name,
 793                                     Directory      => Current_Dir,
 794                                     Resolve_Links  =>
 795                                       Opt.Follow_Links_For_Files,
 796                                     Case_Sensitive => True);
 797
 798                Withed_Project : Project_Node_Id := Empty_Node;
 799
 800             begin
 801                if Imported_Path_Name = "" then
 802
 803                   --  The project file cannot be found
 804
 805                   Error_Msg_File_1 := File_Name_Type (Current_With.Path);
 806                   Error_Msg
 807                     ("unknown project file: {", Current_With.Location);
 808
 809                   --  If this is not imported by the main project file, display
 810                   --  the import path.
 811
 812                   if Project_Stack.Last > 1 then
 813                      for Index in reverse 1 .. Project_Stack.Last loop
 814                         Error_Msg_File_1 :=
 815                           File_Name_Type
 816                             (Project_Stack.Table (Index).Path_Name);
 817                         Error_Msg
 818                           ("\imported by {", Current_With.Location);
 819                      end loop;
 820                   end if;
 821
 822                else
 823                   --  New with clause
 824
 825                   Previous_Project := Current_Project;
 826
 827                   if No (Current_Project) then
 828
 829                      --  First with clause of the context clause
 830
 831                      Current_Project := Current_With.Node;
 832                      Imported_Projects := Current_Project;
 833
 834                   else
 835                      Next_Project := Current_With.Node;
 836                      Set_Next_With_Clause_Of
 837                        (Current_Project, In_Tree, Next_Project);
 838                      Current_Project := Next_Project;
 839                   end if;
 840
 841                   Set_String_Value_Of
 842                     (Current_Project,
 843                      In_Tree,
 844                      Name_Id (Current_With.Path));
 845                   Set_Location_Of
 846                     (Current_Project, In_Tree, Current_With.Location);
 847
 848                   --  If it is a limited with, check if we have a circularity.
 849                   --  If we have one, get the project id of the limited
 850                   --  imported project file, and do not parse it.
 851
 852                   if Limited_Withs and then Project_Stack.Last > 1 then
 853                      declare
 854                         Canonical_Path_Name : Path_Name_Type;
 855
 856                      begin
 857                         Name_Len := Resolved_Path'Length;
 858                         Name_Buffer (1 .. Name_Len) := Resolved_Path;
 859                         Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
 860                         Canonical_Path_Name := Name_Find;
 861
 862                         for Index in 1 .. Project_Stack.Last loop
 863                            if Project_Stack.Table (Index).Canonical_Path_Name =
 864                              Canonical_Path_Name
 865                            then
 866                               --  We have found the limited imported project,
 867                               --  get its project id, and do not parse it.
 868
 869                               Withed_Project := Project_Stack.Table (Index).Id;
 870                               exit;
 871                            end if;
 872                         end loop;
 873                      end;
 874                   end if;
 875
 876                   --  Parse the imported project, if its project id is unknown
 877
 878                   if No (Withed_Project) then
 879                      Parse_Single_Project
 880                        (In_Tree           => In_Tree,
 881                         Project           => Withed_Project,
 882                         Extends_All       => Extends_All,
 883                         Path_Name         => Imported_Path_Name,
 884                         Extended          => False,
 885                         From_Extended     => From_Extended,
 886                         In_Limited        => Limited_Withs,
 887                         Packages_To_Check => Packages_To_Check,
 888                         Depth             => Depth,
 889                         Current_Dir       => Current_Dir);
 890
 891                   else
 892                      Extends_All := Is_Extending_All (Withed_Project, In_Tree);
 893                   end if;
 894
 895                   if No (Withed_Project) then
 896
 897                      --  If parsing unsuccessful, remove the context clause
 898
 899                      Current_Project := Previous_Project;
 900
 901                      if No (Current_Project) then
 902                         Imported_Projects := Empty_Node;
 903
 904                      else
 905                         Set_Next_With_Clause_Of
 906                           (Current_Project, In_Tree, Empty_Node);
 907                      end if;
 908                   else
 909                      --  If parsing was successful, record project name and
 910                      --  path name in with clause
 911
 912                      Set_Project_Node_Of
 913                        (Node         => Current_Project,
 914                         In_Tree      => In_Tree,
 915                         To           => Withed_Project,
 916                         Limited_With => Current_With.Limited_With);
 917                      Set_Name_Of
 918                        (Current_Project,
 919                         In_Tree,
 920                         Name_Of (Withed_Project, In_Tree));
 921
 922                      Name_Len := Resolved_Path'Length;
 923                      Name_Buffer (1 .. Name_Len) := Resolved_Path;
 924                      Set_Path_Name_Of (Current_Project, In_Tree, Name_Find);
 925
 926                      if Extends_All then
 927                         Set_Is_Extending_All (Current_Project, In_Tree);
 928                      end if;
 929                   end if;
 930                end if;
 931             end;
 932          end if;
 933       end loop;
 934    end Post_Parse_Context_Clause;
 935
 936    --------------------------
 937    -- Parse_Single_Project --
 938    --------------------------
 939
 940    procedure Parse_Single_Project
 941      (In_Tree           : Project_Node_Tree_Ref;
 942       Project           : out Project_Node_Id;
 943       Extends_All       : out Boolean;
 944       Path_Name         : String;
 945       Extended          : Boolean;
 946       From_Extended     : Extension_Origin;
 947       In_Limited        : Boolean;
 948       Packages_To_Check : String_List_Access;
 949       Depth             : Natural;
 950       Current_Dir       : String)
 951    is
 952       Normed_Path_Name    : Path_Name_Type;
 953       Canonical_Path_Name : Path_Name_Type;
 954       Project_Directory   : Path_Name_Type;
 955       Project_Scan_State  : Saved_Project_Scan_State;
 956       Source_Index        : Source_File_Index;
 957
 958       Extending : Boolean := False;
 959
 960       Extended_Project : Project_Node_Id := Empty_Node;
 961
 962       A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
 963                                   Tree_Private_Part.Projects_Htable.Get_First
 964                                     (In_Tree.Projects_HT);
 965
 966       Name_From_Path  : constant Name_Id := Project_Name_From (Path_Name);
 967       Name_Of_Project : Name_Id := No_Name;
 968
 969       Duplicated : Boolean := False;
 970
 971       First_With        : With_Id;
 972       Imported_Projects : Project_Node_Id := Empty_Node;
 973
 974       use Tree_Private_Part;
 975
 976       Project_Comment_State : Tree.Comment_State;
 977
 978       Proj_Qualifier     : Project_Qualifier := Unspecified;
 979       Qualifier_Location : Source_Ptr;
 980
 981    begin
 982       Extends_All := False;
 983
 984       declare
 985          Normed_Path    : constant String := Normalize_Pathname
 986                             (Path_Name,
 987                              Directory      => Current_Dir,
 988                              Resolve_Links  => False,
 989                              Case_Sensitive => True);
 990          Canonical_Path : constant String := Normalize_Pathname
 991                             (Normed_Path,
 992                              Directory      => Current_Dir,
 993                              Resolve_Links  => Opt.Follow_Links_For_Files,
 994                              Case_Sensitive => False);
 995       begin
 996          Name_Len := Normed_Path'Length;
 997          Name_Buffer (1 .. Name_Len) := Normed_Path;
 998          Normed_Path_Name := Name_Find;
 999          Name_Len := Canonical_Path'Length;
1000          Name_Buffer (1 .. Name_Len) := Canonical_Path;
1001          Canonical_Path_Name := Name_Find;
1002       end;
1003
1004       --  Check for a circular dependency
1005
1006       for Index in reverse 1 .. Project_Stack.Last loop
1007          exit when Project_Stack.Table (Index).Limited_With;
1008
1009          if Canonical_Path_Name =
1010               Project_Stack.Table (Index).Canonical_Path_Name
1011          then
1012             Error_Msg ("circular dependency detected", Token_Ptr);
1013             Error_Msg_Name_1 := Name_Id (Normed_Path_Name);
1014             Error_Msg ("\  %% is imported by", Token_Ptr);
1015
1016             for Current in reverse 1 .. Project_Stack.Last loop
1017                Error_Msg_Name_1 :=
1018                  Name_Id (Project_Stack.Table (Current).Path_Name);
1019
1020                if Project_Stack.Table (Current).Canonical_Path_Name /=
1021                     Canonical_Path_Name
1022                then
1023                   Error_Msg
1024                     ("\  %% which itself is imported by", Token_Ptr);
1025
1026                else
1027                   Error_Msg ("\  %%", Token_Ptr);
1028                   exit;
1029                end if;
1030             end loop;
1031
1032             Project := Empty_Node;
1033             return;
1034          end if;
1035       end loop;
1036
1037       --  Put the new path name on the stack
1038
1039       Project_Stack.Append
1040         ((Path_Name           => Normed_Path_Name,
1041           Canonical_Path_Name => Canonical_Path_Name,
1042           Id                  => Empty_Node,
1043           Limited_With        => In_Limited));
1044
1045       --  Check if the project file has already been parsed
1046
1047       while
1048         A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
1049       loop
1050          if A_Project_Name_And_Node.Canonical_Path = Canonical_Path_Name then
1051             if Extended then
1052
1053                if A_Project_Name_And_Node.Extended then
1054                   if A_Project_Name_And_Node.Proj_Qualifier /= Dry then
1055                      Error_Msg
1056                        ("cannot extend the same project file several times",
1057                         Token_Ptr);
1058                   end if;
1059                else
1060                   Error_Msg
1061                     ("cannot extend an already imported project file",
1062                      Token_Ptr);
1063                end if;
1064
1065             elsif A_Project_Name_And_Node.Extended then
1066                Extends_All :=
1067                  Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree);
1068
1069                --  If the imported project is an extended project A, and we are
1070                --  in an extended project, replace A with the ultimate project
1071                --  extending A.
1072
1073                if From_Extended /= None then
1074                   declare
1075                      Decl : Project_Node_Id :=
1076                               Project_Declaration_Of
1077                                 (A_Project_Name_And_Node.Node, In_Tree);
1078
1079                      Prj  : Project_Node_Id :=
1080                               Extending_Project_Of (Decl, In_Tree);
1081
1082                   begin
1083                      loop
1084                         Decl := Project_Declaration_Of (Prj, In_Tree);
1085                         exit when Extending_Project_Of (Decl, In_Tree) =
1086                           Empty_Node;
1087                         Prj := Extending_Project_Of (Decl, In_Tree);
1088                      end loop;
1089
1090                      A_Project_Name_And_Node.Node := Prj;
1091                   end;
1092                else
1093                   Error_Msg
1094                     ("cannot import an already extended project file",
1095                      Token_Ptr);
1096                end if;
1097             end if;
1098
1099             Project := A_Project_Name_And_Node.Node;
1100             Project_Stack.Decrement_Last;
1101             return;
1102          end if;
1103
1104          A_Project_Name_And_Node :=
1105            Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT);
1106       end loop;
1107
1108       --  We never encountered this project file. Save the scan state, load the
1109       --  project file and start to scan it.
1110
1111       Save_Project_Scan_State (Project_Scan_State);
1112       Source_Index := Load_Project_File (Path_Name);
1113       Tree.Save (Project_Comment_State);
1114
1115       --  If we cannot find it, we stop
1116
1117       if Source_Index = No_Source_File then
1118          Project := Empty_Node;
1119          Project_Stack.Decrement_Last;
1120          return;
1121       end if;
1122
1123       Prj.Err.Scanner.Initialize_Scanner (Source_Index);
1124       Tree.Reset_State;
1125       Scan (In_Tree);
1126
1127       if not In_Configuration and then Name_From_Path = No_Name then
1128
1129          --  The project file name is not correct (no or bad extension, or not
1130          --  following Ada identifier's syntax).
1131
1132          Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
1133          Error_Msg ("?{ is not a valid path name for a project file",
1134                     Token_Ptr);
1135       end if;
1136
1137       if Current_Verbosity >= Medium then
1138          Write_Str  ("Parsing """);
1139          Write_Str  (Path_Name);
1140          Write_Char ('"');
1141          Write_Eol;
1142       end if;
1143
1144       Project_Directory := Immediate_Directory_Of (Normed_Path_Name);
1145
1146       --  Is there any imported project?
1147
1148       Pre_Parse_Context_Clause
1149         (In_Tree        => In_Tree,
1150          Context_Clause => First_With);
1151
1152       Project := Default_Project_Node
1153                    (Of_Kind => N_Project, In_Tree => In_Tree);
1154       Project_Stack.Table (Project_Stack.Last).Id := Project;
1155       Set_Directory_Of (Project, In_Tree, Project_Directory);
1156       Set_Path_Name_Of (Project, In_Tree,  Normed_Path_Name);
1157
1158       --  Check if there is a qualifier before the reserved word "project"
1159
1160       Qualifier_Location := Token_Ptr;
1161
1162       if Token = Tok_Abstract then
1163          Proj_Qualifier := Dry;
1164          Scan (In_Tree);
1165
1166       elsif Token = Tok_Identifier then
1167          case Token_Name is
1168             when Snames.Name_Standard =>
1169                Proj_Qualifier := Standard;
1170                Scan (In_Tree);
1171
1172             when Snames.Name_Aggregate =>
1173                Proj_Qualifier := Aggregate;
1174                Scan (In_Tree);
1175
1176                if Token = Tok_Identifier and then
1177                  Token_Name = Snames.Name_Library
1178                then
1179                   Proj_Qualifier := Aggregate_Library;
1180                   Scan (In_Tree);
1181                end if;
1182
1183             when Snames.Name_Library =>
1184                Proj_Qualifier := Library;
1185                Scan (In_Tree);
1186
1187             when Snames.Name_Configuration =>
1188                if not In_Configuration then
1189                   Error_Msg ("configuration projects cannot belong to a user" &
1190                              " project tree",
1191                              Token_Ptr);
1192                end if;
1193
1194                Scan (In_Tree);
1195
1196             when others =>
1197                null;
1198          end case;
1199       end if;
1200
1201       if Proj_Qualifier /= Unspecified then
1202          if In_Configuration then
1203             Error_Msg ("a configuration project cannot be qualified except " &
1204                        "as configuration project",
1205                        Qualifier_Location);
1206          end if;
1207
1208          Set_Project_Qualifier_Of (Project, In_Tree, Proj_Qualifier);
1209       end if;
1210
1211       Set_Location_Of (Project, In_Tree, Token_Ptr);
1212
1213       Expect (Tok_Project, "PROJECT");
1214
1215       --  Mark location of PROJECT token if present
1216
1217       if Token = Tok_Project then
1218          Scan (In_Tree); -- past PROJECT
1219          Set_Location_Of (Project, In_Tree, Token_Ptr);
1220       end if;
1221
1222       --  Clear the Buffer
1223
1224       Buffer_Last := 0;
1225       loop
1226          Expect (Tok_Identifier, "identifier");
1227
1228          --  If the token is not an identifier, clear the buffer before
1229          --  exiting to indicate that the name of the project is ill-formed.
1230
1231          if Token /= Tok_Identifier then
1232             Buffer_Last := 0;
1233             exit;
1234          end if;
1235
1236          --  Add the identifier name to the buffer
1237
1238          Get_Name_String (Token_Name);
1239          Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1240
1241          --  Scan past the identifier
1242
1243          Scan (In_Tree);
1244
1245          --  If we have a dot, add a dot to the Buffer and look for the next
1246          --  identifier.
1247
1248          exit when Token /= Tok_Dot;
1249          Add_To_Buffer (".", Buffer, Buffer_Last);
1250
1251          --  Scan past the dot
1252
1253          Scan (In_Tree);
1254       end loop;
1255
1256       --  See if this is an extending project
1257
1258       if Token = Tok_Extends then
1259
1260          if In_Configuration then
1261             Error_Msg
1262               ("extending configuration project not allowed", Token_Ptr);
1263          end if;
1264
1265          --  Make sure that gnatmake will use mapping files
1266
1267          Create_Mapping_File := True;
1268
1269          --  We are extending another project
1270
1271          Extending := True;
1272
1273          Scan (In_Tree); -- past EXTENDS
1274
1275          if Token = Tok_All then
1276             Extends_All := True;
1277             Set_Is_Extending_All (Project, In_Tree);
1278             Scan (In_Tree); --  scan past ALL
1279          end if;
1280       end if;
1281
1282       --  If the name is well formed, Buffer_Last is > 0
1283
1284       if Buffer_Last > 0 then
1285
1286          --  The Buffer contains the name of the project
1287
1288          Name_Len := Buffer_Last;
1289          Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
1290          Name_Of_Project := Name_Find;
1291          Set_Name_Of (Project, In_Tree, Name_Of_Project);
1292
1293          --  To get expected name of the project file, replace dots by dashes
1294
1295          Name_Len := Buffer_Last;
1296          Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
1297
1298          for Index in 1 .. Name_Len loop
1299             if Name_Buffer (Index) = '.' then
1300                Name_Buffer (Index) := '-';
1301             end if;
1302          end loop;
1303
1304          Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1305
1306          declare
1307             Expected_Name : constant Name_Id := Name_Find;
1308             Extension     : String_Access;
1309
1310          begin
1311             --  Output a warning if the actual name is not the expected name
1312
1313             if not In_Configuration
1314               and then (Name_From_Path /= No_Name)
1315               and then Expected_Name /= Name_From_Path
1316             then
1317                Error_Msg_Name_1 := Expected_Name;
1318
1319                if In_Configuration then
1320                   Extension := new String'(Config_Project_File_Extension);
1321
1322                else
1323                   Extension := new String'(Project_File_Extension);
1324                end if;
1325
1326                Error_Msg ("?file name does not match project name, " &
1327                           "should be `%%" & Extension.all & "`",
1328                           Token_Ptr);
1329             end if;
1330          end;
1331
1332          declare
1333             From_Ext : Extension_Origin := None;
1334
1335          begin
1336             --  Extending_All is always propagated
1337
1338             if From_Extended = Extending_All or else Extends_All then
1339                From_Ext := Extending_All;
1340
1341             --  Otherwise, From_Extended is set to Extending_Single if the
1342             --  current project is an extending project.
1343
1344             elsif Extended then
1345                From_Ext := Extending_Simple;
1346             end if;
1347
1348             Post_Parse_Context_Clause
1349               (In_Tree           => In_Tree,
1350                Context_Clause    => First_With,
1351                Limited_Withs     => False,
1352                Imported_Projects => Imported_Projects,
1353                Project_Directory => Project_Directory,
1354                From_Extended     => From_Ext,
1355                In_Limited        => In_Limited,
1356                Packages_To_Check => Packages_To_Check,
1357                Depth             => Depth + 1,
1358                Current_Dir       => Current_Dir);
1359             Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
1360          end;
1361
1362          if not In_Configuration then
1363             declare
1364                Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1365                                  Tree_Private_Part.Projects_Htable.Get_First
1366                                    (In_Tree.Projects_HT);
1367                Project_Name  : Name_Id := Name_And_Node.Name;
1368
1369             begin
1370                --  Check if we already have a project with this name
1371
1372                while Project_Name /= No_Name
1373                  and then Project_Name /= Name_Of_Project
1374                loop
1375                   Name_And_Node :=
1376                     Tree_Private_Part.Projects_Htable.Get_Next
1377                       (In_Tree.Projects_HT);
1378                   Project_Name := Name_And_Node.Name;
1379                end loop;
1380
1381                --  Report an error if we already have a project with this name
1382
1383                if Project_Name /= No_Name then
1384                   Duplicated := True;
1385                   Error_Msg_Name_1 := Project_Name;
1386                   Error_Msg
1387                     ("duplicate project name %%",
1388                      Location_Of (Project, In_Tree));
1389                   Error_Msg_Name_1 :=
1390                     Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
1391                   Error_Msg
1392                     ("\already in %%", Location_Of (Project, In_Tree));
1393                end if;
1394             end;
1395          end if;
1396
1397       end if;
1398
1399       if Extending then
1400          Expect (Tok_String_Literal, "literal string");
1401
1402          if Token = Tok_String_Literal then
1403             Set_Extended_Project_Path_Of
1404               (Project,
1405                In_Tree,
1406                Path_Name_Type (Token_Name));
1407
1408             declare
1409                Original_Path_Name : constant String :=
1410                                       Get_Name_String (Token_Name);
1411
1412                Extended_Project_Path_Name : constant String :=
1413                                               Project_Path_Name_Of
1414                                                 (Original_Path_Name,
1415                                                  Get_Name_String
1416                                                    (Project_Directory));
1417
1418             begin
1419                if Extended_Project_Path_Name = "" then
1420
1421                   --  We could not find the project file to extend
1422
1423                   Error_Msg_Name_1 := Token_Name;
1424
1425                   Error_Msg ("unknown project file: %%", Token_Ptr);
1426
1427                   --  If we are not in the main project file, display the
1428                   --  import path.
1429
1430                   if Project_Stack.Last > 1 then
1431                      Error_Msg_Name_1 :=
1432                        Name_Id
1433                          (Project_Stack.Table (Project_Stack.Last).Path_Name);
1434                      Error_Msg ("\extended by %%", Token_Ptr);
1435
1436                      for Index in reverse 1 .. Project_Stack.Last - 1 loop
1437                         Error_Msg_Name_1 :=
1438                           Name_Id
1439                             (Project_Stack.Table (Index).Path_Name);
1440                         Error_Msg ("\imported by %%", Token_Ptr);
1441                      end loop;
1442                   end if;
1443
1444                else
1445                   declare
1446                      From_Ext : Extension_Origin := None;
1447
1448                   begin
1449                      if From_Extended = Extending_All or else Extends_All then
1450                         From_Ext := Extending_All;
1451                      end if;
1452
1453                      Parse_Single_Project
1454                        (In_Tree           => In_Tree,
1455                         Project           => Extended_Project,
1456                         Extends_All       => Extends_All,
1457                         Path_Name         => Extended_Project_Path_Name,
1458                         Extended          => True,
1459                         From_Extended     => From_Ext,
1460                         In_Limited        => In_Limited,
1461                         Packages_To_Check => Packages_To_Check,
1462                         Depth             => Depth + 1,
1463                         Current_Dir       => Current_Dir);
1464                   end;
1465
1466                   if Present (Extended_Project) then
1467
1468                      --  A project that extends an extending-all project is
1469                      --  also an extending-all project.
1470
1471                      if Is_Extending_All (Extended_Project, In_Tree) then
1472                         Set_Is_Extending_All (Project, In_Tree);
1473                      end if;
1474
1475                      --  An abstract project can only extend an abstract
1476                      --  project, otherwise we may have an abstract project
1477                      --  with sources, if it inherits sources from the project
1478                      --  it extends.
1479
1480                      if Proj_Qualifier = Dry and then
1481                        Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
1482                      then
1483                         Error_Msg
1484                           ("an abstract project can only extend " &
1485                            "another abstract project",
1486                            Qualifier_Location);
1487                      end if;
1488                   end if;
1489                end if;
1490             end;
1491
1492             Scan (In_Tree); -- past the extended project path
1493          end if;
1494       end if;
1495
1496       --  Check that a non extending-all project does not import an
1497       --  extending-all project.
1498
1499       if not Is_Extending_All (Project, In_Tree) then
1500          declare
1501             With_Clause : Project_Node_Id :=
1502                             First_With_Clause_Of (Project, In_Tree);
1503             Imported    : Project_Node_Id := Empty_Node;
1504
1505          begin
1506             With_Clause_Loop :
1507             while Present (With_Clause) loop
1508                Imported := Project_Node_Of (With_Clause, In_Tree);
1509
1510                if Is_Extending_All (With_Clause, In_Tree) then
1511                   Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
1512                   Error_Msg ("cannot import extending-all project %%",
1513                              Token_Ptr);
1514                   exit With_Clause_Loop;
1515                end if;
1516
1517                With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1518             end loop With_Clause_Loop;
1519          end;
1520       end if;
1521
1522       --  Check that a project with a name including a dot either imports
1523       --  or extends the project whose name precedes the last dot.
1524
1525       if Name_Of_Project /= No_Name then
1526          Get_Name_String (Name_Of_Project);
1527
1528       else
1529          Name_Len := 0;
1530       end if;
1531
1532       --  Look for the last dot
1533
1534       while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop
1535          Name_Len := Name_Len - 1;
1536       end loop;
1537
1538       --  If a dot was find, check if the parent project is imported
1539       --  or extended.
1540
1541       if Name_Len > 0 then
1542          Name_Len := Name_Len - 1;
1543
1544          declare
1545             Parent_Name  : constant Name_Id := Name_Find;
1546             Parent_Found : Boolean := False;
1547             Parent_Node  : Project_Node_Id := Empty_Node;
1548             With_Clause  : Project_Node_Id :=
1549                              First_With_Clause_Of (Project, In_Tree);
1550
1551          begin
1552             --  If there is an extended project, check its name
1553
1554             if Present (Extended_Project) then
1555                Parent_Node := Extended_Project;
1556                Parent_Found :=
1557                  Name_Of (Extended_Project, In_Tree) = Parent_Name;
1558             end if;
1559
1560             --  If the parent project is not the extended project,
1561             --  check each imported project until we find the parent project.
1562
1563             while not Parent_Found and then Present (With_Clause) loop
1564                Parent_Node := Project_Node_Of (With_Clause, In_Tree);
1565                Parent_Found := Name_Of (Parent_Node, In_Tree) = Parent_Name;
1566                With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1567             end loop;
1568
1569             if Parent_Found then
1570                Set_Parent_Project_Of (Project, In_Tree, To => Parent_Node);
1571
1572             else
1573                --  If the parent project was not found, report an error
1574
1575                Error_Msg_Name_1 := Name_Of_Project;
1576                Error_Msg_Name_2 := Parent_Name;
1577                Error_Msg ("project %% does not import or extend project %%",
1578                           Location_Of (Project, In_Tree));
1579             end if;
1580          end;
1581       end if;
1582
1583       Expect (Tok_Is, "IS");
1584       Set_End_Of_Line (Project);
1585       Set_Previous_Line_Node (Project);
1586       Set_Next_End_Node (Project);
1587
1588       declare
1589          Project_Declaration : Project_Node_Id := Empty_Node;
1590
1591       begin
1592          --  No need to Scan past "is", Prj.Dect.Parse will do it
1593
1594          Prj.Dect.Parse
1595            (In_Tree           => In_Tree,
1596             Declarations      => Project_Declaration,
1597             Current_Project   => Project,
1598             Extends           => Extended_Project,
1599             Packages_To_Check => Packages_To_Check);
1600          Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
1601
1602          if Present (Extended_Project)
1603            and then Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
1604          then
1605             Set_Extending_Project_Of
1606               (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,
1607                To => Project);
1608          end if;
1609       end;
1610
1611       Expect (Tok_End, "END");
1612       Remove_Next_End_Node;
1613
1614       --  Skip "end" if present
1615
1616       if Token = Tok_End then
1617          Scan (In_Tree);
1618       end if;
1619
1620       --  Clear the Buffer
1621
1622       Buffer_Last := 0;
1623
1624       --  Store the name following "end" in the Buffer. The name may be made of
1625       --  several simple names.
1626
1627       loop
1628          Expect (Tok_Identifier, "identifier");
1629
1630          --  If we don't have an identifier, clear the buffer before exiting to
1631          --  avoid checking the name.
1632
1633          if Token /= Tok_Identifier then
1634             Buffer_Last := 0;
1635             exit;
1636          end if;
1637
1638          --  Add the identifier to the Buffer
1639          Get_Name_String (Token_Name);
1640          Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1641
1642          --  Scan past the identifier
1643
1644          Scan (In_Tree);
1645          exit when Token /= Tok_Dot;
1646          Add_To_Buffer (".", Buffer, Buffer_Last);
1647          Scan (In_Tree);
1648       end loop;
1649
1650       --  If we have a valid name, check if it is the name of the project
1651
1652       if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
1653          if To_Lower (Buffer (1 .. Buffer_Last)) /=
1654             Get_Name_String (Name_Of (Project, In_Tree))
1655          then
1656             --  Invalid name: report an error
1657
1658             Error_Msg ("expected """ &
1659                        Get_Name_String (Name_Of (Project, In_Tree)) & """",
1660                        Token_Ptr);
1661          end if;
1662       end if;
1663
1664       Expect (Tok_Semicolon, "`;`");
1665
1666       --  Check that there is no more text following the end of the project
1667       --  source.
1668
1669       if Token = Tok_Semicolon then
1670          Set_Previous_End_Node (Project);
1671          Scan (In_Tree);
1672
1673          if Token /= Tok_EOF then
1674             Error_Msg
1675               ("unexpected text following end of project", Token_Ptr);
1676          end if;
1677       end if;
1678
1679       if not Duplicated and then Name_Of_Project /= No_Name then
1680
1681          --  Add the name of the project to the hash table, so that we can
1682          --  check that no other subsequent project will have the same name.
1683
1684          Tree_Private_Part.Projects_Htable.Set
1685            (T => In_Tree.Projects_HT,
1686             K => Name_Of_Project,
1687             E => (Name           => Name_Of_Project,
1688                   Node           => Project,
1689                   Canonical_Path => Canonical_Path_Name,
1690                   Extended       => Extended,
1691                   Proj_Qualifier => Proj_Qualifier));
1692       end if;
1693
1694       declare
1695          From_Ext : Extension_Origin := None;
1696
1697       begin
1698          --  Extending_All is always propagated
1699
1700          if From_Extended = Extending_All or else Extends_All then
1701             From_Ext := Extending_All;
1702
1703             --  Otherwise, From_Extended is set to Extending_Single if the
1704             --  current project is an extending project.
1705
1706          elsif Extended then
1707             From_Ext := Extending_Simple;
1708          end if;
1709
1710          Post_Parse_Context_Clause
1711            (In_Tree           => In_Tree,
1712             Context_Clause    => First_With,
1713             Limited_Withs     => True,
1714             Imported_Projects => Imported_Projects,
1715             Project_Directory => Project_Directory,
1716             From_Extended     => From_Ext,
1717             In_Limited        => In_Limited,
1718             Packages_To_Check => Packages_To_Check,
1719             Depth             => Depth + 1,
1720             Current_Dir       => Current_Dir);
1721          Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
1722       end;
1723
1724       --  Restore the scan state, in case we are not the main project
1725
1726       Restore_Project_Scan_State (Project_Scan_State);
1727
1728       --  And remove the project from the project stack
1729
1730       Project_Stack.Decrement_Last;
1731
1732       --  Indicate if there are unkept comments
1733
1734       Tree.Set_Project_File_Includes_Unkept_Comments
1735         (Node    => Project,
1736          In_Tree => In_Tree,
1737          To      => Tree.There_Are_Unkept_Comments);
1738
1739       --  And restore the comment state that was saved
1740
1741       Tree.Restore_And_Free (Project_Comment_State);
1742    end Parse_Single_Project;
1743
1744    -----------------------
1745    -- Project_Name_From --
1746    -----------------------
1747
1748    function Project_Name_From (Path_Name : String) return Name_Id is
1749       Canonical : String (1 .. Path_Name'Length) := Path_Name;
1750       First     : Natural := Canonical'Last;
1751       Last      : Natural := First;
1752       Index     : Positive;
1753
1754    begin
1755       if Current_Verbosity = High then
1756          Write_Str ("Project_Name_From (""");
1757          Write_Str (Canonical);
1758          Write_Line (""")");
1759       end if;
1760
1761       --  If the path name is empty, return No_Name to indicate failure
1762
1763       if First = 0 then
1764          return No_Name;
1765       end if;
1766
1767       Canonical_Case_File_Name (Canonical);
1768
1769       --  Look for the last dot in the path name
1770
1771       while First > 0
1772         and then
1773         Canonical (First) /= '.'
1774       loop
1775          First := First - 1;
1776       end loop;
1777
1778       --  If we have a dot, check that it is followed by the correct extension
1779
1780       if First > 0 and then Canonical (First) = '.' then
1781          if (not In_Configuration
1782               and then Canonical (First .. Last) = Project_File_Extension
1783               and then First /= 1)
1784            or else
1785              (In_Configuration
1786                and then
1787                  Canonical (First .. Last) = Config_Project_File_Extension
1788                and then First /= 1)
1789          then
1790             --  Look for the last directory separator, if any
1791
1792             First := First - 1;
1793             Last := First;
1794             while First > 0
1795               and then Canonical (First) /= '/'
1796               and then Canonical (First) /= Dir_Sep
1797             loop
1798                First := First - 1;
1799             end loop;
1800
1801          else
1802             --  Not the correct extension, return No_Name to indicate failure
1803
1804             return No_Name;
1805          end if;
1806
1807       --  If no dot in the path name, return No_Name to indicate failure
1808
1809       else
1810          return No_Name;
1811       end if;
1812
1813       First := First + 1;
1814
1815       --  If the extension is the file name, return No_Name to indicate failure
1816
1817       if First > Last then
1818          return No_Name;
1819       end if;
1820
1821       --  Put the name in lower case into Name_Buffer
1822
1823       Name_Len := Last - First + 1;
1824       Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
1825
1826       Index := 1;
1827
1828       --  Check if it is a well formed project name. Return No_Name if it is
1829       --  ill formed.
1830
1831       loop
1832          if not Is_Letter (Name_Buffer (Index)) then
1833             return No_Name;
1834
1835          else
1836             loop
1837                Index := Index + 1;
1838
1839                exit when Index >= Name_Len;
1840
1841                if Name_Buffer (Index) = '_' then
1842                   if Name_Buffer (Index + 1) = '_' then
1843                      return No_Name;
1844                   end if;
1845                end if;
1846
1847                exit when Name_Buffer (Index) = '-';
1848
1849                if Name_Buffer (Index) /= '_'
1850                  and then not Is_Alphanumeric (Name_Buffer (Index))
1851                then
1852                   return No_Name;
1853                end if;
1854
1855             end loop;
1856          end if;
1857
1858          if Index >= Name_Len then
1859             if Is_Alphanumeric (Name_Buffer (Name_Len)) then
1860
1861                --  All checks have succeeded. Return name in Name_Buffer
1862
1863                return Name_Find;
1864
1865             else
1866                return No_Name;
1867             end if;
1868
1869          elsif Name_Buffer (Index) = '-' then
1870             Index := Index + 1;
1871          end if;
1872       end loop;
1873    end Project_Name_From;
1874
1875    --------------------------
1876    -- Project_Path_Name_Of --
1877    --------------------------
1878
1879    function Project_Path_Name_Of
1880      (Project_File_Name : String;
1881       Directory         : String) return String
1882    is
1883
1884       function Try_Path_Name (Path : String) return String_Access;
1885       pragma Inline (Try_Path_Name);
1886       --  Try the specified Path
1887
1888       -------------------
1889       -- Try_Path_Name --
1890       -------------------
1891
1892       function Try_Path_Name (Path : String) return String_Access is
1893          Prj_Path : constant String := Project_Path;
1894          First    : Natural;
1895          Last     : Natural;
1896          Result   : String_Access := null;
1897
1898       begin
1899          if Current_Verbosity = High then
1900             Write_Str  ("   Trying ");
1901             Write_Line (Path);
1902          end if;
1903
1904          if Is_Absolute_Path (Path) then
1905             if Is_Regular_File (Path) then
1906                Result := new String'(Path);
1907             end if;
1908
1909          else
1910             --  Because we don't want to resolve symbolic links, we cannot use
1911             --  Locate_Regular_File. So, we try each possible path
1912             --  successively.
1913
1914             First := Prj_Path'First;
1915             while First <= Prj_Path'Last loop
1916                while First <= Prj_Path'Last
1917                  and then Prj_Path (First) = Path_Separator
1918                loop
1919                   First := First + 1;
1920                end loop;
1921
1922                exit when First > Prj_Path'Last;
1923
1924                Last := First;
1925                while Last < Prj_Path'Last
1926                  and then Prj_Path (Last + 1) /= Path_Separator
1927                loop
1928                   Last := Last + 1;
1929                end loop;
1930
1931                Name_Len := 0;
1932
1933                if not Is_Absolute_Path (Prj_Path (First .. Last)) then
1934                   Add_Str_To_Name_Buffer (Get_Current_Dir);
1935                   Add_Char_To_Name_Buffer (Directory_Separator);
1936                end if;
1937
1938                Add_Str_To_Name_Buffer (Prj_Path (First .. Last));
1939                Add_Char_To_Name_Buffer (Directory_Separator);
1940                Add_Str_To_Name_Buffer (Path);
1941
1942                if Is_Regular_File (Name_Buffer (1 .. Name_Len)) then
1943                   Result := new String'(Name_Buffer (1 .. Name_Len));
1944                   exit;
1945                end if;
1946
1947                First := Last + 1;
1948             end loop;
1949          end if;
1950
1951          return Result;
1952       end Try_Path_Name;
1953
1954       --  Local Declarations
1955
1956       Result    : String_Access;
1957       Result_Id : Path_Name_Type;
1958       Has_Dot   : Boolean := False;
1959       Key       : Name_Id;
1960
1961    --  Start of processing for Project_Path_Name_Of
1962
1963    begin
1964       if Current_Verbosity = High then
1965          Write_Str  ("Project_Path_Name_Of (""");
1966          Write_Str  (Project_File_Name);
1967          Write_Str  (""", """);
1968          Write_Str  (Directory);
1969          Write_Line (""");");
1970       end if;
1971
1972       --  Check the project cache
1973
1974       Name_Len := Project_File_Name'Length;
1975       Name_Buffer (1 .. Name_Len) := Project_File_Name;
1976       Key := Name_Find;
1977       Result_Id := Projects_Paths.Get (Key);
1978
1979       if Result_Id /= No_Path then
1980          return Get_Name_String (Result_Id);
1981       end if;
1982
1983       --  Check if Project_File_Name contains an extension (a dot before a
1984       --  directory separator). If it is the case we do not try project file
1985       --  with an added extension as it is not possible to have multiple dots
1986       --  on a project file name.
1987
1988       Check_Dot : for K in reverse Project_File_Name'Range loop
1989          if Project_File_Name (K) = '.' then
1990             Has_Dot := True;
1991             exit Check_Dot;
1992          end if;
1993
1994          exit Check_Dot when Project_File_Name (K) = Directory_Separator
1995            or else Project_File_Name (K) = '/';
1996       end loop Check_Dot;
1997
1998       if not Is_Absolute_Path (Project_File_Name) then
1999
2000          --  First we try <directory>/<file_name>.<extension>
2001
2002          if not Has_Dot then
2003             Result := Try_Path_Name
2004               (Directory & Directory_Separator &
2005                Project_File_Name & Project_File_Extension);
2006          end if;
2007
2008          --  Then we try <directory>/<file_name>
2009
2010          if Result = null then
2011             Result := Try_Path_Name
2012               (Directory & Directory_Separator & Project_File_Name);
2013          end if;
2014       end if;
2015
2016       --  Then we try <file_name>.<extension>
2017
2018       if Result = null and then not Has_Dot then
2019          Result := Try_Path_Name (Project_File_Name & Project_File_Extension);
2020       end if;
2021
2022       --  Then we try <file_name>
2023
2024       if Result = null then
2025          Result := Try_Path_Name (Project_File_Name);
2026       end if;
2027
2028       --  If we cannot find the project file, we return an empty string
2029
2030       if Result = null then
2031          return "";
2032
2033       else
2034          declare
2035             Final_Result : constant String :=
2036                              GNAT.OS_Lib.Normalize_Pathname
2037                                (Result.all,
2038                                 Directory      => Directory,
2039                                 Resolve_Links  => False,
2040                                 Case_Sensitive => True);
2041          begin
2042             Free (Result);
2043             Name_Len := Final_Result'Length;
2044             Name_Buffer (1 .. Name_Len) := Final_Result;
2045             Result_Id := Name_Find;
2046
2047             Projects_Paths.Set (Key, Result_Id);
2048             return Final_Result;
2049          end;
2050       end if;
2051    end Project_Path_Name_Of;
2052
2053 end Prj.Part;