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