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