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