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