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