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