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