gcc/ada/prj-part.adb

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