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