gcc/ada/prj-part.adb

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