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 Table;
  39 with Types;    use Types;
  40
  41 with Ada.Characters.Handling;    use Ada.Characters.Handling;
  42 with Ada.Exceptions;             use Ada.Exceptions;
  43
  44 with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
  45 with GNAT.OS_Lib;                use GNAT.OS_Lib;
  46
  47 pragma Elaborate_All (GNAT.OS_Lib);
  48
  49 package body Prj.Part is
  50
  51    Dir_Sep  : Character renames GNAT.OS_Lib.Directory_Separator;
  52
  53    Project_Path : String_Access;
  54    --  The project path; initialized during package elaboration.
  55    --  Contains at least the current working directory.
  56
  57    Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
  58    --  Name of the env. variable that contains path name(s) of directories
  59    --  where project files may reside.
  60
  61    Prj_Path : constant String_Access := Getenv (Ada_Project_Path);
  62    --  The path name(s) of directories where project files may reside.
  63    --  May be empty.
  64
  65    ------------------------------------
  66    -- Local Packages and Subprograms --
  67    ------------------------------------
  68
  69    type With_Id is new Nat;
  70    No_With : constant With_Id := 0;
  71
  72    type With_Record is record
  73       Path         : Name_Id;
  74       Location     : Source_Ptr;
  75       Limited_With : Boolean;
  76       Next         : With_Id;
  77    end record;
  78    --  Information about an imported project, to be put in table Withs below
  79
  80    package Withs is new Table.Table
  81      (Table_Component_Type => With_Record,
  82       Table_Index_Type     => With_Id,
  83       Table_Low_Bound      => 1,
  84       Table_Initial        => 10,
  85       Table_Increment      => 50,
  86       Table_Name           => "Prj.Part.Withs");
  87    --  Table used to store temporarily paths and locations of imported
  88    --  projects. These imported projects will be effectively parsed after the
  89    --  name of the current project has been extablished.
  90
  91    type Name_And_Id is record
  92       Name : Name_Id;
  93       Id   : Project_Node_Id;
  94    end record;
  95
  96    package Project_Stack is new Table.Table
  97      (Table_Component_Type => Name_And_Id,
  98       Table_Index_Type     => Nat,
  99       Table_Low_Bound      => 1,
 100       Table_Initial        => 10,
 101       Table_Increment      => 50,
 102       Table_Name           => "Prj.Part.Project_Stack");
 103    --  This table is used to detect circular dependencies
 104    --  for imported and extended projects and to get the project ids of
 105    --  limited imported projects when there is a circularity with at least
 106    --  one limited imported project file.
 107
 108    procedure Pre_Parse_Context_Clause (Context_Clause : out With_Id);
 109    --  Parse the context clause of a project.
 110    --  Store the paths and locations of the imported projects in table Withs.
 111    --  Does nothing if there is no context clause (if the current
 112    --  token is not "with" or "limited" followed by "with").
 113
 114    procedure Post_Parse_Context_Clause
 115      (Context_Clause    : With_Id;
 116       Imported_Projects : out Project_Node_Id;
 117       Project_Directory : Name_Id;
 118       From_Extended     : Boolean);
 119    --  Parse the imported projects that have been stored in table Withs,
 120    --  if any. From_Extended is used for the call to Parse_Single_Project
 121    --  below.
 122
 123    procedure Parse_Single_Project
 124      (Project       : out Project_Node_Id;
 125       Path_Name     : String;
 126       Extended      : Boolean;
 127       From_Extended : Boolean);
 128    --  Parse a project file.
 129    --  Recursive procedure: it calls itself for imported and extended
 130    --  projects. When From_Extended is True, if the project has already
 131    --  been parsed and is an extended project A, return the ultimate
 132    --  (not extended) project that extends A.
 133
 134    function Project_Path_Name_Of
 135      (Project_File_Name : String;
 136       Directory         : String)
 137       return              String;
 138    --  Returns the path name of a project file. Returns an empty string
 139    --  if project file cannot be found.
 140
 141    function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id;
 142    --  Get the directory of the file with the specified path name.
 143    --  This includes the directory separator as the last character.
 144    --  Returns "./" if Path_Name contains no directory separator.
 145
 146    function Project_Name_From (Path_Name : String) return Name_Id;
 147    --  Returns the name of the project that corresponds to its path name.
 148    --  Returns No_Name if the path name is invalid, because the corresponding
 149    --  project name does not have the syntax of an ada identifier.
 150
 151    ----------------------------
 152    -- Immediate_Directory_Of --
 153    ----------------------------
 154
 155    function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id is
 156    begin
 157       Get_Name_String (Path_Name);
 158
 159       for Index in reverse 1 .. Name_Len loop
 160          if Name_Buffer (Index) = '/'
 161            or else Name_Buffer (Index) = Dir_Sep
 162          then
 163             --  Remove all chars after last directory separator from name
 164
 165             if Index > 1 then
 166                Name_Len := Index - 1;
 167
 168             else
 169                Name_Len := Index;
 170             end if;
 171
 172             return Name_Find;
 173          end if;
 174       end loop;
 175
 176       --  There is no directory separator in name. Return "./" or ".\"
 177
 178       Name_Len := 2;
 179       Name_Buffer (1) := '.';
 180       Name_Buffer (2) := Dir_Sep;
 181       return Name_Find;
 182    end Immediate_Directory_Of;
 183
 184    -----------
 185    -- Parse --
 186    -----------
 187
 188    procedure Parse
 189      (Project                : out Project_Node_Id;
 190       Project_File_Name      : String;
 191       Always_Errout_Finalize : Boolean;
 192       Packages_To_Check      : String_List_Access := All_Packages)
 193    is
 194       Current_Directory : constant String := Get_Current_Dir;
 195
 196    begin
 197       --  Save the Packages_To_Check in Prj, so that it is visible from
 198       --  Prj.Dect.
 199
 200       Current_Packages_To_Check := Packages_To_Check;
 201
 202       Project := Empty_Node;
 203
 204       if Current_Verbosity >= Medium then
 205          Write_Str ("ADA_PROJECT_PATH=""");
 206          Write_Str (Project_Path.all);
 207          Write_Line ("""");
 208       end if;
 209
 210       declare
 211          Path_Name : constant String :=
 212                        Project_Path_Name_Of (Project_File_Name,
 213                                              Directory   => Current_Directory);
 214
 215       begin
 216          Prj.Err.Initialize;
 217
 218          --  Parse the main project file
 219
 220          if Path_Name = "" then
 221             Prj.Com.Fail
 222               ("project file """, Project_File_Name, """ not found");
 223             Project := Empty_Node;
 224             return;
 225          end if;
 226
 227          Parse_Single_Project
 228            (Project       => Project,
 229             Path_Name     => Path_Name,
 230             Extended      => False,
 231             From_Extended => False);
 232
 233          --  If there were any kind of error during the parsing, serious
 234          --  or not, then the parsing fails.
 235
 236          if Err_Vars.Total_Errors_Detected > 0 then
 237             Project := Empty_Node;
 238          end if;
 239
 240          if Project = Empty_Node or else Always_Errout_Finalize then
 241             Prj.Err.Finalize;
 242          end if;
 243       end;
 244
 245    exception
 246       when X : others =>
 247
 248          --  Internal error
 249
 250          Write_Line (Exception_Information (X));
 251          Write_Str  ("Exception ");
 252          Write_Str  (Exception_Name (X));
 253          Write_Line (" raised, while processing project file");
 254          Project := Empty_Node;
 255    end Parse;
 256
 257    ------------------------------
 258    -- Pre_Parse_Context_Clause --
 259    ------------------------------
 260
 261    procedure Pre_Parse_Context_Clause (Context_Clause : out With_Id) is
 262       Current_With_Clause    : With_Id := No_With;
 263       Limited_With           : Boolean         := False;
 264
 265       Current_With : With_Record;
 266
 267    begin
 268       --  Assume no context clause
 269
 270       Context_Clause := No_With;
 271       With_Loop :
 272
 273       --  If Token is not WITH or LIMITED, there is no context clause,
 274       --  or we have exhausted the with clauses.
 275
 276       while Token = Tok_With or else Token = Tok_Limited loop
 277          Limited_With := Token = Tok_Limited;
 278
 279          if Limited_With then
 280             Scan;  --  scan past LIMITED
 281             Expect (Tok_With, "WITH");
 282             exit With_Loop when Token /= Tok_With;
 283          end if;
 284
 285          Comma_Loop :
 286          loop
 287             Scan; -- scan past WITH or ","
 288
 289             Expect (Tok_String_Literal, "literal string");
 290
 291             if Token /= Tok_String_Literal then
 292                return;
 293             end if;
 294
 295             --  Store path and location in table Withs
 296
 297             Current_With :=
 298               (Path         => Token_Name,
 299                Location     => Token_Ptr,
 300                Limited_With => Limited_With,
 301                Next         => No_With);
 302
 303             Withs.Increment_Last;
 304             Withs.Table (Withs.Last) := Current_With;
 305
 306             if Current_With_Clause = No_With then
 307                Context_Clause := Withs.Last;
 308
 309             else
 310                Withs.Table (Current_With_Clause).Next := Withs.Last;
 311             end if;
 312
 313             Current_With_Clause := Withs.Last;
 314
 315             Scan;
 316
 317             if Token = Tok_Semicolon then
 318
 319                --  End of (possibly multiple) with clause;
 320
 321                Scan; -- scan past the semicolon.
 322                exit Comma_Loop;
 323
 324             elsif Token /= Tok_Comma then
 325                Error_Msg ("expected comma or semi colon", Token_Ptr);
 326                exit Comma_Loop;
 327             end if;
 328          end loop Comma_Loop;
 329       end loop With_Loop;
 330    end Pre_Parse_Context_Clause;
 331
 332
 333    -------------------------------
 334    -- Post_Parse_Context_Clause --
 335    -------------------------------
 336
 337    procedure Post_Parse_Context_Clause
 338      (Context_Clause    : With_Id;
 339       Imported_Projects : out Project_Node_Id;
 340       Project_Directory : Name_Id;
 341       From_Extended     : Boolean)
 342    is
 343       Current_With_Clause : With_Id := Context_Clause;
 344
 345       Current_Project  : Project_Node_Id := Empty_Node;
 346       Previous_Project : Project_Node_Id := Empty_Node;
 347       Next_Project     : Project_Node_Id := Empty_Node;
 348
 349       Project_Directory_Path : constant String :=
 350                                  Get_Name_String (Project_Directory);
 351
 352       Current_With : With_Record;
 353       Limited_With : Boolean := False;
 354
 355    begin
 356       Imported_Projects := Empty_Node;
 357
 358       while Current_With_Clause /= No_With loop
 359          Current_With := Withs.Table (Current_With_Clause);
 360          Current_With_Clause := Current_With.Next;
 361
 362          Limited_With := Current_With.Limited_With;
 363
 364          declare
 365             Original_Path : constant String :=
 366                                  Get_Name_String (Current_With.Path);
 367
 368             Imported_Path_Name : constant String :=
 369                                    Project_Path_Name_Of
 370                                      (Original_Path,
 371                                       Project_Directory_Path);
 372
 373             Withed_Project : Project_Node_Id := Empty_Node;
 374
 375          begin
 376             if Imported_Path_Name = "" then
 377
 378                --  The project file cannot be found
 379
 380                Error_Msg_Name_1 := Current_With.Path;
 381
 382                Error_Msg ("unknown project file: {", Current_With.Location);
 383
 384                --  If this is not imported by the main project file,
 385                --  display the import path.
 386
 387                if Project_Stack.Last > 1 then
 388                   for Index in reverse 1 .. Project_Stack.Last loop
 389                      Error_Msg_Name_1 := Project_Stack.Table (Index).Name;
 390                      Error_Msg ("\imported by {", Current_With.Location);
 391                   end loop;
 392                end if;
 393
 394             else
 395                --  New with clause
 396
 397                Previous_Project := Current_Project;
 398
 399                if Current_Project = Empty_Node then
 400
 401                   --  First with clause of the context clause
 402
 403                   Current_Project := Default_Project_Node
 404                                            (Of_Kind => N_With_Clause);
 405                   Imported_Projects := Current_Project;
 406
 407                else
 408                   Next_Project := Default_Project_Node
 409                                         (Of_Kind => N_With_Clause);
 410                   Set_Next_With_Clause_Of (Current_Project, Next_Project);
 411                   Current_Project := Next_Project;
 412                end if;
 413
 414                Set_String_Value_Of
 415                  (Current_Project, Current_With.Path);
 416                Set_Location_Of (Current_Project, Current_With.Location);
 417
 418                --  If this is a "limited with", check if we have
 419                --  a circularity; if we have one, get the project id
 420                --  of the limited imported project file, and don't
 421                --  parse it.
 422
 423                if Limited_With and then Project_Stack.Last > 1 then
 424                   declare
 425                      Normed : constant String :=
 426                                 Normalize_Pathname (Imported_Path_Name);
 427                      Canonical_Path_Name : Name_Id;
 428
 429                   begin
 430                      Name_Len := Normed'Length;
 431                      Name_Buffer (1 .. Name_Len) := Normed;
 432                      Canonical_Path_Name := Name_Find;
 433
 434                      for Index in 1 .. Project_Stack.Last loop
 435                         if Project_Stack.Table (Index).Name =
 436                           Canonical_Path_Name
 437                         then
 438                            --  We have found the limited imported project,
 439                            --  get its project id, and don't parse it.
 440
 441                            Withed_Project := Project_Stack.Table (Index).Id;
 442                            exit;
 443                         end if;
 444                      end loop;
 445                   end;
 446                end if;
 447
 448                --  Parse the imported project, if its project id is unknown
 449
 450                if Withed_Project = Empty_Node then
 451                   Parse_Single_Project
 452                     (Project       => Withed_Project,
 453                      Path_Name     => Imported_Path_Name,
 454                      Extended      => False,
 455                      From_Extended => From_Extended);
 456                end if;
 457
 458                if Withed_Project = Empty_Node then
 459                   --  If parsing was not successful, remove the
 460                   --  context clause.
 461
 462                   Current_Project := Previous_Project;
 463
 464                   if Current_Project = Empty_Node then
 465                      Imported_Projects := Empty_Node;
 466
 467                   else
 468                      Set_Next_With_Clause_Of
 469                        (Current_Project, Empty_Node);
 470                   end if;
 471                else
 472                   --  If parsing was successful, record project name
 473                   --  and path name in with clause
 474
 475                   Set_Project_Node_Of
 476                     (Node         => Current_Project,
 477                      To           => Withed_Project,
 478                      Limited_With => Limited_With);
 479                   Set_Name_Of (Current_Project, Name_Of (Withed_Project));
 480                   Name_Len := Imported_Path_Name'Length;
 481                   Name_Buffer (1 .. Name_Len) := Imported_Path_Name;
 482                   Set_Path_Name_Of (Current_Project, Name_Find);
 483                end if;
 484             end if;
 485          end;
 486       end loop;
 487    end Post_Parse_Context_Clause;
 488
 489    --------------------------
 490    -- Parse_Single_Project --
 491    --------------------------
 492
 493    procedure Parse_Single_Project
 494      (Project       : out Project_Node_Id;
 495       Path_Name     : String;
 496       Extended      : Boolean;
 497       From_Extended : Boolean)
 498    is
 499       Normed_Path_Name    : Name_Id;
 500       Canonical_Path_Name : Name_Id;
 501       Project_Directory   : Name_Id;
 502       Project_Scan_State  : Saved_Project_Scan_State;
 503       Source_Index        : Source_File_Index;
 504
 505       Extended_Project    : Project_Node_Id := Empty_Node;
 506
 507       A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
 508                                   Tree_Private_Part.Projects_Htable.Get_First;
 509
 510       Name_From_Path : constant Name_Id := Project_Name_From (Path_Name);
 511
 512       Name_Of_Project : Name_Id := No_Name;
 513
 514       First_With : With_Id;
 515
 516       use Tree_Private_Part;
 517
 518    begin
 519       declare
 520          Normed : String := Normalize_Pathname (Path_Name);
 521       begin
 522          Name_Len := Normed'Length;
 523          Name_Buffer (1 .. Name_Len) := Normed;
 524          Normed_Path_Name := Name_Find;
 525          Canonical_Case_File_Name (Normed);
 526          Name_Len := Normed'Length;
 527          Name_Buffer (1 .. Name_Len) := Normed;
 528          Canonical_Path_Name := Name_Find;
 529       end;
 530
 531       --  Check for a circular dependency
 532
 533       for Index in 1 .. Project_Stack.Last loop
 534          if Canonical_Path_Name = Project_Stack.Table (Index).Name then
 535             Error_Msg ("circular dependency detected", Token_Ptr);
 536             Error_Msg_Name_1 := Normed_Path_Name;
 537             Error_Msg ("\  { is imported by", Token_Ptr);
 538
 539             for Current in reverse 1 .. Project_Stack.Last loop
 540                Error_Msg_Name_1 := Project_Stack.Table (Current).Name;
 541
 542                if Error_Msg_Name_1 /= Canonical_Path_Name then
 543                   Error_Msg
 544                     ("\  { which itself is imported by", Token_Ptr);
 545
 546                else
 547                   Error_Msg ("\  {", Token_Ptr);
 548                   exit;
 549                end if;
 550             end loop;
 551
 552             Project := Empty_Node;
 553             return;
 554          end if;
 555       end loop;
 556
 557       Project_Stack.Increment_Last;
 558       Project_Stack.Table (Project_Stack.Last).Name := Canonical_Path_Name;
 559
 560       --  Check if the project file has already been parsed.
 561
 562       while
 563         A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
 564       loop
 565          if
 566            Path_Name_Of (A_Project_Name_And_Node.Node) = Canonical_Path_Name
 567          then
 568             if Extended then
 569
 570                if A_Project_Name_And_Node.Extended then
 571                   Error_Msg
 572                     ("cannot extend the same project file several times",
 573                      Token_Ptr);
 574
 575                else
 576                   Error_Msg
 577                     ("cannot extend an already imported project file",
 578                      Token_Ptr);
 579                end if;
 580
 581             elsif A_Project_Name_And_Node.Extended then
 582                --  If the imported project is an extended project A, and we are
 583                --  in an extended project, replace A with the ultimate project
 584                --  extending A.
 585
 586                if From_Extended then
 587                   declare
 588                      Decl : Project_Node_Id :=
 589                        Project_Declaration_Of
 590                          (A_Project_Name_And_Node.Node);
 591                      Prj : Project_Node_Id :=
 592                        Extending_Project_Of (Decl);
 593                   begin
 594                      loop
 595                         Decl := Project_Declaration_Of (Prj);
 596                         exit when Extending_Project_Of (Decl) = Empty_Node;
 597                         Prj := Extending_Project_Of (Decl);
 598                      end loop;
 599
 600                      A_Project_Name_And_Node.Node := Prj;
 601                   end;
 602                else
 603                   Error_Msg
 604                     ("cannot import an already extended project file",
 605                      Token_Ptr);
 606                end if;
 607             end if;
 608
 609             Project := A_Project_Name_And_Node.Node;
 610             Project_Stack.Decrement_Last;
 611             return;
 612          end if;
 613
 614          A_Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next;
 615       end loop;
 616
 617       --  We never encountered this project file
 618       --  Save the scan state, load the project file and start to scan it.
 619
 620       Save_Project_Scan_State (Project_Scan_State);
 621       Source_Index := Load_Project_File (Path_Name);
 622
 623       --  if we cannot find it, we stop
 624
 625       if Source_Index = No_Source_File then
 626          Project := Empty_Node;
 627          Project_Stack.Decrement_Last;
 628          return;
 629       end if;
 630
 631       Prj.Err.Scanner.Initialize_Scanner (Types.No_Unit, Source_Index);
 632       Scan;
 633
 634       if Name_From_Path = No_Name then
 635
 636          --  The project file name is not correct (no or bad extension,
 637          --  or not following Ada identifier's syntax).
 638
 639          Error_Msg_Name_1 := Canonical_Path_Name;
 640          Error_Msg ("?{ is not a valid path name for a project file",
 641                     Token_Ptr);
 642       end if;
 643
 644       if Current_Verbosity >= Medium then
 645          Write_Str  ("Parsing """);
 646          Write_Str  (Path_Name);
 647          Write_Char ('"');
 648          Write_Eol;
 649       end if;
 650
 651       Project_Directory := Immediate_Directory_Of (Normed_Path_Name);
 652       Project := Default_Project_Node (Of_Kind => N_Project);
 653       Project_Stack.Table (Project_Stack.Last).Id := Project;
 654       Set_Directory_Of (Project, Project_Directory);
 655       Set_Path_Name_Of (Project, Normed_Path_Name);
 656       Set_Location_Of (Project, Token_Ptr);
 657
 658       --  Is there any imported project?
 659
 660       Pre_Parse_Context_Clause (First_With);
 661
 662       Expect (Tok_Project, "PROJECT");
 663
 664       --  Mark location of PROJECT token if present
 665
 666       if Token = Tok_Project then
 667          Set_Location_Of (Project, Token_Ptr);
 668          Scan; -- scan past project
 669       end if;
 670
 671       --  Clear the Buffer
 672
 673       Buffer_Last := 0;
 674
 675       loop
 676          Expect (Tok_Identifier, "identifier");
 677
 678          --  If the token is not an identifier, clear the buffer before
 679          --  exiting to indicate that the name of the project is ill-formed.
 680
 681          if Token /= Tok_Identifier then
 682             Buffer_Last := 0;
 683             exit;
 684          end if;
 685
 686          --  Add the identifier name to the buffer
 687
 688          Get_Name_String (Token_Name);
 689          Add_To_Buffer (Name_Buffer (1 .. Name_Len));
 690
 691          --  Scan past the identifier
 692
 693          Scan;
 694
 695          --  If we have a dot, add a dot the the Buffer and look for the next
 696          --  identifier.
 697
 698          exit when Token /= Tok_Dot;
 699          Add_To_Buffer (".");
 700
 701          --  Scan past the dot
 702
 703          Scan;
 704       end loop;
 705
 706       --  If the name is well formed, Buffer_Last is > 0
 707
 708       if Buffer_Last > 0 then
 709
 710          --  The Buffer contains the name of the project
 711
 712          Name_Len := Buffer_Last;
 713          Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
 714          Name_Of_Project := Name_Find;
 715          Set_Name_Of (Project, Name_Of_Project);
 716
 717          --  To get expected name of the project file, replace dots by dashes
 718
 719          Name_Len := Buffer_Last;
 720          Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
 721
 722          for Index in 1 .. Name_Len loop
 723             if Name_Buffer (Index) = '.' then
 724                Name_Buffer (Index) := '-';
 725             end if;
 726          end loop;
 727
 728          Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
 729
 730          declare
 731             Expected_Name : constant Name_Id := Name_Find;
 732
 733          begin
 734             --  Output a warning if the actual name is not the expected name
 735
 736             if Name_From_Path /= No_Name
 737               and then Expected_Name /= Name_From_Path
 738             then
 739                Error_Msg_Name_1 := Expected_Name;
 740                Error_Msg ("?file name does not match unit name, " &
 741                           "should be `{" & Project_File_Extension & "`",
 742                           Token_Ptr);
 743             end if;
 744          end;
 745
 746          declare
 747             Imported_Projects : Project_Node_Id := Empty_Node;
 748
 749          begin
 750             Post_Parse_Context_Clause
 751               (Context_Clause    => First_With,
 752                Imported_Projects => Imported_Projects,
 753                Project_Directory => Project_Directory,
 754                From_Extended     => Extended);
 755             Set_First_With_Clause_Of (Project, Imported_Projects);
 756          end;
 757
 758          declare
 759             Project_Name : Name_Id :=
 760                              Tree_Private_Part.Projects_Htable.Get_First.Name;
 761
 762          begin
 763             --  Check if we already have a project with this name
 764
 765             while Project_Name /= No_Name
 766               and then Project_Name /= Name_Of_Project
 767             loop
 768                Project_Name := Tree_Private_Part.Projects_Htable.Get_Next.Name;
 769             end loop;
 770
 771             --  Report an error if we already have a project with this name
 772
 773             if Project_Name /= No_Name then
 774                Error_Msg ("duplicate project name", Token_Ptr);
 775
 776             else
 777                --  Otherwise, add the name of the project to the hash table, so
 778                --  that we can check that no other subsequent project will have
 779                --  the same name.
 780
 781                Tree_Private_Part.Projects_Htable.Set
 782                  (K => Name_Of_Project,
 783                   E => (Name     => Name_Of_Project,
 784                         Node     => Project,
 785                         Extended => Extended));
 786             end if;
 787          end;
 788
 789       end if;
 790
 791       if Token = Tok_Extends then
 792
 793          --  Make sure that gnatmake will use mapping files
 794
 795          Opt.Create_Mapping_File := True;
 796
 797          --  We are extending another project
 798
 799          Scan; -- scan past EXTENDS
 800          Expect (Tok_String_Literal, "literal string");
 801
 802          if Token = Tok_String_Literal then
 803             Set_Extended_Project_Path_Of (Project, Token_Name);
 804
 805             declare
 806                Original_Path_Name : constant String :=
 807                                       Get_Name_String (Token_Name);
 808
 809                Extended_Project_Path_Name : constant String :=
 810                                               Project_Path_Name_Of
 811                                                 (Original_Path_Name,
 812                                                    Get_Name_String
 813                                                      (Project_Directory));
 814
 815             begin
 816                if Extended_Project_Path_Name = "" then
 817
 818                   --  We could not find the project file to extend
 819
 820                   Error_Msg_Name_1 := Token_Name;
 821
 822                   Error_Msg ("unknown project file: {", Token_Ptr);
 823
 824                   --  If we are not in the main project file, display the
 825                   --  import path.
 826
 827                   if Project_Stack.Last > 1 then
 828                      Error_Msg_Name_1 :=
 829                        Project_Stack.Table (Project_Stack.Last).Name;
 830                      Error_Msg ("\extended by {", Token_Ptr);
 831
 832                      for Index in reverse 1 .. Project_Stack.Last - 1 loop
 833                         Error_Msg_Name_1 := Project_Stack.Table (Index).Name;
 834                         Error_Msg ("\imported by {", Token_Ptr);
 835                      end loop;
 836                   end if;
 837
 838                else
 839                   Parse_Single_Project
 840                     (Project       => Extended_Project,
 841                      Path_Name     => Extended_Project_Path_Name,
 842                      Extended      => True,
 843                      From_Extended => False);
 844                end if;
 845             end;
 846
 847             Scan; -- scan past the extended project path
 848          end if;
 849       end if;
 850
 851       --  Check that a project with a name including a dot either imports
 852       --  or extends the project whose name precedes the last dot.
 853
 854       if Name_Of_Project /= No_Name then
 855          Get_Name_String (Name_Of_Project);
 856
 857       else
 858          Name_Len := 0;
 859       end if;
 860
 861       --  Look for the last dot
 862
 863       while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop
 864          Name_Len := Name_Len - 1;
 865       end loop;
 866
 867       --  If a dot was find, check if the parent project is imported
 868       --  or extended.
 869
 870       if Name_Len > 0 then
 871          Name_Len := Name_Len - 1;
 872
 873          declare
 874             Parent_Name  : constant Name_Id := Name_Find;
 875             Parent_Found : Boolean := False;
 876             With_Clause  : Project_Node_Id := First_With_Clause_Of (Project);
 877
 878          begin
 879             --  If there is an extended project, check its name
 880
 881             if Extended_Project /= Empty_Node then
 882                Parent_Found := Name_Of (Extended_Project) = Parent_Name;
 883             end if;
 884
 885             --  If the parent project is not the extended project,
 886             --  check each imported project until we find the parent project.
 887
 888             while not Parent_Found and then With_Clause /= Empty_Node loop
 889                Parent_Found := Name_Of (Project_Node_Of (With_Clause))
 890                  = Parent_Name;
 891                With_Clause := Next_With_Clause_Of (With_Clause);
 892             end loop;
 893
 894             --  If the parent project was not found, report an error
 895
 896             if not Parent_Found then
 897                Error_Msg_Name_1 := Name_Of_Project;
 898                Error_Msg_Name_2 := Parent_Name;
 899                Error_Msg ("project { does not import or extend project {",
 900                           Location_Of (Project));
 901             end if;
 902          end;
 903       end if;
 904
 905       Expect (Tok_Is, "IS");
 906
 907       declare
 908          Project_Declaration : Project_Node_Id := Empty_Node;
 909
 910       begin
 911          --  No need to Scan past "is", Prj.Dect.Parse will do it.
 912
 913          Prj.Dect.Parse
 914            (Declarations    => Project_Declaration,
 915             Current_Project => Project,
 916             Extends         => Extended_Project);
 917          Set_Project_Declaration_Of (Project, Project_Declaration);
 918
 919          if Extended_Project /= Empty_Node then
 920             Set_Extending_Project_Of
 921               (Project_Declaration_Of (Extended_Project), To => Project);
 922          end if;
 923       end;
 924
 925       Expect (Tok_End, "END");
 926
 927       --  Skip "end" if present
 928
 929       if Token = Tok_End then
 930          Scan;
 931       end if;
 932
 933       --  Clear the Buffer
 934
 935       Buffer_Last := 0;
 936
 937       --  Store the name following "end" in the Buffer. The name may be made of
 938       --  several simple names.
 939
 940       loop
 941          Expect (Tok_Identifier, "identifier");
 942
 943          --  If we don't have an identifier, clear the buffer before exiting to
 944          --  avoid checking the name.
 945
 946          if Token /= Tok_Identifier then
 947             Buffer_Last := 0;
 948             exit;
 949          end if;
 950
 951          --  Add the identifier to the Buffer
 952          Get_Name_String (Token_Name);
 953          Add_To_Buffer (Name_Buffer (1 .. Name_Len));
 954
 955          --  Scan past the identifier
 956
 957          Scan;
 958          exit when Token /= Tok_Dot;
 959          Add_To_Buffer (".");
 960          Scan;
 961       end loop;
 962
 963       --  If we have a valid name, check if it is the name of the project
 964
 965       if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
 966          if To_Lower (Buffer (1 .. Buffer_Last)) /=
 967             Get_Name_String (Name_Of (Project))
 968          then
 969             --  Invalid name: report an error
 970
 971             Error_Msg ("Expected """ &
 972                        Get_Name_String (Name_Of (Project)) & """",
 973                        Token_Ptr);
 974          end if;
 975       end if;
 976
 977       Expect (Tok_Semicolon, "`;`");
 978
 979       --  Check that there is no more text following the end of the project
 980       --  source.
 981
 982       if Token = Tok_Semicolon then
 983          Scan;
 984
 985          if Token /= Tok_EOF then
 986             Error_Msg
 987               ("Unexpected text following end of project", Token_Ptr);
 988          end if;
 989       end if;
 990
 991       --  Restore the scan state, in case we are not the main project
 992
 993       Restore_Project_Scan_State (Project_Scan_State);
 994
 995       --  And remove the project from the project stack
 996
 997       Project_Stack.Decrement_Last;
 998    end Parse_Single_Project;
 999
1000    -----------------------
1001    -- Project_Name_From --
1002    -----------------------
1003
1004    function Project_Name_From (Path_Name : String) return Name_Id is
1005       Canonical : String (1 .. Path_Name'Length) := Path_Name;
1006       First : Natural := Canonical'Last;
1007       Last  : Natural := First;
1008       Index : Positive;
1009
1010    begin
1011       if Current_Verbosity = High then
1012          Write_Str ("Project_Name_From (""");
1013          Write_Str (Canonical);
1014          Write_Line (""")");
1015       end if;
1016
1017       --  If the path name is empty, return No_Name to indicate failure
1018
1019       if First = 0 then
1020          return No_Name;
1021       end if;
1022
1023       Canonical_Case_File_Name (Canonical);
1024
1025       --  Look for the last dot in the path name
1026
1027       while First > 0
1028         and then
1029         Canonical (First) /= '.'
1030       loop
1031          First := First - 1;
1032       end loop;
1033
1034       --  If we have a dot, check that it is followed by the correct extension
1035
1036       if First > 0 and then Canonical (First) = '.' then
1037          if Canonical (First .. Last) = Project_File_Extension
1038            and then First /= 1
1039          then
1040             --  Look for the last directory separator, if any
1041
1042             First := First - 1;
1043             Last := First;
1044
1045             while First > 0
1046               and then Canonical (First) /= '/'
1047               and then Canonical (First) /= Dir_Sep
1048             loop
1049                First := First - 1;
1050             end loop;
1051
1052          else
1053             --  Not the correct extension, return No_Name to indicate failure
1054
1055             return No_Name;
1056          end if;
1057
1058       --  If no dot in the path name, return No_Name to indicate failure
1059
1060       else
1061          return No_Name;
1062       end if;
1063
1064       First := First + 1;
1065
1066       --  If the extension is the file name, return No_Name to indicate failure
1067
1068       if First > Last then
1069          return No_Name;
1070       end if;
1071
1072       --  Put the name in lower case into Name_Buffer
1073
1074       Name_Len := Last - First + 1;
1075       Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
1076
1077       Index := 1;
1078
1079       --  Check if it is a well formed project name. Return No_Name if it is
1080       --  ill formed.
1081
1082       loop
1083          if not Is_Letter (Name_Buffer (Index)) then
1084             return No_Name;
1085
1086          else
1087             loop
1088                Index := Index + 1;
1089
1090                exit when Index >= Name_Len;
1091
1092                if Name_Buffer (Index) = '_' then
1093                   if Name_Buffer (Index + 1) = '_' then
1094                      return No_Name;
1095                   end if;
1096                end if;
1097
1098                exit when Name_Buffer (Index) = '-';
1099
1100                if Name_Buffer (Index) /= '_'
1101                  and then not Is_Alphanumeric (Name_Buffer (Index))
1102                then
1103                   return No_Name;
1104                end if;
1105
1106             end loop;
1107          end if;
1108
1109          if Index >= Name_Len then
1110             if Is_Alphanumeric (Name_Buffer (Name_Len)) then
1111
1112                --  All checks have succeeded. Return name in Name_Buffer
1113
1114                return Name_Find;
1115
1116             else
1117                return No_Name;
1118             end if;
1119
1120          elsif Name_Buffer (Index) = '-' then
1121             Index := Index + 1;
1122          end if;
1123       end loop;
1124    end Project_Name_From;
1125
1126    --------------------------
1127    -- Project_Path_Name_Of --
1128    --------------------------
1129
1130    function Project_Path_Name_Of
1131      (Project_File_Name : String;
1132       Directory         : String)
1133       return              String
1134    is
1135       Result : String_Access;
1136
1137    begin
1138       if Current_Verbosity = High then
1139          Write_Str  ("Project_Path_Name_Of (""");
1140          Write_Str  (Project_File_Name);
1141          Write_Str  (""", """);
1142          Write_Str  (Directory);
1143          Write_Line (""");");
1144       end if;
1145
1146       if not Is_Absolute_Path (Project_File_Name) then
1147          --  First we try <directory>/<file_name>.<extension>
1148
1149          if Current_Verbosity = High then
1150             Write_Str  ("   Trying ");
1151             Write_Str  (Directory);
1152             Write_Char (Directory_Separator);
1153             Write_Str (Project_File_Name);
1154             Write_Line (Project_File_Extension);
1155          end if;
1156
1157          Result :=
1158            Locate_Regular_File
1159            (File_Name => Directory & Directory_Separator &
1160               Project_File_Name & Project_File_Extension,
1161             Path      => Project_Path.all);
1162
1163          --  Then we try <directory>/<file_name>
1164
1165          if Result = null then
1166             if Current_Verbosity = High then
1167                Write_Str  ("   Trying ");
1168                Write_Str  (Directory);
1169                Write_Char (Directory_Separator);
1170                Write_Line (Project_File_Name);
1171             end if;
1172
1173             Result :=
1174               Locate_Regular_File
1175               (File_Name => Directory & Directory_Separator &
1176                  Project_File_Name,
1177                Path      => Project_Path.all);
1178          end if;
1179       end if;
1180
1181       if Result = null then
1182
1183          --  Then we try <file_name>.<extension>
1184
1185          if Current_Verbosity = High then
1186             Write_Str  ("   Trying ");
1187             Write_Str (Project_File_Name);
1188             Write_Line (Project_File_Extension);
1189          end if;
1190
1191          Result :=
1192            Locate_Regular_File
1193            (File_Name => Project_File_Name & Project_File_Extension,
1194             Path      => Project_Path.all);
1195       end if;
1196
1197       if Result = null then
1198
1199          --  Then we try <file_name>
1200
1201          if Current_Verbosity = High then
1202             Write_Str  ("   Trying ");
1203             Write_Line  (Project_File_Name);
1204          end if;
1205
1206          Result :=
1207            Locate_Regular_File
1208            (File_Name => Project_File_Name,
1209             Path      => Project_Path.all);
1210       end if;
1211
1212       --  If we cannot find the project file, we return an empty string
1213
1214       if Result = null then
1215          return "";
1216
1217       else
1218          declare
1219             Final_Result : String :=
1220                              GNAT.OS_Lib.Normalize_Pathname (Result.all);
1221          begin
1222             Free (Result);
1223             Canonical_Case_File_Name (Final_Result);
1224             return Final_Result;
1225          end;
1226       end if;
1227    end Project_Path_Name_Of;
1228
1229 begin
1230    --  Initialize Project_Path during package elaboration
1231
1232    if Prj_Path.all = "" then
1233       Project_Path := new String'(".");
1234    else
1235       Project_Path := new String'("." & Path_Separator & Prj_Path.all);
1236    end if;
1237 end Prj.Part;