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