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