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,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Err_Vars; use Err_Vars;
  28 with Namet;    use Namet;
  29 with Opt;      use Opt;
  30 with Osint;    use Osint;
  31 with Output;   use Output;
  32 with Prj.Com;  use Prj.Com;
  33 with Prj.Dect;
  34 with Prj.Err;  use Prj.Err;
  35 with 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                Error_Msg ("expected comma or semi colon", Token_Ptr);
 672                exit Comma_Loop;
 673             end if;
 674
 675             Current_With_Node :=
 676               Default_Project_Node
 677                 (Of_Kind => N_With_Clause, In_Tree => In_Tree);
 678          end loop Comma_Loop;
 679       end loop With_Loop;
 680    end Pre_Parse_Context_Clause;
 681
 682
 683    -------------------------------
 684    -- Post_Parse_Context_Clause --
 685    -------------------------------
 686
 687    procedure Post_Parse_Context_Clause
 688      (Context_Clause    : With_Id;
 689       In_Tree           : Project_Node_Tree_Ref;
 690       Imported_Projects : out Project_Node_Id;
 691       Project_Directory : Name_Id;
 692       From_Extended     : Extension_Origin;
 693       In_Limited        : Boolean;
 694       Packages_To_Check : String_List_Access)
 695    is
 696       Current_With_Clause : With_Id := Context_Clause;
 697
 698       Current_Project  : Project_Node_Id := Empty_Node;
 699       Previous_Project : Project_Node_Id := Empty_Node;
 700       Next_Project     : Project_Node_Id := Empty_Node;
 701
 702       Project_Directory_Path : constant String :=
 703                                  Get_Name_String (Project_Directory);
 704
 705       Current_With : With_Record;
 706       Limited_With : Boolean := False;
 707       Extends_All  : Boolean := False;
 708
 709    begin
 710       Imported_Projects := Empty_Node;
 711
 712       while Current_With_Clause /= No_With loop
 713          Current_With := Withs.Table (Current_With_Clause);
 714          Current_With_Clause := Current_With.Next;
 715
 716          Limited_With := In_Limited or Current_With.Limited_With;
 717
 718          declare
 719             Original_Path : constant String :=
 720                               Get_Name_String (Current_With.Path);
 721
 722             Imported_Path_Name : constant String :=
 723                                    Project_Path_Name_Of
 724                                      (Original_Path, Project_Directory_Path);
 725
 726             Resolved_Path : constant String :=
 727                               Normalize_Pathname
 728                                 (Imported_Path_Name,
 729                                  Resolve_Links => True,
 730                                  Case_Sensitive => True);
 731
 732             Withed_Project : Project_Node_Id := Empty_Node;
 733
 734          begin
 735             if Imported_Path_Name = "" then
 736
 737                --  The project file cannot be found
 738
 739                Error_Msg_Name_1 := Current_With.Path;
 740
 741                Error_Msg ("unknown project file: {", Current_With.Location);
 742
 743                --  If this is not imported by the main project file,
 744                --  display the import path.
 745
 746                if Project_Stack.Last > 1 then
 747                   for Index in reverse 1 .. Project_Stack.Last loop
 748                      Error_Msg_Name_1 := Project_Stack.Table (Index).Path_Name;
 749                      Error_Msg ("\imported by {", Current_With.Location);
 750                   end loop;
 751                end if;
 752
 753             else
 754                --  New with clause
 755
 756                Previous_Project := Current_Project;
 757
 758                if Current_Project = Empty_Node then
 759
 760                   --  First with clause of the context clause
 761
 762                   Current_Project := Current_With.Node;
 763                   Imported_Projects := Current_Project;
 764
 765                else
 766                   Next_Project := Current_With.Node;
 767                   Set_Next_With_Clause_Of
 768                     (Current_Project, In_Tree, Next_Project);
 769                   Current_Project := Next_Project;
 770                end if;
 771
 772                Set_String_Value_Of
 773                  (Current_Project, In_Tree, Current_With.Path);
 774                Set_Location_Of
 775                  (Current_Project, In_Tree, Current_With.Location);
 776
 777                --  If this is a "limited with", check if we have a circularity.
 778                --  If we have one, get the project id of the limited imported
 779                --  project file, and do not parse it.
 780
 781                if Limited_With and then Project_Stack.Last > 1 then
 782                   declare
 783                      Canonical_Path_Name : Name_Id;
 784
 785                   begin
 786                      Name_Len := Resolved_Path'Length;
 787                      Name_Buffer (1 .. Name_Len) := Resolved_Path;
 788                      Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
 789                      Canonical_Path_Name := Name_Find;
 790
 791                      for Index in 1 .. Project_Stack.Last loop
 792                         if Project_Stack.Table (Index).Canonical_Path_Name =
 793                              Canonical_Path_Name
 794                         then
 795                            --  We have found the limited imported project,
 796                            --  get its project id, and do not parse it.
 797
 798                            Withed_Project := Project_Stack.Table (Index).Id;
 799                            exit;
 800                         end if;
 801                      end loop;
 802                   end;
 803                end if;
 804
 805                --  Parse the imported project, if its project id is unknown
 806
 807                if Withed_Project = Empty_Node then
 808                   Parse_Single_Project
 809                     (In_Tree           => In_Tree,
 810                      Project           => Withed_Project,
 811                      Extends_All       => Extends_All,
 812                      Path_Name         => Imported_Path_Name,
 813                      Extended          => False,
 814                      From_Extended     => From_Extended,
 815                      In_Limited        => Limited_With,
 816                      Packages_To_Check => Packages_To_Check);
 817
 818                else
 819                   Extends_All := Is_Extending_All (Withed_Project, In_Tree);
 820                end if;
 821
 822                if Withed_Project = Empty_Node then
 823                   --  If parsing was not successful, remove the
 824                   --  context clause.
 825
 826                   Current_Project := Previous_Project;
 827
 828                   if Current_Project = Empty_Node then
 829                      Imported_Projects := Empty_Node;
 830
 831                   else
 832                      Set_Next_With_Clause_Of
 833                        (Current_Project, In_Tree, Empty_Node);
 834                   end if;
 835                else
 836                   --  If parsing was successful, record project name
 837                   --  and path name in with clause
 838
 839                   Set_Project_Node_Of
 840                     (Node         => Current_Project,
 841                      In_Tree      => In_Tree,
 842                      To           => Withed_Project,
 843                      Limited_With => Current_With.Limited_With);
 844                   Set_Name_Of
 845                     (Current_Project,
 846                      In_Tree,
 847                      Name_Of (Withed_Project, In_Tree));
 848
 849                   Name_Len := Resolved_Path'Length;
 850                   Name_Buffer (1 .. Name_Len) := Resolved_Path;
 851                   Set_Path_Name_Of (Current_Project, In_Tree, Name_Find);
 852
 853                   if Extends_All then
 854                      Set_Is_Extending_All (Current_Project, In_Tree);
 855                   end if;
 856                end if;
 857             end if;
 858          end;
 859       end loop;
 860    end Post_Parse_Context_Clause;
 861
 862    --------------------------
 863    -- Parse_Single_Project --
 864    --------------------------
 865
 866    procedure Parse_Single_Project
 867      (In_Tree           : Project_Node_Tree_Ref;
 868       Project           : out Project_Node_Id;
 869       Extends_All       : out Boolean;
 870       Path_Name         : String;
 871       Extended          : Boolean;
 872       From_Extended     : Extension_Origin;
 873       In_Limited        : Boolean;
 874       Packages_To_Check : String_List_Access)
 875    is
 876       Normed_Path_Name    : Name_Id;
 877       Canonical_Path_Name : Name_Id;
 878       Project_Directory   : Name_Id;
 879       Project_Scan_State  : Saved_Project_Scan_State;
 880       Source_Index        : Source_File_Index;
 881
 882       Extending : Boolean := False;
 883
 884       Extended_Project    : Project_Node_Id := Empty_Node;
 885
 886       A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
 887                                   Tree_Private_Part.Projects_Htable.Get_First
 888                                     (In_Tree.Projects_HT);
 889
 890       Name_From_Path : constant Name_Id := Project_Name_From (Path_Name);
 891
 892       Name_Of_Project : Name_Id := No_Name;
 893
 894       First_With : With_Id;
 895
 896       use Tree_Private_Part;
 897
 898       Project_Comment_State : Tree.Comment_State;
 899
 900    begin
 901       Extends_All := False;
 902
 903       declare
 904          Normed_Path    : constant String := Normalize_Pathname
 905                             (Path_Name, Resolve_Links => False,
 906                              Case_Sensitive           => True);
 907          Canonical_Path : constant String := Normalize_Pathname
 908                             (Normed_Path, Resolve_Links => True,
 909                              Case_Sensitive             => False);
 910
 911       begin
 912          Name_Len := Normed_Path'Length;
 913          Name_Buffer (1 .. Name_Len) := Normed_Path;
 914          Normed_Path_Name := Name_Find;
 915          Name_Len := Canonical_Path'Length;
 916          Name_Buffer (1 .. Name_Len) := Canonical_Path;
 917          Canonical_Path_Name := Name_Find;
 918       end;
 919
 920       --  Check for a circular dependency
 921
 922       for Index in 1 .. Project_Stack.Last loop
 923          if Canonical_Path_Name =
 924               Project_Stack.Table (Index).Canonical_Path_Name
 925          then
 926             Error_Msg ("circular dependency detected", Token_Ptr);
 927             Error_Msg_Name_1 := Normed_Path_Name;
 928             Error_Msg ("\  { is imported by", Token_Ptr);
 929
 930             for Current in reverse 1 .. Project_Stack.Last loop
 931                Error_Msg_Name_1 := Project_Stack.Table (Current).Path_Name;
 932
 933                if Project_Stack.Table (Current).Canonical_Path_Name /=
 934                     Canonical_Path_Name
 935                then
 936                   Error_Msg
 937                     ("\  { which itself is imported by", Token_Ptr);
 938
 939                else
 940                   Error_Msg ("\  {", Token_Ptr);
 941                   exit;
 942                end if;
 943             end loop;
 944
 945             Project := Empty_Node;
 946             return;
 947          end if;
 948       end loop;
 949
 950       --  Put the new path name on the stack
 951
 952       Project_Stack.Increment_Last;
 953       Project_Stack.Table (Project_Stack.Last).Path_Name := Normed_Path_Name;
 954       Project_Stack.Table (Project_Stack.Last).Canonical_Path_Name :=
 955         Canonical_Path_Name;
 956
 957       --  Check if the project file has already been parsed
 958
 959       while
 960         A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
 961       loop
 962          if A_Project_Name_And_Node.Canonical_Path = Canonical_Path_Name then
 963             if Extended then
 964
 965                if A_Project_Name_And_Node.Extended then
 966                   Error_Msg
 967                     ("cannot extend the same project file several times",
 968                      Token_Ptr);
 969                else
 970                   Error_Msg
 971                     ("cannot extend an already imported project file",
 972                      Token_Ptr);
 973                end if;
 974
 975             elsif A_Project_Name_And_Node.Extended then
 976                Extends_All :=
 977                  Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree);
 978
 979                --  If the imported project is an extended project A,
 980                --  and we are in an extended project, replace A with the
 981                --  ultimate project extending A.
 982
 983                if From_Extended /= None then
 984                   declare
 985                      Decl : Project_Node_Id :=
 986                               Project_Declaration_Of
 987                                 (A_Project_Name_And_Node.Node, In_Tree);
 988
 989                      Prj  : Project_Node_Id :=
 990                               Extending_Project_Of (Decl, In_Tree);
 991
 992                   begin
 993                      loop
 994                         Decl := Project_Declaration_Of (Prj, In_Tree);
 995                         exit when Extending_Project_Of (Decl, In_Tree) =
 996                           Empty_Node;
 997                         Prj := Extending_Project_Of (Decl, In_Tree);
 998                      end loop;
 999
1000                      A_Project_Name_And_Node.Node := Prj;
1001                   end;
1002                else
1003                   Error_Msg
1004                     ("cannot import an already extended project file",
1005                      Token_Ptr);
1006                end if;
1007             end if;
1008
1009             Project := A_Project_Name_And_Node.Node;
1010             Project_Stack.Decrement_Last;
1011             return;
1012          end if;
1013
1014          A_Project_Name_And_Node :=
1015            Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT);
1016       end loop;
1017
1018       --  We never encountered this project file
1019       --  Save the scan state, load the project file and start to scan it.
1020
1021       Save_Project_Scan_State (Project_Scan_State);
1022       Source_Index := Load_Project_File (Path_Name);
1023       Tree.Save (Project_Comment_State);
1024
1025       --  If we cannot find it, we stop
1026
1027       if Source_Index = No_Source_File then
1028          Project := Empty_Node;
1029          Project_Stack.Decrement_Last;
1030          return;
1031       end if;
1032
1033       Prj.Err.Scanner.Initialize_Scanner (Types.No_Unit, Source_Index);
1034       Tree.Reset_State;
1035       Scan (In_Tree);
1036
1037       if Name_From_Path = No_Name then
1038
1039          --  The project file name is not correct (no or bad extension,
1040          --  or not following Ada identifier's syntax).
1041
1042          Error_Msg_Name_1 := Canonical_Path_Name;
1043          Error_Msg ("?{ is not a valid path name for a project file",
1044                     Token_Ptr);
1045       end if;
1046
1047       if Current_Verbosity >= Medium then
1048          Write_Str  ("Parsing """);
1049          Write_Str  (Path_Name);
1050          Write_Char ('"');
1051          Write_Eol;
1052       end if;
1053
1054       --  Is there any imported project?
1055
1056       Pre_Parse_Context_Clause (In_Tree, First_With);
1057
1058       Project_Directory := Immediate_Directory_Of (Normed_Path_Name);
1059       Project := Default_Project_Node
1060                    (Of_Kind => N_Project, In_Tree => In_Tree);
1061       Project_Stack.Table (Project_Stack.Last).Id := Project;
1062       Set_Directory_Of (Project, In_Tree, Project_Directory);
1063       Set_Path_Name_Of (Project, In_Tree,  Normed_Path_Name);
1064       Set_Location_Of (Project, In_Tree, Token_Ptr);
1065
1066       Expect (Tok_Project, "PROJECT");
1067
1068       --  Mark location of PROJECT token if present
1069
1070       if Token = Tok_Project then
1071          Scan (In_Tree); -- scan past PROJECT
1072          Set_Location_Of (Project, In_Tree, Token_Ptr);
1073       end if;
1074
1075       --  Clear the Buffer
1076
1077       Buffer_Last := 0;
1078       loop
1079          Expect (Tok_Identifier, "identifier");
1080
1081          --  If the token is not an identifier, clear the buffer before
1082          --  exiting to indicate that the name of the project is ill-formed.
1083
1084          if Token /= Tok_Identifier then
1085             Buffer_Last := 0;
1086             exit;
1087          end if;
1088
1089          --  Add the identifier name to the buffer
1090
1091          Get_Name_String (Token_Name);
1092          Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1093
1094          --  Scan past the identifier
1095
1096          Scan (In_Tree);
1097
1098          --  If we have a dot, add a dot the the Buffer and look for the next
1099          --  identifier.
1100
1101          exit when Token /= Tok_Dot;
1102          Add_To_Buffer (".", Buffer, Buffer_Last);
1103
1104          --  Scan past the dot
1105
1106          Scan (In_Tree);
1107       end loop;
1108
1109       --  See if this is an extending project
1110
1111       if Token = Tok_Extends then
1112
1113          --  Make sure that gnatmake will use mapping files
1114
1115          Create_Mapping_File := True;
1116
1117          --  We are extending another project
1118
1119          Extending := True;
1120
1121          Scan (In_Tree); -- scan past EXTENDS
1122
1123          if Token = Tok_All then
1124             Extends_All := True;
1125             Set_Is_Extending_All (Project, In_Tree);
1126             Scan (In_Tree); --  scan past ALL
1127          end if;
1128       end if;
1129
1130       --  If the name is well formed, Buffer_Last is > 0
1131
1132       if Buffer_Last > 0 then
1133
1134          --  The Buffer contains the name of the project
1135
1136          Name_Len := Buffer_Last;
1137          Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
1138          Name_Of_Project := Name_Find;
1139          Set_Name_Of (Project, In_Tree, Name_Of_Project);
1140
1141          --  To get expected name of the project file, replace dots by dashes
1142
1143          Name_Len := Buffer_Last;
1144          Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
1145
1146          for Index in 1 .. Name_Len loop
1147             if Name_Buffer (Index) = '.' then
1148                Name_Buffer (Index) := '-';
1149             end if;
1150          end loop;
1151
1152          Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1153
1154          declare
1155             Expected_Name : constant Name_Id := Name_Find;
1156
1157          begin
1158             --  Output a warning if the actual name is not the expected name
1159
1160             if Name_From_Path /= No_Name
1161               and then Expected_Name /= Name_From_Path
1162             then
1163                Error_Msg_Name_1 := Expected_Name;
1164                Error_Msg ("?file name does not match unit name, " &
1165                           "should be `{" & Project_File_Extension & "`",
1166                           Token_Ptr);
1167             end if;
1168          end;
1169
1170          declare
1171             Imported_Projects : Project_Node_Id := Empty_Node;
1172             From_Ext : Extension_Origin := None;
1173
1174          begin
1175             --  Extending_All is always propagated
1176
1177             if From_Extended = Extending_All or else Extends_All then
1178                From_Ext := Extending_All;
1179
1180             --  Otherwise, From_Extended is set to Extending_Single if the
1181             --  current project is an extending project.
1182
1183             elsif Extended then
1184                From_Ext := Extending_Simple;
1185             end if;
1186
1187             Post_Parse_Context_Clause
1188               (In_Tree           => In_Tree,
1189                Context_Clause    => First_With,
1190                Imported_Projects => Imported_Projects,
1191                Project_Directory => Project_Directory,
1192                From_Extended     => From_Ext,
1193                In_Limited        => In_Limited,
1194                Packages_To_Check => Packages_To_Check);
1195             Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
1196          end;
1197
1198          declare
1199             Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1200               Tree_Private_Part.Projects_Htable.Get_First
1201                 (In_Tree.Projects_HT);
1202             Project_Name : Name_Id := Name_And_Node.Name;
1203
1204          begin
1205             --  Check if we already have a project with this name
1206
1207             while Project_Name /= No_Name
1208               and then Project_Name /= Name_Of_Project
1209             loop
1210                Name_And_Node :=
1211                  Tree_Private_Part.Projects_Htable.Get_Next
1212                    (In_Tree.Projects_HT);
1213                Project_Name := Name_And_Node.Name;
1214             end loop;
1215
1216             --  Report an error if we already have a project with this name
1217
1218             if Project_Name /= No_Name then
1219                Error_Msg_Name_1 := Project_Name;
1220                Error_Msg
1221                  ("duplicate project name {", Location_Of (Project, In_Tree));
1222                Error_Msg_Name_1 :=
1223                  Path_Name_Of (Name_And_Node.Node, In_Tree);
1224                Error_Msg
1225                  ("\already in {", Location_Of (Project, In_Tree));
1226
1227             else
1228                --  Otherwise, add the name of the project to the hash table, so
1229                --  that we can check that no other subsequent project will have
1230                --  the same name.
1231
1232                Tree_Private_Part.Projects_Htable.Set
1233                  (T => In_Tree.Projects_HT,
1234                   K => Name_Of_Project,
1235                   E => (Name           => Name_Of_Project,
1236                         Node           => Project,
1237                         Canonical_Path => Canonical_Path_Name,
1238                         Extended       => Extended));
1239             end if;
1240          end;
1241
1242       end if;
1243
1244       if Extending then
1245          Expect (Tok_String_Literal, "literal string");
1246
1247          if Token = Tok_String_Literal then
1248             Set_Extended_Project_Path_Of (Project, In_Tree, Token_Name);
1249
1250             declare
1251                Original_Path_Name : constant String :=
1252                                       Get_Name_String (Token_Name);
1253
1254                Extended_Project_Path_Name : constant String :=
1255                                               Project_Path_Name_Of
1256                                                 (Original_Path_Name,
1257                                                  Get_Name_String
1258                                                    (Project_Directory));
1259
1260             begin
1261                if Extended_Project_Path_Name = "" then
1262
1263                   --  We could not find the project file to extend
1264
1265                   Error_Msg_Name_1 := Token_Name;
1266
1267                   Error_Msg ("unknown project file: {", Token_Ptr);
1268
1269                   --  If we are not in the main project file, display the
1270                   --  import path.
1271
1272                   if Project_Stack.Last > 1 then
1273                      Error_Msg_Name_1 :=
1274                        Project_Stack.Table (Project_Stack.Last).Path_Name;
1275                      Error_Msg ("\extended by {", Token_Ptr);
1276
1277                      for Index in reverse 1 .. Project_Stack.Last - 1 loop
1278                         Error_Msg_Name_1 :=
1279                           Project_Stack.Table (Index).Path_Name;
1280                         Error_Msg ("\imported by {", Token_Ptr);
1281                      end loop;
1282                   end if;
1283
1284                else
1285                   declare
1286                      From_Ext : Extension_Origin := None;
1287
1288                   begin
1289                      if From_Extended = Extending_All or else Extends_All then
1290                         From_Ext := Extending_All;
1291                      end if;
1292
1293                      Parse_Single_Project
1294                        (In_Tree           => In_Tree,
1295                         Project           => Extended_Project,
1296                         Extends_All       => Extends_All,
1297                         Path_Name         => Extended_Project_Path_Name,
1298                         Extended          => True,
1299                         From_Extended     => From_Ext,
1300                         In_Limited        => In_Limited,
1301                         Packages_To_Check => Packages_To_Check);
1302                   end;
1303
1304                   --  A project that extends an extending-all project is also
1305                   --  an extending-all project.
1306
1307                   if Extended_Project /= Empty_Node
1308                     and then Is_Extending_All (Extended_Project, In_Tree)
1309                   then
1310                      Set_Is_Extending_All (Project, In_Tree);
1311                   end if;
1312                end if;
1313             end;
1314
1315             Scan (In_Tree); -- scan past the extended project path
1316          end if;
1317       end if;
1318
1319       --  Check that a non extending-all project does not import an
1320       --  extending-all project.
1321
1322       if not Is_Extending_All (Project, In_Tree) then
1323          declare
1324             With_Clause : Project_Node_Id :=
1325                             First_With_Clause_Of (Project, In_Tree);
1326             Imported    : Project_Node_Id := Empty_Node;
1327
1328          begin
1329             With_Clause_Loop :
1330             while With_Clause /= Empty_Node loop
1331                Imported := Project_Node_Of (With_Clause, In_Tree);
1332
1333                if Is_Extending_All (With_Clause, In_Tree) then
1334                   Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
1335                   Error_Msg ("cannot import extending-all project {",
1336                              Token_Ptr);
1337                   exit With_Clause_Loop;
1338                end if;
1339
1340                With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1341             end loop With_Clause_Loop;
1342          end;
1343       end if;
1344
1345       --  Check that a project with a name including a dot either imports
1346       --  or extends the project whose name precedes the last dot.
1347
1348       if Name_Of_Project /= No_Name then
1349          Get_Name_String (Name_Of_Project);
1350
1351       else
1352          Name_Len := 0;
1353       end if;
1354
1355       --  Look for the last dot
1356
1357       while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop
1358          Name_Len := Name_Len - 1;
1359       end loop;
1360
1361       --  If a dot was find, check if the parent project is imported
1362       --  or extended.
1363
1364       if Name_Len > 0 then
1365          Name_Len := Name_Len - 1;
1366
1367          declare
1368             Parent_Name  : constant Name_Id := Name_Find;
1369             Parent_Found : Boolean := False;
1370             With_Clause  : Project_Node_Id :=
1371                              First_With_Clause_Of (Project, In_Tree);
1372
1373          begin
1374             --  If there is an extended project, check its name
1375
1376             if Extended_Project /= Empty_Node then
1377                Parent_Found :=
1378                  Name_Of (Extended_Project, In_Tree) = Parent_Name;
1379             end if;
1380
1381             --  If the parent project is not the extended project,
1382             --  check each imported project until we find the parent project.
1383
1384             while not Parent_Found and then With_Clause /= Empty_Node loop
1385                Parent_Found :=
1386                  Name_Of (Project_Node_Of (With_Clause, In_Tree), In_Tree) =
1387                     Parent_Name;
1388                With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1389             end loop;
1390
1391             --  If the parent project was not found, report an error
1392
1393             if not Parent_Found then
1394                Error_Msg_Name_1 := Name_Of_Project;
1395                Error_Msg_Name_2 := Parent_Name;
1396                Error_Msg ("project { does not import or extend project {",
1397                           Location_Of (Project, In_Tree));
1398             end if;
1399          end;
1400       end if;
1401
1402       Expect (Tok_Is, "IS");
1403       Set_End_Of_Line (Project);
1404       Set_Previous_Line_Node (Project);
1405       Set_Next_End_Node (Project);
1406
1407       declare
1408          Project_Declaration : Project_Node_Id := Empty_Node;
1409
1410       begin
1411          --  No need to Scan past "is", Prj.Dect.Parse will do it
1412
1413          Prj.Dect.Parse
1414            (In_Tree           => In_Tree,
1415             Declarations      => Project_Declaration,
1416             Current_Project   => Project,
1417             Extends           => Extended_Project,
1418             Packages_To_Check => Packages_To_Check);
1419          Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
1420
1421          if Extended_Project /= Empty_Node then
1422             Set_Extending_Project_Of
1423               (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,
1424                To => Project);
1425          end if;
1426       end;
1427
1428       Expect (Tok_End, "END");
1429       Remove_Next_End_Node;
1430
1431       --  Skip "end" if present
1432
1433       if Token = Tok_End then
1434          Scan (In_Tree);
1435       end if;
1436
1437       --  Clear the Buffer
1438
1439       Buffer_Last := 0;
1440
1441       --  Store the name following "end" in the Buffer. The name may be made of
1442       --  several simple names.
1443
1444       loop
1445          Expect (Tok_Identifier, "identifier");
1446
1447          --  If we don't have an identifier, clear the buffer before exiting to
1448          --  avoid checking the name.
1449
1450          if Token /= Tok_Identifier then
1451             Buffer_Last := 0;
1452             exit;
1453          end if;
1454
1455          --  Add the identifier to the Buffer
1456          Get_Name_String (Token_Name);
1457          Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1458
1459          --  Scan past the identifier
1460
1461          Scan (In_Tree);
1462          exit when Token /= Tok_Dot;
1463          Add_To_Buffer (".", Buffer, Buffer_Last);
1464          Scan (In_Tree);
1465       end loop;
1466
1467       --  If we have a valid name, check if it is the name of the project
1468
1469       if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
1470          if To_Lower (Buffer (1 .. Buffer_Last)) /=
1471             Get_Name_String (Name_Of (Project, In_Tree))
1472          then
1473             --  Invalid name: report an error
1474
1475             Error_Msg ("Expected """ &
1476                        Get_Name_String (Name_Of (Project, In_Tree)) & """",
1477                        Token_Ptr);
1478          end if;
1479       end if;
1480
1481       Expect (Tok_Semicolon, "`;`");
1482
1483       --  Check that there is no more text following the end of the project
1484       --  source.
1485
1486       if Token = Tok_Semicolon then
1487          Set_Previous_End_Node (Project);
1488          Scan (In_Tree);
1489
1490          if Token /= Tok_EOF then
1491             Error_Msg
1492               ("Unexpected text following end of project", Token_Ptr);
1493          end if;
1494       end if;
1495
1496       --  Restore the scan state, in case we are not the main project
1497
1498       Restore_Project_Scan_State (Project_Scan_State);
1499
1500       --  And remove the project from the project stack
1501
1502       Project_Stack.Decrement_Last;
1503
1504       --  Indicate if there are unkept comments
1505
1506       Tree.Set_Project_File_Includes_Unkept_Comments
1507         (Node    => Project,
1508          In_Tree => In_Tree,
1509          To      => Tree.There_Are_Unkept_Comments);
1510
1511       --  And restore the comment state that was saved
1512
1513       Tree.Restore (Project_Comment_State);
1514    end Parse_Single_Project;
1515
1516    -----------------------
1517    -- Project_Name_From --
1518    -----------------------
1519
1520    function Project_Name_From (Path_Name : String) return Name_Id is
1521       Canonical : String (1 .. Path_Name'Length) := Path_Name;
1522       First : Natural := Canonical'Last;
1523       Last  : Natural := First;
1524       Index : Positive;
1525
1526    begin
1527       if Current_Verbosity = High then
1528          Write_Str ("Project_Name_From (""");
1529          Write_Str (Canonical);
1530          Write_Line (""")");
1531       end if;
1532
1533       --  If the path name is empty, return No_Name to indicate failure
1534
1535       if First = 0 then
1536          return No_Name;
1537       end if;
1538
1539       Canonical_Case_File_Name (Canonical);
1540
1541       --  Look for the last dot in the path name
1542
1543       while First > 0
1544         and then
1545         Canonical (First) /= '.'
1546       loop
1547          First := First - 1;
1548       end loop;
1549
1550       --  If we have a dot, check that it is followed by the correct extension
1551
1552       if First > 0 and then Canonical (First) = '.' then
1553          if Canonical (First .. Last) = Project_File_Extension
1554            and then First /= 1
1555          then
1556             --  Look for the last directory separator, if any
1557
1558             First := First - 1;
1559             Last := First;
1560
1561             while First > 0
1562               and then Canonical (First) /= '/'
1563               and then Canonical (First) /= Dir_Sep
1564             loop
1565                First := First - 1;
1566             end loop;
1567
1568          else
1569             --  Not the correct extension, return No_Name to indicate failure
1570
1571             return No_Name;
1572          end if;
1573
1574       --  If no dot in the path name, return No_Name to indicate failure
1575
1576       else
1577          return No_Name;
1578       end if;
1579
1580       First := First + 1;
1581
1582       --  If the extension is the file name, return No_Name to indicate failure
1583
1584       if First > Last then
1585          return No_Name;
1586       end if;
1587
1588       --  Put the name in lower case into Name_Buffer
1589
1590       Name_Len := Last - First + 1;
1591       Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
1592
1593       Index := 1;
1594
1595       --  Check if it is a well formed project name. Return No_Name if it is
1596       --  ill formed.
1597
1598       loop
1599          if not Is_Letter (Name_Buffer (Index)) then
1600             return No_Name;
1601
1602          else
1603             loop
1604                Index := Index + 1;
1605
1606                exit when Index >= Name_Len;
1607
1608                if Name_Buffer (Index) = '_' then
1609                   if Name_Buffer (Index + 1) = '_' then
1610                      return No_Name;
1611                   end if;
1612                end if;
1613
1614                exit when Name_Buffer (Index) = '-';
1615
1616                if Name_Buffer (Index) /= '_'
1617                  and then not Is_Alphanumeric (Name_Buffer (Index))
1618                then
1619                   return No_Name;
1620                end if;
1621
1622             end loop;
1623          end if;
1624
1625          if Index >= Name_Len then
1626             if Is_Alphanumeric (Name_Buffer (Name_Len)) then
1627
1628                --  All checks have succeeded. Return name in Name_Buffer
1629
1630                return Name_Find;
1631
1632             else
1633                return No_Name;
1634             end if;
1635
1636          elsif Name_Buffer (Index) = '-' then
1637             Index := Index + 1;
1638          end if;
1639       end loop;
1640    end Project_Name_From;
1641
1642    --------------------------
1643    -- Project_Path_Name_Of --
1644    --------------------------
1645
1646    function Project_Path_Name_Of
1647      (Project_File_Name : String;
1648       Directory         : String) return String
1649    is
1650       Result : String_Access;
1651
1652    begin
1653       if Current_Verbosity = High then
1654          Write_Str  ("Project_Path_Name_Of (""");
1655          Write_Str  (Project_File_Name);
1656          Write_Str  (""", """);
1657          Write_Str  (Directory);
1658          Write_Line (""");");
1659       end if;
1660
1661       if not Is_Absolute_Path (Project_File_Name) then
1662          --  First we try <directory>/<file_name>.<extension>
1663
1664          if Current_Verbosity = High then
1665             Write_Str  ("   Trying ");
1666             Write_Str  (Directory);
1667             Write_Char (Directory_Separator);
1668             Write_Str (Project_File_Name);
1669             Write_Line (Project_File_Extension);
1670          end if;
1671
1672          Result :=
1673            Locate_Regular_File
1674            (File_Name => Directory & Directory_Separator &
1675               Project_File_Name & Project_File_Extension,
1676             Path      => Project_Path);
1677
1678          --  Then we try <directory>/<file_name>
1679
1680          if Result = null then
1681             if Current_Verbosity = High then
1682                Write_Str  ("   Trying ");
1683                Write_Str  (Directory);
1684                Write_Char (Directory_Separator);
1685                Write_Line (Project_File_Name);
1686             end if;
1687
1688             Result :=
1689               Locate_Regular_File
1690               (File_Name => Directory & Directory_Separator &
1691                  Project_File_Name,
1692                Path      => Project_Path);
1693          end if;
1694       end if;
1695
1696       if Result = null then
1697
1698          --  Then we try <file_name>.<extension>
1699
1700          if Current_Verbosity = High then
1701             Write_Str  ("   Trying ");
1702             Write_Str (Project_File_Name);
1703             Write_Line (Project_File_Extension);
1704          end if;
1705
1706          Result :=
1707            Locate_Regular_File
1708            (File_Name => Project_File_Name & Project_File_Extension,
1709             Path      => Project_Path);
1710       end if;
1711
1712       if Result = null then
1713
1714          --  Then we try <file_name>
1715
1716          if Current_Verbosity = High then
1717             Write_Str  ("   Trying ");
1718             Write_Line  (Project_File_Name);
1719          end if;
1720
1721          Result :=
1722            Locate_Regular_File
1723            (File_Name => Project_File_Name,
1724             Path      => Project_Path);
1725       end if;
1726
1727       --  If we cannot find the project file, we return an empty string
1728
1729       if Result = null then
1730          return "";
1731
1732       else
1733          declare
1734             Final_Result : constant String :=
1735                              GNAT.OS_Lib.Normalize_Pathname
1736                                (Result.all,
1737                                 Resolve_Links  => False,
1738                                 Case_Sensitive => True);
1739          begin
1740             Free (Result);
1741             return Final_Result;
1742          end;
1743       end if;
1744    end Project_Path_Name_Of;
1745
1746 end Prj.Part;