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