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