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