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