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