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