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