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