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 --                            $Revision: 1.10 $
  10 --                                                                          --
  11 --             Copyright (C) 2001 Free Software Foundation, Inc.            --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 with Ada.Characters.Handling;    use Ada.Characters.Handling;
  30 with Ada.Exceptions;             use Ada.Exceptions;
  31 with Errout;                     use Errout;
  32 with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
  33 with GNAT.OS_Lib;                use GNAT.OS_Lib;
  34 with Namet;                      use Namet;
  35 with Osint;                      use Osint;
  36 with Output;                     use Output;
  37 with Prj.Com;                    use Prj.Com;
  38 with Prj.Dect;
  39 with Scans;                      use Scans;
  40 with Scn;                        use Scn;
  41 with Sinfo;                      use Sinfo;
  42 with Sinput;                     use Sinput;
  43 with Sinput.P;                   use Sinput.P;
  44 with Stringt;                    use Stringt;
  45 with Table;
  46 with Types;                      use Types;
  47
  48 pragma Elaborate_All (GNAT.OS_Lib);
  49
  50 package body Prj.Part is
  51
  52    Dir_Sep  : Character renames GNAT.OS_Lib.Directory_Separator;
  53
  54    Project_File_Extension : String := ".gpr";
  55
  56    Project_Path : String_Access;
  57    --  The project path; initialized during package elaboration.
  58
  59    Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
  60    Prj_Path : constant String_Access := Getenv (Ada_Project_Path);
  61
  62    ------------------------------------
  63    -- Local Packages and Subprograms --
  64    ------------------------------------
  65
  66    package Project_Stack is new Table.Table
  67      (Table_Component_Type => Name_Id,
  68       Table_Index_Type     => Nat,
  69       Table_Low_Bound      => 1,
  70       Table_Initial        => 10,
  71       Table_Increment      => 10,
  72       Table_Name           => "Prj.Part.Project_Stack");
  73    --  This table is used to detect circular dependencies
  74    --  for imported and modified projects.
  75
  76    procedure Parse_Context_Clause
  77      (Context_Clause    : out Project_Node_Id;
  78       Project_Directory : Name_Id);
  79    --  Parse the context clause of a project
  80    --  Does nothing if there is b\no context clause (if the current
  81    --  token is not "with").
  82
  83    procedure Parse_Single_Project
  84      (Project         : out Project_Node_Id;
  85       Path_Name       : String;
  86       Modified        : Boolean);
  87    --  Parse a project file.
  88    --  Recursive procedure: it calls itself for imported and
  89    --  modified projects.
  90
  91    function Path_Name_Of
  92      (File_Name : String;
  93       Directory : String)
  94       return      String;
  95    --  Returns the path name of a (non project) file.
  96    --  Returns an empty string if file cannot be found.
  97
  98    function Project_Path_Name_Of
  99      (Project_File_Name : String;
 100       Directory         : String)
 101       return              String;
 102    --  Returns the path name of a project file.
 103    --  Returns an empty string if project file cannot be found.
 104
 105    function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id;
 106    --  Get the directory of the file with the specified path name.
 107    --  This includes the directory separator as the last character.
 108    --  Returns "./" if Path_Name contains no directory separator.
 109
 110    function Simple_File_Name_Of (Path_Name : Name_Id) return Name_Id;
 111    --  Returns the name of a file with the specified path name
 112    --  with no directory information.
 113
 114    function Project_Name_From (Path_Name : String) return Name_Id;
 115    --  Returns the name of the project that corresponds to its path name.
 116    --  Returns No_Name if the path name is invalid, because the corresponding
 117    --  project name does not have the syntax of an ada identifier.
 118
 119    ----------------------------
 120    -- Immediate_Directory_Of --
 121    ----------------------------
 122
 123    function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id is
 124    begin
 125       Get_Name_String (Path_Name);
 126
 127       for Index in reverse 1 .. Name_Len loop
 128          if Name_Buffer (Index) = '/'
 129            or else Name_Buffer (Index) = Dir_Sep
 130          then
 131             --  Remove from name all characters after the last
 132             --  directory separator.
 133
 134             Name_Len := Index;
 135             return Name_Find;
 136          end if;
 137       end loop;
 138
 139       --  There is no directory separator in name. Return "./" or ".\".
 140       Name_Len := 2;
 141       Name_Buffer (1) := '.';
 142       Name_Buffer (2) := Dir_Sep;
 143       return Name_Find;
 144    end Immediate_Directory_Of;
 145
 146    -----------
 147    -- Parse --
 148    -----------
 149
 150    procedure Parse
 151      (Project                : out Project_Node_Id;
 152       Project_File_Name      : String;
 153       Always_Errout_Finalize : Boolean)
 154    is
 155       Current_Directory : constant String := Get_Current_Dir;
 156
 157    begin
 158       Project := Empty_Node;
 159
 160       if Current_Verbosity >= Medium then
 161          Write_Str ("ADA_PROJECT_PATH=""");
 162          Write_Str (Project_Path.all);
 163          Write_Line ("""");
 164       end if;
 165
 166       declare
 167          Path_Name : constant String :=
 168            Project_Path_Name_Of (Project_File_Name,
 169                                  Directory   => Current_Directory);
 170
 171       begin
 172          --  Initialize the tables
 173
 174          Tree_Private_Part.Project_Nodes.Set_Last (Empty_Node);
 175          Tree_Private_Part.Projects_Htable.Reset;
 176
 177          Errout.Initialize;
 178
 179          --  And parse the main project file
 180
 181          if Path_Name = "" then
 182             Fail ("project file """ & Project_File_Name & """ not found");
 183          end if;
 184
 185          Parse_Single_Project
 186            (Project         => Project,
 187             Path_Name       => Path_Name,
 188             Modified        => False);
 189
 190          if Errout.Errors_Detected > 0 then
 191             Project := Empty_Node;
 192          end if;
 193
 194          if Project = Empty_Node or else Always_Errout_Finalize then
 195             Errout.Finalize;
 196          end if;
 197       end;
 198
 199    exception
 200       when X : others =>
 201
 202          --  Internal error
 203
 204          Write_Line (Exception_Information (X));
 205          Write_Str  ("Exception ");
 206          Write_Str  (Exception_Name (X));
 207          Write_Line (" raised, while processing project file");
 208          Project := Empty_Node;
 209    end Parse;
 210
 211    --------------------------
 212    -- Parse_Context_Clause --
 213    --------------------------
 214
 215    procedure Parse_Context_Clause
 216      (Context_Clause    : out Project_Node_Id;
 217       Project_Directory : Name_Id)
 218    is
 219       Project_Directory_Path : constant String :=
 220                                  Get_Name_String (Project_Directory);
 221       Current_With_Clause    : Project_Node_Id := Empty_Node;
 222       Next_With_Clause       : Project_Node_Id := Empty_Node;
 223
 224    begin
 225       --  Assume no context clause
 226
 227       Context_Clause := Empty_Node;
 228       With_Loop :
 229
 230       --  If Token is not "with", there is no context clause,
 231       --  or we have exhausted the with clauses.
 232
 233       while Token = Tok_With loop
 234          Comma_Loop :
 235          loop
 236             --  Scan past "with" or ","
 237
 238             Scan;
 239             Expect (Tok_String_Literal, "literal string");
 240
 241             if Token /= Tok_String_Literal then
 242                return;
 243             end if;
 244
 245             --  New with clause
 246
 247             if Current_With_Clause = Empty_Node then
 248
 249                --  First with clause of the context clause
 250
 251                Current_With_Clause := Default_Project_Node
 252                  (Of_Kind => N_With_Clause);
 253                Context_Clause := Current_With_Clause;
 254
 255             else
 256                Next_With_Clause := Default_Project_Node
 257                  (Of_Kind => N_With_Clause);
 258                Set_Next_With_Clause_Of (Current_With_Clause, Next_With_Clause);
 259                Current_With_Clause := Next_With_Clause;
 260             end if;
 261
 262             Set_String_Value_Of (Current_With_Clause, Strval (Token_Node));
 263             Set_Location_Of     (Current_With_Clause, Token_Ptr);
 264             String_To_Name_Buffer (String_Value_Of (Current_With_Clause));
 265
 266             declare
 267                Original_Path : constant String :=
 268                                  Name_Buffer (1 .. Name_Len);
 269
 270                Imported_Path_Name : constant String :=
 271                                       Project_Path_Name_Of
 272                                         (Original_Path,
 273                                          Project_Directory_Path);
 274
 275                Withed_Project : Project_Node_Id := Empty_Node;
 276
 277             begin
 278                if Imported_Path_Name = "" then
 279
 280                   --  The project file cannot be found
 281
 282                   Name_Len := Original_Path'Length;
 283                   Name_Buffer (1 .. Name_Len) := Original_Path;
 284                   Error_Msg_Name_1 := Name_Find;
 285
 286                   Error_Msg ("unknown project file: {", Token_Ptr);
 287
 288                else
 289                   --  Parse the imported project
 290
 291                   Parse_Single_Project
 292                     (Project   => Withed_Project,
 293                      Path_Name => Imported_Path_Name,
 294                      Modified  => False);
 295
 296                   if Withed_Project /= Empty_Node then
 297
 298                      --  If parsing was successful, record project name
 299                      --  and path name in with clause
 300
 301                      Set_Project_Node_Of (Current_With_Clause, Withed_Project);
 302                      Set_Name_Of (Current_With_Clause,
 303                                   Name_Of (Withed_Project));
 304                      Name_Len := Imported_Path_Name'Length;
 305                      Name_Buffer (1 .. Name_Len) := Imported_Path_Name;
 306                      Set_Path_Name_Of (Current_With_Clause, Name_Find);
 307                   end if;
 308                end if;
 309             end;
 310
 311             Scan;
 312             if Token = Tok_Semicolon then
 313
 314                --  End of (possibly multiple) with clause;
 315                --  Scan past the semicolon.
 316
 317                Scan;
 318                exit Comma_Loop;
 319
 320             elsif Token /= Tok_Comma then
 321                Error_Msg ("expected comma or semi colon", Token_Ptr);
 322                exit Comma_Loop;
 323             end if;
 324          end loop Comma_Loop;
 325       end loop With_Loop;
 326
 327    end Parse_Context_Clause;
 328
 329    --------------------------
 330    -- Parse_Single_Project --
 331    --------------------------
 332
 333    procedure Parse_Single_Project
 334      (Project         : out Project_Node_Id;
 335       Path_Name       : String;
 336       Modified        : Boolean)
 337    is
 338       Canonical_Path_Name : Name_Id;
 339       Project_Directory   : Name_Id;
 340       Project_Scan_State  : Saved_Project_Scan_State;
 341       Source_Index        : Source_File_Index;
 342
 343       Modified_Project    : Project_Node_Id := Empty_Node;
 344
 345       A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
 346         Tree_Private_Part.Projects_Htable.Get_First;
 347
 348       Name_From_Path : constant Name_Id := Project_Name_From (Path_Name);
 349
 350       use Tree_Private_Part;
 351
 352    begin
 353       Name_Len := Path_Name'Length;
 354       Name_Buffer (1 .. Name_Len) := Path_Name;
 355       Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
 356       Canonical_Path_Name := Name_Find;
 357
 358       --  Check for a circular dependency
 359
 360       for Index in 1 .. Project_Stack.Last loop
 361          if Canonical_Path_Name = Project_Stack.Table (Index) then
 362             Error_Msg ("circular dependency detected", Token_Ptr);
 363             Error_Msg_Name_1 := Canonical_Path_Name;
 364             Error_Msg ("\  { is imported by", Token_Ptr);
 365
 366             for Current in reverse 1 .. Project_Stack.Last loop
 367                Error_Msg_Name_1 := Project_Stack.Table (Current);
 368
 369                if Error_Msg_Name_1 /= Canonical_Path_Name then
 370                   Error_Msg
 371                     ("\  { which itself is imported by", Token_Ptr);
 372
 373                else
 374                   Error_Msg ("\  {", Token_Ptr);
 375                   exit;
 376                end if;
 377             end loop;
 378
 379             Project := Empty_Node;
 380             return;
 381          end if;
 382       end loop;
 383
 384       Project_Stack.Increment_Last;
 385       Project_Stack.Table (Project_Stack.Last) := Canonical_Path_Name;
 386
 387       --  Check if the project file has already been parsed.
 388
 389       while
 390         A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
 391       loop
 392          if
 393            Path_Name_Of (A_Project_Name_And_Node.Node) = Canonical_Path_Name
 394          then
 395             if Modified then
 396
 397                if A_Project_Name_And_Node.Modified then
 398                   Error_Msg
 399                     ("cannot modify several times the same project file",
 400                      Token_Ptr);
 401
 402                else
 403                   Error_Msg
 404                     ("cannot modify an imported project file",
 405                      Token_Ptr);
 406                end if;
 407
 408             elsif A_Project_Name_And_Node.Modified then
 409                Error_Msg
 410                  ("cannot imported a modified project file",
 411                   Token_Ptr);
 412             end if;
 413
 414             Project := A_Project_Name_And_Node.Node;
 415             Project_Stack.Decrement_Last;
 416             return;
 417          end if;
 418
 419          A_Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next;
 420       end loop;
 421
 422       --  We never encountered this project file
 423       --  Save the scan state, load the project file and start to scan it.
 424
 425       Save_Project_Scan_State (Project_Scan_State);
 426       Source_Index := Load_Project_File (Path_Name);
 427
 428       --  if we cannot find it, we stop
 429
 430       if Source_Index = No_Source_File then
 431          Project := Empty_Node;
 432          Project_Stack.Decrement_Last;
 433          return;
 434       end if;
 435
 436       Initialize_Scanner (Types.No_Unit, Source_Index);
 437
 438       if Name_From_Path = No_Name then
 439
 440          --  The project file name is not correct (no or bad extension,
 441          --  or not following Ada identifier's syntax).
 442
 443          Error_Msg_Name_1 := Canonical_Path_Name;
 444          Error_Msg ("?{ is not a valid path name for a project file",
 445                     Token_Ptr);
 446       end if;
 447
 448       if Current_Verbosity >= Medium then
 449          Write_Str  ("Parsing """);
 450          Write_Str  (Path_Name);
 451          Write_Char ('"');
 452          Write_Eol;
 453       end if;
 454
 455       Project_Directory := Immediate_Directory_Of (Canonical_Path_Name);
 456       Project := Default_Project_Node (Of_Kind => N_Project);
 457       Set_Directory_Of (Project, Project_Directory);
 458       Set_Name_Of (Project, Simple_File_Name_Of (Canonical_Path_Name));
 459       Set_Path_Name_Of (Project, Canonical_Path_Name);
 460       Set_Location_Of (Project, Token_Ptr);
 461
 462       --  Is there any imported project?
 463
 464       declare
 465          First_With_Clause : Project_Node_Id := Empty_Node;
 466
 467       begin
 468          Parse_Context_Clause (Context_Clause    => First_With_Clause,
 469                                Project_Directory => Project_Directory);
 470          Set_First_With_Clause_Of (Project, First_With_Clause);
 471       end;
 472
 473       Expect (Tok_Project, "project");
 474
 475       --  Scan past "project"
 476
 477       if Token = Tok_Project then
 478          Set_Location_Of (Project, Token_Ptr);
 479          Scan;
 480       end if;
 481
 482       Expect (Tok_Identifier, "identifier");
 483
 484       if Token = Tok_Identifier then
 485          Set_Name_Of (Project, Token_Name);
 486
 487          Get_Name_String (Token_Name);
 488          Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
 489
 490          declare
 491             Expected_Name : constant Name_Id := Name_Find;
 492
 493          begin
 494             if Name_From_Path /= No_Name
 495               and then Expected_Name /= Name_From_Path
 496             then
 497                --  The project name is not the one that was expected from
 498                --  the file name. Report a warning.
 499
 500                Error_Msg_Name_1 := Expected_Name;
 501                Error_Msg ("?file name does not match unit name, " &
 502                           "should be `{" & Project_File_Extension & "`",
 503                           Token_Ptr);
 504             end if;
 505          end;
 506
 507          declare
 508             Project_Name : Name_Id :=
 509                              Tree_Private_Part.Projects_Htable.Get_First.Name;
 510
 511          begin
 512             --  Check if we already have a project with this name
 513
 514             while Project_Name /= No_Name
 515               and then Project_Name /= Token_Name
 516             loop
 517                Project_Name := Tree_Private_Part.Projects_Htable.Get_Next.Name;
 518             end loop;
 519
 520             if Project_Name /= No_Name then
 521                Error_Msg ("duplicate project name", Token_Ptr);
 522
 523             else
 524                Tree_Private_Part.Projects_Htable.Set
 525                  (K => Token_Name,
 526                   E => (Name     => Token_Name,
 527                         Node     => Project,
 528                         Modified => Modified));
 529             end if;
 530          end;
 531
 532          --  Scan past the project name
 533
 534          Scan;
 535
 536       end if;
 537
 538       if Token = Tok_Modifying then
 539
 540          --  We are modifying another project
 541
 542          --  Scan past "modifying"
 543
 544          Scan;
 545
 546          Expect (Tok_String_Literal, "literal string");
 547
 548          if Token = Tok_String_Literal then
 549             Set_Modified_Project_Path_Of (Project, Strval (Token_Node));
 550             String_To_Name_Buffer (Modified_Project_Path_Of (Project));
 551
 552             declare
 553                Original_Path_Name : constant String :=
 554                                       Name_Buffer (1 .. Name_Len);
 555
 556                Modified_Project_Path_Name : constant String :=
 557                                               Project_Path_Name_Of
 558                                                 (Original_Path_Name,
 559                                                    Get_Name_String
 560                                                      (Project_Directory));
 561
 562             begin
 563                if Modified_Project_Path_Name = "" then
 564
 565                   --  We could not find the project file to modify
 566
 567                   Name_Len := Original_Path_Name'Length;
 568                   Name_Buffer (1 .. Name_Len) := Original_Path_Name;
 569                   Error_Msg_Name_1 := Name_Find;
 570
 571                   Error_Msg ("unknown project file: {", Token_Ptr);
 572
 573                else
 574                   Parse_Single_Project
 575                     (Project   => Modified_Project,
 576                      Path_Name => Modified_Project_Path_Name,
 577                      Modified  => True);
 578                end if;
 579             end;
 580
 581             --  Scan past the modified project path
 582
 583             Scan;
 584          end if;
 585       end if;
 586
 587       Expect (Tok_Is, "is");
 588
 589       declare
 590          Project_Declaration : Project_Node_Id := Empty_Node;
 591
 592       begin
 593          --  No need to Scan past "is", Prj.Dect.Parse will do it.
 594
 595          Prj.Dect.Parse
 596            (Declarations    => Project_Declaration,
 597             Current_Project => Project,
 598             Modifying       => Modified_Project);
 599          Set_Project_Declaration_Of (Project, Project_Declaration);
 600       end;
 601
 602       Expect (Tok_End, "end");
 603
 604       --  Scan past "end"
 605
 606       if Token = Tok_End then
 607          Scan;
 608       end if;
 609
 610       Expect (Tok_Identifier, "identifier");
 611
 612       if Token = Tok_Identifier then
 613
 614          --  We check if this is the project name
 615
 616          if To_Lower (Get_Name_String (Token_Name)) /=
 617             Get_Name_String (Name_Of (Project))
 618          then
 619             Error_Msg ("Expected """ &
 620                        Get_Name_String (Name_Of (Project)) & """",
 621                        Token_Ptr);
 622          end if;
 623       end if;
 624
 625       if Token /= Tok_Semicolon then
 626          Scan;
 627       end if;
 628
 629       Expect (Tok_Semicolon, ";");
 630
 631       --  Restore the scan state, in case we are not the main project
 632
 633       Restore_Project_Scan_State (Project_Scan_State);
 634
 635       Project_Stack.Decrement_Last;
 636    end Parse_Single_Project;
 637
 638    ------------------
 639    -- Path_Name_Of --
 640    ------------------
 641
 642    function Path_Name_Of
 643      (File_Name : String;
 644       Directory : String)
 645       return      String
 646    is
 647       Result : String_Access;
 648
 649    begin
 650       Result := Locate_Regular_File (File_Name => File_Name,
 651                                      Path      => Directory);
 652
 653       if Result = null then
 654          return "";
 655
 656       else
 657          Canonical_Case_File_Name (Result.all);
 658          return Result.all;
 659       end if;
 660    end Path_Name_Of;
 661
 662    -----------------------
 663    -- Project_Name_From --
 664    -----------------------
 665
 666    function Project_Name_From (Path_Name : String) return Name_Id is
 667       Canonical : String (1 .. Path_Name'Length) := Path_Name;
 668       First : Natural  := Canonical'Last;
 669       Last  : Positive := First;
 670
 671    begin
 672       if First = 0 then
 673          return No_Name;
 674       end if;
 675
 676       Canonical_Case_File_Name (Canonical);
 677
 678       while First > 0
 679         and then
 680         Canonical (First) /= '.'
 681       loop
 682          First := First - 1;
 683       end loop;
 684
 685       if Canonical (First) = '.' then
 686          if Canonical (First .. Last) = Project_File_Extension
 687            and then First /= 1
 688          then
 689             First := First - 1;
 690             Last := First;
 691
 692             while First > 0
 693               and then Canonical (First) /= '/'
 694               and then Canonical (First) /= Dir_Sep
 695             loop
 696                First := First - 1;
 697             end loop;
 698
 699          else
 700             return No_Name;
 701          end if;
 702
 703       else
 704          return No_Name;
 705       end if;
 706
 707       if Canonical (First) = '/'
 708         or else Canonical (First) = Dir_Sep
 709       then
 710          First := First + 1;
 711       end if;
 712
 713       Name_Len := Last - First + 1;
 714       Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
 715
 716       if not Is_Letter (Name_Buffer (1)) then
 717          return No_Name;
 718
 719       else
 720          for Index in 2 .. Name_Len - 1 loop
 721             if Name_Buffer (Index) = '_' then
 722                if Name_Buffer (Index + 1) = '_' then
 723                   return No_Name;
 724                end if;
 725
 726             elsif not Is_Alphanumeric (Name_Buffer (Index)) then
 727                return No_Name;
 728             end if;
 729
 730          end loop;
 731
 732          if not Is_Alphanumeric (Name_Buffer (Name_Len)) then
 733             return No_Name;
 734
 735          else
 736             return Name_Find;
 737          end if;
 738
 739       end if;
 740    end Project_Name_From;
 741
 742    --------------------------
 743    -- Project_Path_Name_Of --
 744    --------------------------
 745
 746    function Project_Path_Name_Of
 747      (Project_File_Name : String;
 748       Directory         : String)
 749       return              String
 750    is
 751       Result : String_Access;
 752
 753    begin
 754       --  First we try <file_name>.<extension>
 755
 756       if Current_Verbosity = High then
 757          Write_Str  ("Project_Path_Name_Of (""");
 758          Write_Str  (Project_File_Name);
 759          Write_Str  (""", """);
 760          Write_Str  (Directory);
 761          Write_Line (""");");
 762          Write_Str  ("   Trying ");
 763          Write_Str (Project_File_Name);
 764          Write_Line (Project_File_Extension);
 765       end if;
 766
 767       Result :=
 768         Locate_Regular_File
 769           (File_Name => Project_File_Name & Project_File_Extension,
 770            Path      => Project_Path.all);
 771
 772       --  Then we try <file_name>
 773
 774       if Result = null then
 775          if Current_Verbosity = High then
 776             Write_Str  ("   Trying ");
 777             Write_Line  (Project_File_Name);
 778          end if;
 779
 780          Result :=
 781            Locate_Regular_File
 782            (File_Name => Project_File_Name,
 783             Path      => Project_Path.all);
 784
 785          --  The we try <directory>/<file_name>.<extension>
 786
 787          if Result = null then
 788             if Current_Verbosity = High then
 789                Write_Str  ("   Trying ");
 790                Write_Str  (Directory);
 791                Write_Str (Project_File_Name);
 792                Write_Line (Project_File_Extension);
 793             end if;
 794
 795             Result :=
 796               Locate_Regular_File
 797               (File_Name => Directory & Project_File_Name &
 798                             Project_File_Extension,
 799                Path      => Project_Path.all);
 800
 801             --  Then we try <directory>/<file_name>
 802
 803             if Result = null then
 804                if Current_Verbosity = High then
 805                   Write_Str  ("   Trying ");
 806                   Write_Str  (Directory);
 807                   Write_Line  (Project_File_Name);
 808                end if;
 809
 810                Result :=
 811                  Locate_Regular_File
 812                  (File_Name => Directory & Project_File_Name,
 813                   Path      => Project_Path.all);
 814             end if;
 815          end if;
 816       end if;
 817
 818       --  If we cannot find the project file, we return an empty string
 819
 820       if Result = null then
 821          return "";
 822
 823       else
 824          declare
 825             Final_Result : String
 826               := GNAT.OS_Lib.Normalize_Pathname (Result.all);
 827          begin
 828             Free (Result);
 829             Canonical_Case_File_Name (Final_Result);
 830             return Final_Result;
 831          end;
 832
 833       end if;
 834
 835    end Project_Path_Name_Of;
 836
 837    -------------------------
 838    -- Simple_File_Name_Of --
 839    -------------------------
 840
 841    function Simple_File_Name_Of (Path_Name : Name_Id) return Name_Id is
 842    begin
 843       Get_Name_String (Path_Name);
 844
 845       for Index in reverse 1 .. Name_Len loop
 846          if Name_Buffer (Index) = '/'
 847            or else Name_Buffer (Index) = Dir_Sep
 848          then
 849             exit when Index = Name_Len;
 850             Name_Buffer (1 .. Name_Len - Index) :=
 851               Name_Buffer (Index + 1 .. Name_Len);
 852             Name_Len := Name_Len - Index;
 853             return Name_Find;
 854          end if;
 855       end loop;
 856
 857       return No_Name;
 858
 859    end Simple_File_Name_Of;
 860
 861 begin
 862    Canonical_Case_File_Name (Project_File_Extension);
 863
 864    if Prj_Path.all = "" then
 865       Project_Path := new String'(".");
 866
 867    else
 868       Project_Path := new String'("." & Path_Separator & Prj_Path.all);
 869    end if;
 870
 871 end Prj.Part;