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