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