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