OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [prj-part.adb] - Rev 281

Compare with Previous | Blame | View Log

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             P R J . P A R T                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2001-2009, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
with Err_Vars; use Err_Vars;
with Opt;      use Opt;
with Osint;    use Osint;
with Output;   use Output;
with Prj.Com;  use Prj.Com;
with Prj.Dect;
with Prj.Err;  use Prj.Err;
with Prj.Ext;  use Prj.Ext;
with Sinput;   use Sinput;
with Sinput.P; use Sinput.P;
with Snames;
with Table;
 
with Ada.Characters.Handling;    use Ada.Characters.Handling;
with Ada.Exceptions;             use Ada.Exceptions;
 
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
 
with System.HTable;              use System.HTable;
 
package body Prj.Part is
 
   Buffer      : String_Access;
   Buffer_Last : Natural := 0;
 
   Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
 
   ------------------------------------
   -- Local Packages and Subprograms --
   ------------------------------------
 
   type With_Id is new Nat;
   No_With : constant With_Id := 0;
 
   type With_Record is record
      Path         : Path_Name_Type;
      Location     : Source_Ptr;
      Limited_With : Boolean;
      Node         : Project_Node_Id;
      Next         : With_Id;
   end record;
   --  Information about an imported project, to be put in table Withs below
 
   package Withs is new Table.Table
     (Table_Component_Type => With_Record,
      Table_Index_Type     => With_Id,
      Table_Low_Bound      => 1,
      Table_Initial        => 10,
      Table_Increment      => 100,
      Table_Name           => "Prj.Part.Withs");
   --  Table used to store temporarily paths and locations of imported
   --  projects. These imported projects will be effectively parsed later: just
   --  before parsing the current project for the non limited withed projects,
   --  after getting its name; after complete parsing of the current project
   --  for the limited withed projects.
 
   type Names_And_Id is record
      Path_Name           : Path_Name_Type;
      Canonical_Path_Name : Path_Name_Type;
      Id                  : Project_Node_Id;
      Limited_With        : Boolean;
   end record;
 
   package Project_Stack is new Table.Table
     (Table_Component_Type => Names_And_Id,
      Table_Index_Type     => Nat,
      Table_Low_Bound      => 1,
      Table_Initial        => 10,
      Table_Increment      => 100,
      Table_Name           => "Prj.Part.Project_Stack");
   --  This table is used to detect circular dependencies
   --  for imported and extended projects and to get the project ids of
   --  limited imported projects when there is a circularity with at least
   --  one limited imported project file.
 
   package Virtual_Hash is new System.HTable.Simple_HTable
     (Header_Num => Header_Num,
      Element    => Project_Node_Id,
      No_Element => Empty_Node,
      Key        => Project_Node_Id,
      Hash       => Prj.Tree.Hash,
      Equal      => "=");
   --  Hash table to store the node id of the project for which a virtual
   --  extending project need to be created.
 
   package Processed_Hash is new System.HTable.Simple_HTable
     (Header_Num => Header_Num,
      Element    => Boolean,
      No_Element => False,
      Key        => Project_Node_Id,
      Hash       => Prj.Tree.Hash,
      Equal      => "=");
   --  Hash table to store the project process when looking for project that
   --  need to have a virtual extending project, to avoid processing the same
   --  project twice.
 
   package Projects_Paths is new System.HTable.Simple_HTable
     (Header_Num => Header_Num,
      Element    => Path_Name_Type,
      No_Element => No_Path,
      Key        => Name_Id,
      Hash       => Hash,
      Equal      => "=");
   --  Hash table to cache project path to avoid looking for them on the path
 
   procedure Create_Virtual_Extending_Project
     (For_Project  : Project_Node_Id;
      Main_Project : Project_Node_Id;
      In_Tree      : Project_Node_Tree_Ref);
   --  Create a virtual extending project of For_Project. Main_Project is
   --  the extending all project.
   --
   --  The String_Value_Of is not set for the automatically added with
   --  clause and keeps the default value of No_Name. This enables Prj.PP
   --  to skip these automatically added with clauses to be processed.
 
   procedure Look_For_Virtual_Projects_For
     (Proj                : Project_Node_Id;
      In_Tree             : Project_Node_Tree_Ref;
      Potentially_Virtual : Boolean);
   --  Look for projects that need to have a virtual extending project.
   --  This procedure is recursive. If called with Potentially_Virtual set to
   --  True, then Proj may need an virtual extending project; otherwise it
   --  does not (because it is already extended), but other projects that it
   --  imports may need to be virtually extended.
 
   type Extension_Origin is (None, Extending_Simple, Extending_All);
   --  Type of parameter From_Extended for procedures Parse_Single_Project and
   --  Post_Parse_Context_Clause. Extending_All means that we are parsing the
   --  tree rooted at an extending all project.
 
   procedure Parse_Single_Project
     (In_Tree           : Project_Node_Tree_Ref;
      Project           : out Project_Node_Id;
      Extends_All       : out Boolean;
      Path_Name         : String;
      Extended          : Boolean;
      From_Extended     : Extension_Origin;
      In_Limited        : Boolean;
      Packages_To_Check : String_List_Access;
      Depth             : Natural;
      Current_Dir       : String;
      Is_Config_File    : Boolean;
      Flags             : Processing_Flags);
   --  Parse a project file. This is a recursive procedure: it calls itself for
   --  imported and extended projects. When From_Extended is not None, if the
   --  project has already been parsed and is an extended project A, return the
   --  ultimate (not extended) project that extends A. When In_Limited is True,
   --  the importing path includes at least one "limited with". When parsing
   --  configuration projects, do not allow a depth > 1.
   --
   --  Is_Config_File should be set to True if the project represents a config
   --  file (.cgpr) since some specific checks apply.
 
   procedure Pre_Parse_Context_Clause
     (In_Tree        : Project_Node_Tree_Ref;
      Context_Clause : out With_Id;
      Is_Config_File : Boolean;
      Flags          : Processing_Flags);
   --  Parse the context clause of a project. Store the paths and locations of
   --  the imported projects in table Withs. Does nothing if there is no
   --  context clause (if the current token is not "with" or "limited" followed
   --  by "with").
   --  Is_Config_File should be set to True if the project represents a config
   --  file (.cgpr) since some specific checks apply.
 
   procedure Post_Parse_Context_Clause
     (Context_Clause    : With_Id;
      In_Tree           : Project_Node_Tree_Ref;
      Limited_Withs     : Boolean;
      Imported_Projects : in out Project_Node_Id;
      Project_Directory : Path_Name_Type;
      From_Extended     : Extension_Origin;
      In_Limited        : Boolean;
      Packages_To_Check : String_List_Access;
      Depth             : Natural;
      Current_Dir       : String;
      Is_Config_File    : Boolean;
      Flags             : Processing_Flags);
   --  Parse the imported projects that have been stored in table Withs, if
   --  any. From_Extended is used for the call to Parse_Single_Project below.
   --  When In_Limited is True, the importing path includes at least one
   --  "limited with". When Limited_Withs is False, only non limited withed
   --  projects are parsed. When Limited_Withs is True, only limited withed
   --  projects are parsed.
   --  Is_Config_File should be set to True if the project represents a config
   --  file (.cgpr) since some specific checks apply.
 
   function Project_Path_Name_Of
     (In_Tree           : Project_Node_Tree_Ref;
      Project_File_Name : String;
      Directory         : String) return String;
   --  Returns the path name of a project file. Returns an empty string
   --  if project file cannot be found.
 
   function Project_Name_From
     (Path_Name      : String;
      Is_Config_File : Boolean) return Name_Id;
   --  Returns the name of the project that corresponds to its path name.
   --  Returns No_Name if the path name is invalid, because the corresponding
   --  project name does not have the syntax of an ada identifier.
 
   --------------------------------------
   -- Create_Virtual_Extending_Project --
   --------------------------------------
 
   procedure Create_Virtual_Extending_Project
     (For_Project  : Project_Node_Id;
      Main_Project : Project_Node_Id;
      In_Tree      : Project_Node_Tree_Ref)
   is
 
      Virtual_Name : constant String :=
                       Virtual_Prefix &
                         Get_Name_String (Name_Of (For_Project, In_Tree));
      --  The name of the virtual extending project
 
      Virtual_Name_Id : Name_Id;
      --  Virtual extending project name id
 
      Virtual_Path_Id : Path_Name_Type;
      --  Fake path name of the virtual extending project. The directory is
      --  the same directory as the extending all project.
 
      --  The source of the virtual extending project is something like:
 
      --  project V$<project name> extends <project path> is
 
      --     for Source_Dirs use ();
 
      --  end V$<project name>;
 
      --  The project directory cannot be specified during parsing; it will be
      --  put directly in the virtual extending project data during processing.
 
      --  Nodes that made up the virtual extending project
 
      Virtual_Project         : Project_Node_Id;
      With_Clause             : constant Project_Node_Id :=
                                  Default_Project_Node
                                    (In_Tree, N_With_Clause);
      Project_Declaration     : Project_Node_Id;
      Source_Dirs_Declaration : constant Project_Node_Id :=
                                  Default_Project_Node
                                    (In_Tree, N_Declarative_Item);
      Source_Dirs_Attribute   : constant Project_Node_Id :=
                                  Default_Project_Node
                                    (In_Tree, N_Attribute_Declaration, List);
      Source_Dirs_Expression  : constant Project_Node_Id :=
                                  Default_Project_Node
                                    (In_Tree, N_Expression, List);
      Source_Dirs_Term        : constant Project_Node_Id :=
                                  Default_Project_Node
                                    (In_Tree, N_Term, List);
      Source_Dirs_List        : constant Project_Node_Id :=
                                  Default_Project_Node
                                    (In_Tree, N_Literal_String_List, List);
 
   begin
      --  Get the virtual path name
 
      Get_Name_String (Path_Name_Of (Main_Project, In_Tree));
 
      while Name_Len > 0
        and then Name_Buffer (Name_Len) /= Directory_Separator
        and then Name_Buffer (Name_Len) /= '/'
      loop
         Name_Len := Name_Len - 1;
      end loop;
 
      Name_Buffer (Name_Len + 1 .. Name_Len + Virtual_Name'Length) :=
        Virtual_Name;
      Name_Len := Name_Len + Virtual_Name'Length;
      Virtual_Path_Id := Name_Find;
 
      --  Get the virtual name id
 
      Name_Len := Virtual_Name'Length;
      Name_Buffer (1 .. Name_Len) := Virtual_Name;
      Virtual_Name_Id := Name_Find;
 
      Virtual_Project := Create_Project
        (In_Tree        => In_Tree,
         Name           => Virtual_Name_Id,
         Full_Path      => Virtual_Path_Id,
         Is_Config_File => False);
 
      Project_Declaration := Project_Declaration_Of (Virtual_Project, In_Tree);
 
      --  With clause
 
      Set_Name_Of (With_Clause, In_Tree, Virtual_Name_Id);
      Set_Path_Name_Of (With_Clause, In_Tree, Virtual_Path_Id);
      Set_Project_Node_Of (With_Clause, In_Tree, Virtual_Project);
      Set_Next_With_Clause_Of
        (With_Clause, In_Tree, First_With_Clause_Of (Main_Project, In_Tree));
      Set_First_With_Clause_Of (Main_Project, In_Tree, With_Clause);
 
      --  Virtual project node
 
      Set_Location_Of
        (Virtual_Project, In_Tree, Location_Of (Main_Project, In_Tree));
      Set_Extended_Project_Path_Of
        (Virtual_Project, In_Tree, Path_Name_Of (For_Project, In_Tree));
 
      --  Project declaration
 
      Set_First_Declarative_Item_Of
        (Project_Declaration, In_Tree, Source_Dirs_Declaration);
      Set_Extended_Project_Of (Project_Declaration, In_Tree, For_Project);
 
      --  Source_Dirs declaration
 
      Set_Current_Item_Node
        (Source_Dirs_Declaration, In_Tree, Source_Dirs_Attribute);
 
      --  Source_Dirs attribute
 
      Set_Name_Of (Source_Dirs_Attribute, In_Tree, Snames.Name_Source_Dirs);
      Set_Expression_Of
        (Source_Dirs_Attribute, In_Tree, Source_Dirs_Expression);
 
      --  Source_Dirs expression
 
      Set_First_Term (Source_Dirs_Expression, In_Tree, Source_Dirs_Term);
 
      --  Source_Dirs term
 
      Set_Current_Term (Source_Dirs_Term, In_Tree, Source_Dirs_List);
 
      --  Source_Dirs empty list: nothing to do
   end Create_Virtual_Extending_Project;
 
   -----------------------------------
   -- Look_For_Virtual_Projects_For --
   -----------------------------------
 
   procedure Look_For_Virtual_Projects_For
     (Proj                : Project_Node_Id;
      In_Tree             : Project_Node_Tree_Ref;
      Potentially_Virtual : Boolean)
   is
      Declaration : Project_Node_Id := Empty_Node;
      --  Node for the project declaration of Proj
 
      With_Clause : Project_Node_Id := Empty_Node;
      --  Node for a with clause of Proj
 
      Imported    : Project_Node_Id := Empty_Node;
      --  Node for a project imported by Proj
 
      Extended    : Project_Node_Id := Empty_Node;
      --  Node for the eventual project extended by Proj
 
   begin
      --  Nothing to do if Proj is not defined or if it has already been
      --  processed.
 
      if Present (Proj) and then not Processed_Hash.Get (Proj) then
         --  Make sure the project will not be processed again
 
         Processed_Hash.Set (Proj, True);
 
         Declaration := Project_Declaration_Of (Proj, In_Tree);
 
         if Present (Declaration) then
            Extended := Extended_Project_Of (Declaration, In_Tree);
         end if;
 
         --  If this is a project that may need a virtual extending project
         --  and it is not itself an extending project, put it in the list.
 
         if Potentially_Virtual and then No (Extended) then
            Virtual_Hash.Set (Proj, Proj);
         end if;
 
         --  Now check the projects it imports
 
         With_Clause := First_With_Clause_Of (Proj, In_Tree);
 
         while Present (With_Clause) loop
            Imported := Project_Node_Of (With_Clause, In_Tree);
 
            if Present (Imported) then
               Look_For_Virtual_Projects_For
                 (Imported, In_Tree, Potentially_Virtual => True);
            end if;
 
            With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
         end loop;
 
         --  Check also the eventual project extended by Proj. As this project
         --  is already extended, call recursively with Potentially_Virtual
         --  being False.
 
         Look_For_Virtual_Projects_For
           (Extended, In_Tree, Potentially_Virtual => False);
      end if;
   end Look_For_Virtual_Projects_For;
 
   -----------
   -- Parse --
   -----------
 
   procedure Parse
     (In_Tree                : Project_Node_Tree_Ref;
      Project                : out Project_Node_Id;
      Project_File_Name      : String;
      Always_Errout_Finalize : Boolean;
      Packages_To_Check      : String_List_Access := All_Packages;
      Store_Comments         : Boolean := False;
      Current_Directory      : String := "";
      Is_Config_File         : Boolean;
      Flags                  : Processing_Flags)
   is
      Dummy : Boolean;
      pragma Warnings (Off, Dummy);
 
      Real_Project_File_Name : String_Access :=
                                 Osint.To_Canonical_File_Spec
                                   (Project_File_Name);
 
   begin
      if Real_Project_File_Name = null then
         Real_Project_File_Name := new String'(Project_File_Name);
      end if;
 
      Project := Empty_Node;
 
      Projects_Paths.Reset;
 
      if Current_Verbosity >= Medium then
         Write_Str ("GPR_PROJECT_PATH=""");
         Write_Str (Project_Path (In_Tree));
         Write_Line ("""");
      end if;
 
      declare
         Path_Name : constant String :=
                       Project_Path_Name_Of (In_Tree,
                                             Real_Project_File_Name.all,
                                             Directory   => Current_Directory);
 
      begin
         Free (Real_Project_File_Name);
 
         Prj.Err.Initialize;
         Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
         Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
 
         --  Parse the main project file
 
         if Path_Name = "" then
            Prj.Com.Fail
              ("project file """
               & Project_File_Name
               & """ not found in "
               & Project_Path (In_Tree));
            Project := Empty_Node;
            return;
         end if;
 
         begin
            Parse_Single_Project
              (In_Tree           => In_Tree,
               Project           => Project,
               Extends_All       => Dummy,
               Path_Name         => Path_Name,
               Extended          => False,
               From_Extended     => None,
               In_Limited        => False,
               Packages_To_Check => Packages_To_Check,
               Depth             => 0,
               Current_Dir       => Current_Directory,
               Is_Config_File    => Is_Config_File,
               Flags             => Flags);
 
         exception
            when Types.Unrecoverable_Error =>
               --  Unrecoverable_Error is raised when a line is too long.
               --  A meaningful error message will be displayed later.
               Project := Empty_Node;
         end;
 
         --  If Project is an extending-all project, create the eventual
         --  virtual extending projects and check that there are no illegally
         --  imported projects.
 
         if Present (Project)
           and then Is_Extending_All (Project, In_Tree)
         then
            --  First look for projects that potentially need a virtual
            --  extending project.
 
            Virtual_Hash.Reset;
            Processed_Hash.Reset;
 
            --  Mark the extending all project as processed, to avoid checking
            --  the imported projects in case of a "limited with" on this
            --  extending all project.
 
            Processed_Hash.Set (Project, True);
 
            declare
               Declaration : constant Project_Node_Id :=
                               Project_Declaration_Of (Project, In_Tree);
            begin
               Look_For_Virtual_Projects_For
                 (Extended_Project_Of (Declaration, In_Tree), In_Tree,
                  Potentially_Virtual => False);
            end;
 
            --  Now, check the projects directly imported by the main project.
            --  Remove from the potentially virtual any project extended by one
            --  of these imported projects. For non extending imported
            --  projects, check that they do not belong to the project tree of
            --  the project being "extended-all" by the main project.
 
            declare
               With_Clause : Project_Node_Id;
               Imported    : Project_Node_Id := Empty_Node;
               Declaration : Project_Node_Id := Empty_Node;
 
            begin
               With_Clause := First_With_Clause_Of (Project, In_Tree);
               while Present (With_Clause) loop
                  Imported := Project_Node_Of (With_Clause, In_Tree);
 
                  if Present (Imported) then
                     Declaration := Project_Declaration_Of (Imported, In_Tree);
 
                     if Extended_Project_Of (Declaration, In_Tree) /=
                               Empty_Node
                     then
                        loop
                           Imported :=
                             Extended_Project_Of (Declaration, In_Tree);
                           exit when No (Imported);
                           Virtual_Hash.Remove (Imported);
                           Declaration :=
                             Project_Declaration_Of (Imported, In_Tree);
                        end loop;
                     end if;
                  end if;
 
                  With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
               end loop;
            end;
 
            --  Now create all the virtual extending projects
 
            declare
               Proj : Project_Node_Id := Virtual_Hash.Get_First;
            begin
               while Present (Proj) loop
                  Create_Virtual_Extending_Project (Proj, Project, In_Tree);
                  Proj := Virtual_Hash.Get_Next;
               end loop;
            end;
         end if;
 
         --  If there were any kind of error during the parsing, serious
         --  or not, then the parsing fails.
 
         if Err_Vars.Total_Errors_Detected > 0 then
            Project := Empty_Node;
         end if;
 
         if No (Project) or else Always_Errout_Finalize then
            Prj.Err.Finalize;
 
            --  Reinitialize to avoid duplicate warnings later on
 
            Prj.Err.Initialize;
         end if;
      end;
 
   exception
      when X : others =>
 
         --  Internal error
 
         Write_Line (Exception_Information (X));
         Write_Str  ("Exception ");
         Write_Str  (Exception_Name (X));
         Write_Line (" raised, while processing project file");
         Project := Empty_Node;
   end Parse;
 
   ------------------------------
   -- Pre_Parse_Context_Clause --
   ------------------------------
 
   procedure Pre_Parse_Context_Clause
     (In_Tree        : Project_Node_Tree_Ref;
      Context_Clause : out With_Id;
      Is_Config_File : Boolean;
      Flags          : Processing_Flags)
   is
      Current_With_Clause : With_Id := No_With;
      Limited_With        : Boolean := False;
      Current_With        : With_Record;
      Current_With_Node   : Project_Node_Id := Empty_Node;
 
   begin
      --  Assume no context clause
 
      Context_Clause := No_With;
      With_Loop :
 
      --  If Token is not WITH or LIMITED, there is no context clause, or we
      --  have exhausted the with clauses.
 
      while Token = Tok_With or else Token = Tok_Limited loop
         Current_With_Node :=
           Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree);
         Limited_With := Token = Tok_Limited;
 
         if Is_Config_File then
            Error_Msg
              (Flags,
               "configuration project cannot import " &
               "other configuration projects",
               Token_Ptr);
         end if;
 
         if Limited_With then
            Scan (In_Tree);  --  scan past LIMITED
            Expect (Tok_With, "WITH");
            exit With_Loop when Token /= Tok_With;
         end if;
 
         Comma_Loop :
         loop
            Scan (In_Tree); -- past WITH or ","
 
            Expect (Tok_String_Literal, "literal string");
 
            if Token /= Tok_String_Literal then
               return;
            end if;
 
            --  Store path and location in table Withs
 
            Current_With :=
              (Path         => Path_Name_Type (Token_Name),
               Location     => Token_Ptr,
               Limited_With => Limited_With,
               Node         => Current_With_Node,
               Next         => No_With);
 
            Withs.Increment_Last;
            Withs.Table (Withs.Last) := Current_With;
 
            if Current_With_Clause = No_With then
               Context_Clause := Withs.Last;
 
            else
               Withs.Table (Current_With_Clause).Next := Withs.Last;
            end if;
 
            Current_With_Clause := Withs.Last;
 
            Scan (In_Tree);
 
            if Token = Tok_Semicolon then
               Set_End_Of_Line (Current_With_Node);
               Set_Previous_Line_Node (Current_With_Node);
 
               --  End of (possibly multiple) with clause;
 
               Scan (In_Tree); -- past the semicolon
               exit Comma_Loop;
 
            elsif Token = Tok_Comma then
               Set_Is_Not_Last_In_List (Current_With_Node, In_Tree);
 
            else
               Error_Msg (Flags, "expected comma or semi colon", Token_Ptr);
               exit Comma_Loop;
            end if;
 
            Current_With_Node :=
              Default_Project_Node
                (Of_Kind => N_With_Clause, In_Tree => In_Tree);
         end loop Comma_Loop;
      end loop With_Loop;
   end Pre_Parse_Context_Clause;
 
   -------------------------------
   -- Post_Parse_Context_Clause --
   -------------------------------
 
   procedure Post_Parse_Context_Clause
     (Context_Clause    : With_Id;
      In_Tree           : Project_Node_Tree_Ref;
      Limited_Withs     : Boolean;
      Imported_Projects : in out Project_Node_Id;
      Project_Directory : Path_Name_Type;
      From_Extended     : Extension_Origin;
      In_Limited        : Boolean;
      Packages_To_Check : String_List_Access;
      Depth             : Natural;
      Current_Dir       : String;
      Is_Config_File    : Boolean;
      Flags             : Processing_Flags)
   is
      Current_With_Clause : With_Id := Context_Clause;
 
      Current_Project  : Project_Node_Id := Imported_Projects;
      Previous_Project : Project_Node_Id := Empty_Node;
      Next_Project     : Project_Node_Id := Empty_Node;
 
      Project_Directory_Path : constant String :=
                                 Get_Name_String (Project_Directory);
 
      Current_With : With_Record;
      Extends_All  : Boolean := False;
 
   begin
      --  Set Current_Project to the last project in the current list, if the
      --  list is not empty.
 
      if Present (Current_Project) then
         while
           Present (Next_With_Clause_Of (Current_Project, In_Tree))
         loop
            Current_Project := Next_With_Clause_Of (Current_Project, In_Tree);
         end loop;
      end if;
 
      while Current_With_Clause /= No_With loop
         Current_With := Withs.Table (Current_With_Clause);
         Current_With_Clause := Current_With.Next;
 
         if Limited_Withs = Current_With.Limited_With then
            declare
               Original_Path : constant String :=
                                 Get_Name_String (Current_With.Path);
 
               Imported_Path_Name : constant String :=
                                      Project_Path_Name_Of
                                        (In_Tree,
                                         Original_Path,
                                         Project_Directory_Path);
 
               Resolved_Path : constant String :=
                                 Normalize_Pathname
                                   (Imported_Path_Name,
                                    Directory      => Current_Dir,
                                    Resolve_Links  =>
                                      Opt.Follow_Links_For_Files,
                                    Case_Sensitive => True);
 
               Withed_Project : Project_Node_Id := Empty_Node;
 
            begin
               if Imported_Path_Name = "" then
 
                  --  The project file cannot be found
 
                  Error_Msg_File_1 := File_Name_Type (Current_With.Path);
                  Error_Msg
                    (Flags, "unknown project file: {", Current_With.Location);
 
                  --  If this is not imported by the main project file, display
                  --  the import path.
 
                  if Project_Stack.Last > 1 then
                     for Index in reverse 1 .. Project_Stack.Last loop
                        Error_Msg_File_1 :=
                          File_Name_Type
                            (Project_Stack.Table (Index).Path_Name);
                        Error_Msg
                          (Flags, "\imported by {", Current_With.Location);
                     end loop;
                  end if;
 
               else
                  --  New with clause
 
                  Previous_Project := Current_Project;
 
                  if No (Current_Project) then
 
                     --  First with clause of the context clause
 
                     Current_Project := Current_With.Node;
                     Imported_Projects := Current_Project;
 
                  else
                     Next_Project := Current_With.Node;
                     Set_Next_With_Clause_Of
                       (Current_Project, In_Tree, Next_Project);
                     Current_Project := Next_Project;
                  end if;
 
                  Set_String_Value_Of
                    (Current_Project,
                     In_Tree,
                     Name_Id (Current_With.Path));
                  Set_Location_Of
                    (Current_Project, In_Tree, Current_With.Location);
 
                  --  If it is a limited with, check if we have a circularity.
                  --  If we have one, get the project id of the limited
                  --  imported project file, and do not parse it.
 
                  if Limited_Withs and then Project_Stack.Last > 1 then
                     declare
                        Canonical_Path_Name : Path_Name_Type;
 
                     begin
                        Name_Len := Resolved_Path'Length;
                        Name_Buffer (1 .. Name_Len) := Resolved_Path;
                        Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
                        Canonical_Path_Name := Name_Find;
 
                        for Index in 1 .. Project_Stack.Last loop
                           if Project_Stack.Table (Index).Canonical_Path_Name =
                             Canonical_Path_Name
                           then
                              --  We have found the limited imported project,
                              --  get its project id, and do not parse it.
 
                              Withed_Project := Project_Stack.Table (Index).Id;
                              exit;
                           end if;
                        end loop;
                     end;
                  end if;
 
                  --  Parse the imported project, if its project id is unknown
 
                  if No (Withed_Project) then
                     Parse_Single_Project
                       (In_Tree           => In_Tree,
                        Project           => Withed_Project,
                        Extends_All       => Extends_All,
                        Path_Name         => Imported_Path_Name,
                        Extended          => False,
                        From_Extended     => From_Extended,
                        In_Limited        => Limited_Withs,
                        Packages_To_Check => Packages_To_Check,
                        Depth             => Depth,
                        Current_Dir       => Current_Dir,
                        Is_Config_File    => Is_Config_File,
                        Flags             => Flags);
 
                  else
                     Extends_All := Is_Extending_All (Withed_Project, In_Tree);
                  end if;
 
                  if No (Withed_Project) then
 
                     --  If parsing unsuccessful, remove the context clause
 
                     Current_Project := Previous_Project;
 
                     if No (Current_Project) then
                        Imported_Projects := Empty_Node;
 
                     else
                        Set_Next_With_Clause_Of
                          (Current_Project, In_Tree, Empty_Node);
                     end if;
                  else
                     --  If parsing was successful, record project name and
                     --  path name in with clause
 
                     Set_Project_Node_Of
                       (Node         => Current_Project,
                        In_Tree      => In_Tree,
                        To           => Withed_Project,
                        Limited_With => Current_With.Limited_With);
                     Set_Name_Of
                       (Current_Project,
                        In_Tree,
                        Name_Of (Withed_Project, In_Tree));
 
                     Name_Len := Resolved_Path'Length;
                     Name_Buffer (1 .. Name_Len) := Resolved_Path;
                     Set_Path_Name_Of (Current_Project, In_Tree, Name_Find);
 
                     if Extends_All then
                        Set_Is_Extending_All (Current_Project, In_Tree);
                     end if;
                  end if;
               end if;
            end;
         end if;
      end loop;
   end Post_Parse_Context_Clause;
 
   --------------------------
   -- Parse_Single_Project --
   --------------------------
 
   procedure Parse_Single_Project
     (In_Tree           : Project_Node_Tree_Ref;
      Project           : out Project_Node_Id;
      Extends_All       : out Boolean;
      Path_Name         : String;
      Extended          : Boolean;
      From_Extended     : Extension_Origin;
      In_Limited        : Boolean;
      Packages_To_Check : String_List_Access;
      Depth             : Natural;
      Current_Dir       : String;
      Is_Config_File    : Boolean;
      Flags             : Processing_Flags)
   is
      Normed_Path_Name    : Path_Name_Type;
      Canonical_Path_Name : Path_Name_Type;
      Project_Directory   : Path_Name_Type;
      Project_Scan_State  : Saved_Project_Scan_State;
      Source_Index        : Source_File_Index;
 
      Extending : Boolean := False;
 
      Extended_Project : Project_Node_Id := Empty_Node;
 
      A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
                                  Tree_Private_Part.Projects_Htable.Get_First
                                    (In_Tree.Projects_HT);
 
      Name_From_Path  : constant Name_Id :=
        Project_Name_From (Path_Name, Is_Config_File => Is_Config_File);
      Name_Of_Project : Name_Id := No_Name;
      Display_Name_Of_Project : Name_Id := No_Name;
 
      Duplicated : Boolean := False;
 
      First_With        : With_Id;
      Imported_Projects : Project_Node_Id := Empty_Node;
 
      use Tree_Private_Part;
 
      Project_Comment_State : Tree.Comment_State;
 
      Proj_Qualifier     : Project_Qualifier := Unspecified;
      Qualifier_Location : Source_Ptr;
 
   begin
      Extends_All := False;
 
      declare
         Normed_Path    : constant String := Normalize_Pathname
                            (Path_Name,
                             Directory      => Current_Dir,
                             Resolve_Links  => False,
                             Case_Sensitive => True);
         Canonical_Path : constant String := Normalize_Pathname
                            (Normed_Path,
                             Directory      => Current_Dir,
                             Resolve_Links  => Opt.Follow_Links_For_Files,
                             Case_Sensitive => False);
      begin
         Name_Len := Normed_Path'Length;
         Name_Buffer (1 .. Name_Len) := Normed_Path;
         Normed_Path_Name := Name_Find;
         Name_Len := Canonical_Path'Length;
         Name_Buffer (1 .. Name_Len) := Canonical_Path;
         Canonical_Path_Name := Name_Find;
      end;
 
      --  Check for a circular dependency
 
      for Index in reverse 1 .. Project_Stack.Last loop
         exit when Project_Stack.Table (Index).Limited_With;
 
         if Canonical_Path_Name =
              Project_Stack.Table (Index).Canonical_Path_Name
         then
            Error_Msg (Flags, "circular dependency detected", Token_Ptr);
            Error_Msg_Name_1 := Name_Id (Normed_Path_Name);
            Error_Msg (Flags, "\  %% is imported by", Token_Ptr);
 
            for Current in reverse 1 .. Project_Stack.Last loop
               Error_Msg_Name_1 :=
                 Name_Id (Project_Stack.Table (Current).Path_Name);
 
               if Project_Stack.Table (Current).Canonical_Path_Name /=
                    Canonical_Path_Name
               then
                  Error_Msg
                    (Flags, "\  %% which itself is imported by", Token_Ptr);
 
               else
                  Error_Msg (Flags, "\  %%", Token_Ptr);
                  exit;
               end if;
            end loop;
 
            Project := Empty_Node;
            return;
         end if;
      end loop;
 
      --  Put the new path name on the stack
 
      Project_Stack.Append
        ((Path_Name           => Normed_Path_Name,
          Canonical_Path_Name => Canonical_Path_Name,
          Id                  => Empty_Node,
          Limited_With        => In_Limited));
 
      --  Check if the project file has already been parsed
 
      while
        A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
      loop
         if A_Project_Name_And_Node.Canonical_Path = Canonical_Path_Name then
            if Extended then
 
               if A_Project_Name_And_Node.Extended then
                  if A_Project_Name_And_Node.Proj_Qualifier /= Dry then
                     Error_Msg
                       (Flags,
                        "cannot extend the same project file several times",
                        Token_Ptr);
                  end if;
               else
                  Error_Msg
                    (Flags,
                     "cannot extend an already imported project file",
                     Token_Ptr);
               end if;
 
            elsif A_Project_Name_And_Node.Extended then
               Extends_All :=
                 Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree);
 
               --  If the imported project is an extended project A, and we are
               --  in an extended project, replace A with the ultimate project
               --  extending A.
 
               if From_Extended /= None then
                  declare
                     Decl : Project_Node_Id :=
                              Project_Declaration_Of
                                (A_Project_Name_And_Node.Node, In_Tree);
 
                     Prj  : Project_Node_Id :=
                              A_Project_Name_And_Node.Node;
 
                  begin
                     --  Loop through extending projects to find the ultimate
                     --  extending project, that is the one that is not
                     --  extended. For an abstract project, as it can be
                     --  extended several times, there is no extending project
                     --  registered, so the loop does not execute and the
                     --  resulting project is the abstract project.
 
                     while
                       Extending_Project_Of (Decl, In_Tree) /= Empty_Node
                     loop
                        Prj := Extending_Project_Of (Decl, In_Tree);
                        Decl := Project_Declaration_Of (Prj, In_Tree);
                     end loop;
 
                     A_Project_Name_And_Node.Node := Prj;
                  end;
               else
                  Error_Msg
                    (Flags,
                     "cannot import an already extended project file",
                     Token_Ptr);
               end if;
            end if;
 
            Project := A_Project_Name_And_Node.Node;
            Project_Stack.Decrement_Last;
            return;
         end if;
 
         A_Project_Name_And_Node :=
           Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT);
      end loop;
 
      --  We never encountered this project file. Save the scan state, load the
      --  project file and start to scan it.
 
      Save_Project_Scan_State (Project_Scan_State);
      Source_Index := Load_Project_File (Path_Name);
      Tree.Save (Project_Comment_State);
 
      --  If we cannot find it, we stop
 
      if Source_Index = No_Source_File then
         Project := Empty_Node;
         Project_Stack.Decrement_Last;
         return;
      end if;
 
      Prj.Err.Scanner.Initialize_Scanner (Source_Index);
      Tree.Reset_State;
      Scan (In_Tree);
 
      if not Is_Config_File and then Name_From_Path = No_Name then
 
         --  The project file name is not correct (no or bad extension, or not
         --  following Ada identifier's syntax).
 
         Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
         Error_Msg (Flags,
                    "?{ is not a valid path name for a project file",
                    Token_Ptr);
      end if;
 
      if Current_Verbosity >= Medium then
         Write_Str  ("Parsing """);
         Write_Str  (Path_Name);
         Write_Char ('"');
         Write_Eol;
      end if;
 
      Project_Directory :=
        Path_Name_Type (Get_Directory (File_Name_Type (Normed_Path_Name)));
 
      --  Is there any imported project?
 
      Pre_Parse_Context_Clause
        (In_Tree        => In_Tree,
         Is_Config_File => Is_Config_File,
         Context_Clause => First_With,
         Flags          => Flags);
 
      Project := Default_Project_Node
                   (Of_Kind => N_Project, In_Tree => In_Tree);
      Project_Stack.Table (Project_Stack.Last).Id := Project;
      Set_Directory_Of (Project, In_Tree, Project_Directory);
      Set_Path_Name_Of (Project, In_Tree,  Normed_Path_Name);
 
      --  Check if there is a qualifier before the reserved word "project"
 
      Qualifier_Location := Token_Ptr;
 
      if Token = Tok_Abstract then
         Proj_Qualifier := Dry;
         Scan (In_Tree);
 
      elsif Token = Tok_Identifier then
         case Token_Name is
            when Snames.Name_Standard =>
               Proj_Qualifier := Standard;
               Scan (In_Tree);
 
            when Snames.Name_Aggregate =>
               Proj_Qualifier := Aggregate;
               Scan (In_Tree);
 
               if Token = Tok_Identifier and then
                 Token_Name = Snames.Name_Library
               then
                  Proj_Qualifier := Aggregate_Library;
                  Scan (In_Tree);
               end if;
 
            when Snames.Name_Library =>
               Proj_Qualifier := Library;
               Scan (In_Tree);
 
            when Snames.Name_Configuration =>
               if not Is_Config_File then
                  Error_Msg
                    (Flags,
                     "configuration projects cannot belong to a user" &
                     " project tree",
                     Token_Ptr);
               end if;
 
               Proj_Qualifier := Configuration;
               Scan (In_Tree);
 
            when others =>
               null;
         end case;
      end if;
 
      if Is_Config_File and then Proj_Qualifier = Unspecified then
 
         --  Set the qualifier to Configuration, even if the token doesn't
         --  exist in the source file itself, so that we can differentiate
         --  project files and configuration files later on.
 
         Proj_Qualifier := Configuration;
      end if;
 
      if Proj_Qualifier /= Unspecified then
         if Is_Config_File
           and then Proj_Qualifier /= Configuration
         then
            Error_Msg (Flags,
                       "a configuration project cannot be qualified except " &
                       "as configuration project",
                       Qualifier_Location);
         end if;
 
         Set_Project_Qualifier_Of (Project, In_Tree, Proj_Qualifier);
      end if;
 
      Set_Location_Of (Project, In_Tree, Token_Ptr);
 
      Expect (Tok_Project, "PROJECT");
 
      --  Mark location of PROJECT token if present
 
      if Token = Tok_Project then
         Scan (In_Tree); -- past PROJECT
         Set_Location_Of (Project, In_Tree, Token_Ptr);
      end if;
 
      --  Clear the Buffer
 
      Buffer_Last := 0;
      loop
         Expect (Tok_Identifier, "identifier");
 
         --  If the token is not an identifier, clear the buffer before
         --  exiting to indicate that the name of the project is ill-formed.
 
         if Token /= Tok_Identifier then
            Buffer_Last := 0;
            exit;
         end if;
 
         --  Add the identifier name to the buffer
 
         Get_Name_String (Token_Name);
         Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
 
         --  Scan past the identifier
 
         Scan (In_Tree);
 
         --  If we have a dot, add a dot to the Buffer and look for the next
         --  identifier.
 
         exit when Token /= Tok_Dot;
         Add_To_Buffer (".", Buffer, Buffer_Last);
 
         --  Scan past the dot
 
         Scan (In_Tree);
      end loop;
 
      --  See if this is an extending project
 
      if Token = Tok_Extends then
 
         if Is_Config_File then
            Error_Msg
              (Flags,
               "extending configuration project not allowed", Token_Ptr);
         end if;
 
         --  Make sure that gnatmake will use mapping files
 
         Create_Mapping_File := True;
 
         --  We are extending another project
 
         Extending := True;
 
         Scan (In_Tree); -- past EXTENDS
 
         if Token = Tok_All then
            Extends_All := True;
            Set_Is_Extending_All (Project, In_Tree);
            Scan (In_Tree); --  scan past ALL
         end if;
      end if;
 
      --  If the name is well formed, Buffer_Last is > 0
 
      if Buffer_Last > 0 then
 
         --  The Buffer contains the name of the project
 
         Name_Len := Buffer_Last;
         Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
         Name_Of_Project := Name_Find;
         Set_Name_Of (Project, In_Tree, Name_Of_Project);
 
         --  To get expected name of the project file, replace dots by dashes
 
         for Index in 1 .. Name_Len loop
            if Name_Buffer (Index) = '.' then
               Name_Buffer (Index) := '-';
            end if;
         end loop;
 
         Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
 
         declare
            Expected_Name : constant Name_Id := Name_Find;
            Extension     : String_Access;
 
         begin
            --  Output a warning if the actual name is not the expected name
 
            if not Is_Config_File
              and then (Name_From_Path /= No_Name)
              and then Expected_Name /= Name_From_Path
            then
               Error_Msg_Name_1 := Expected_Name;
 
               if Is_Config_File then
                  Extension := new String'(Config_Project_File_Extension);
 
               else
                  Extension := new String'(Project_File_Extension);
               end if;
 
               Error_Msg
                 (Flags,
                  "?file name does not match project name, should be `%%"
                  & Extension.all & "`",
                  Token_Ptr);
            end if;
         end;
 
         --  Read the original casing of the project name
 
         declare
            Loc : Source_Ptr;
 
         begin
            Loc := Location_Of (Project, In_Tree);
            for J in 1 .. Name_Len loop
               Name_Buffer (J) := Sinput.Source (Loc);
               Loc := Loc + 1;
            end loop;
 
            Display_Name_Of_Project := Name_Find;
         end;
 
         declare
            From_Ext : Extension_Origin := None;
 
         begin
            --  Extending_All is always propagated
 
            if From_Extended = Extending_All or else Extends_All then
               From_Ext := Extending_All;
 
            --  Otherwise, From_Extended is set to Extending_Single if the
            --  current project is an extending project.
 
            elsif Extended then
               From_Ext := Extending_Simple;
            end if;
 
            Post_Parse_Context_Clause
              (In_Tree           => In_Tree,
               Context_Clause    => First_With,
               Limited_Withs     => False,
               Imported_Projects => Imported_Projects,
               Project_Directory => Project_Directory,
               From_Extended     => From_Ext,
               In_Limited        => In_Limited,
               Packages_To_Check => Packages_To_Check,
               Depth             => Depth + 1,
               Current_Dir       => Current_Dir,
               Is_Config_File    => Is_Config_File,
               Flags             => Flags);
            Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
         end;
 
         if not Is_Config_File then
            declare
               Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
                                 Tree_Private_Part.Projects_Htable.Get_First
                                   (In_Tree.Projects_HT);
               Project_Name  : Name_Id := Name_And_Node.Name;
 
            begin
               --  Check if we already have a project with this name
 
               while Project_Name /= No_Name
                 and then Project_Name /= Name_Of_Project
               loop
                  Name_And_Node :=
                    Tree_Private_Part.Projects_Htable.Get_Next
                      (In_Tree.Projects_HT);
                  Project_Name := Name_And_Node.Name;
               end loop;
 
               --  Report an error if we already have a project with this name
 
               if Project_Name /= No_Name then
                  Duplicated := True;
                  Error_Msg_Name_1 := Project_Name;
                  Error_Msg
                    (Flags, "duplicate project name %%",
                     Location_Of (Project, In_Tree));
                  Error_Msg_Name_1 :=
                    Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
                  Error_Msg
                    (Flags, "\already in %%", Location_Of (Project, In_Tree));
               end if;
            end;
         end if;
 
      end if;
 
      if Extending then
         Expect (Tok_String_Literal, "literal string");
 
         if Token = Tok_String_Literal then
            Set_Extended_Project_Path_Of
              (Project,
               In_Tree,
               Path_Name_Type (Token_Name));
 
            declare
               Original_Path_Name : constant String :=
                                      Get_Name_String (Token_Name);
 
               Extended_Project_Path_Name : constant String :=
                                              Project_Path_Name_Of
                                                (In_Tree,
                                                 Original_Path_Name,
                                                 Get_Name_String
                                                   (Project_Directory));
 
            begin
               if Extended_Project_Path_Name = "" then
 
                  --  We could not find the project file to extend
 
                  Error_Msg_Name_1 := Token_Name;
 
                  Error_Msg (Flags, "unknown project file: %%", Token_Ptr);
 
                  --  If we are not in the main project file, display the
                  --  import path.
 
                  if Project_Stack.Last > 1 then
                     Error_Msg_Name_1 :=
                       Name_Id
                         (Project_Stack.Table (Project_Stack.Last).Path_Name);
                     Error_Msg (Flags, "\extended by %%", Token_Ptr);
 
                     for Index in reverse 1 .. Project_Stack.Last - 1 loop
                        Error_Msg_Name_1 :=
                          Name_Id
                            (Project_Stack.Table (Index).Path_Name);
                        Error_Msg (Flags, "\imported by %%", Token_Ptr);
                     end loop;
                  end if;
 
               else
                  declare
                     From_Ext : Extension_Origin := None;
 
                  begin
                     if From_Extended = Extending_All or else Extends_All then
                        From_Ext := Extending_All;
                     end if;
 
                     Parse_Single_Project
                       (In_Tree           => In_Tree,
                        Project           => Extended_Project,
                        Extends_All       => Extends_All,
                        Path_Name         => Extended_Project_Path_Name,
                        Extended          => True,
                        From_Extended     => From_Ext,
                        In_Limited        => In_Limited,
                        Packages_To_Check => Packages_To_Check,
                        Depth             => Depth + 1,
                        Current_Dir       => Current_Dir,
                        Is_Config_File    => Is_Config_File,
                        Flags             => Flags);
                  end;
 
                  if Present (Extended_Project) then
 
                     --  A project that extends an extending-all project is
                     --  also an extending-all project.
 
                     if Is_Extending_All (Extended_Project, In_Tree) then
                        Set_Is_Extending_All (Project, In_Tree);
                     end if;
 
                     --  An abstract project can only extend an abstract
                     --  project, otherwise we may have an abstract project
                     --  with sources, if it inherits sources from the project
                     --  it extends.
 
                     if Proj_Qualifier = Dry and then
                       Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
                     then
                        Error_Msg
                          (Flags, "an abstract project can only extend " &
                           "another abstract project",
                           Qualifier_Location);
                     end if;
                  end if;
               end if;
            end;
 
            Scan (In_Tree); -- past the extended project path
         end if;
      end if;
 
      --  Check that a non extending-all project does not import an
      --  extending-all project.
 
      if not Is_Extending_All (Project, In_Tree) then
         declare
            With_Clause : Project_Node_Id :=
                            First_With_Clause_Of (Project, In_Tree);
            Imported    : Project_Node_Id := Empty_Node;
 
         begin
            With_Clause_Loop :
            while Present (With_Clause) loop
               Imported := Project_Node_Of (With_Clause, In_Tree);
 
               if Is_Extending_All (With_Clause, In_Tree) then
                  Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
                  Error_Msg (Flags, "cannot import extending-all project %%",
                             Token_Ptr);
                  exit With_Clause_Loop;
               end if;
 
               With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
            end loop With_Clause_Loop;
         end;
      end if;
 
      --  Check that a project with a name including a dot either imports
      --  or extends the project whose name precedes the last dot.
 
      if Name_Of_Project /= No_Name then
         Get_Name_String (Name_Of_Project);
 
      else
         Name_Len := 0;
      end if;
 
      --  Look for the last dot
 
      while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop
         Name_Len := Name_Len - 1;
      end loop;
 
      --  If a dot was find, check if the parent project is imported
      --  or extended.
 
      if Name_Len > 0 then
         Name_Len := Name_Len - 1;
 
         declare
            Parent_Name  : constant Name_Id := Name_Find;
            Parent_Found : Boolean := False;
            Parent_Node  : Project_Node_Id := Empty_Node;
            With_Clause  : Project_Node_Id :=
                             First_With_Clause_Of (Project, In_Tree);
 
         begin
            --  If there is an extended project, check its name
 
            if Present (Extended_Project) then
               Parent_Node := Extended_Project;
               Parent_Found :=
                 Name_Of (Extended_Project, In_Tree) = Parent_Name;
            end if;
 
            --  If the parent project is not the extended project,
            --  check each imported project until we find the parent project.
 
            while not Parent_Found and then Present (With_Clause) loop
               Parent_Node := Project_Node_Of (With_Clause, In_Tree);
               Parent_Found := Name_Of (Parent_Node, In_Tree) = Parent_Name;
               With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
            end loop;
 
            if Parent_Found then
               Set_Parent_Project_Of (Project, In_Tree, To => Parent_Node);
 
            else
               --  If the parent project was not found, report an error
 
               Error_Msg_Name_1 := Name_Of_Project;
               Error_Msg_Name_2 := Parent_Name;
               Error_Msg (Flags,
                          "project %% does not import or extend project %%",
                          Location_Of (Project, In_Tree));
            end if;
         end;
      end if;
 
      Expect (Tok_Is, "IS");
      Set_End_Of_Line (Project);
      Set_Previous_Line_Node (Project);
      Set_Next_End_Node (Project);
 
      declare
         Project_Declaration : Project_Node_Id := Empty_Node;
 
      begin
         --  No need to Scan past "is", Prj.Dect.Parse will do it
 
         Prj.Dect.Parse
           (In_Tree           => In_Tree,
            Declarations      => Project_Declaration,
            Current_Project   => Project,
            Extends           => Extended_Project,
            Packages_To_Check => Packages_To_Check,
            Is_Config_File    => Is_Config_File,
            Flags             => Flags);
         Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
 
         if Present (Extended_Project)
           and then Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
         then
            Set_Extending_Project_Of
              (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,
               To => Project);
         end if;
      end;
 
      Expect (Tok_End, "END");
      Remove_Next_End_Node;
 
      --  Skip "end" if present
 
      if Token = Tok_End then
         Scan (In_Tree);
      end if;
 
      --  Clear the Buffer
 
      Buffer_Last := 0;
 
      --  Store the name following "end" in the Buffer. The name may be made of
      --  several simple names.
 
      loop
         Expect (Tok_Identifier, "identifier");
 
         --  If we don't have an identifier, clear the buffer before exiting to
         --  avoid checking the name.
 
         if Token /= Tok_Identifier then
            Buffer_Last := 0;
            exit;
         end if;
 
         --  Add the identifier to the Buffer
         Get_Name_String (Token_Name);
         Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
 
         --  Scan past the identifier
 
         Scan (In_Tree);
         exit when Token /= Tok_Dot;
         Add_To_Buffer (".", Buffer, Buffer_Last);
         Scan (In_Tree);
      end loop;
 
      --  If we have a valid name, check if it is the name of the project
 
      if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
         if To_Lower (Buffer (1 .. Buffer_Last)) /=
            Get_Name_String (Name_Of (Project, In_Tree))
         then
            --  Invalid name: report an error
 
            Error_Msg (Flags, "expected """ &
                       Get_Name_String (Name_Of (Project, In_Tree)) & """",
                       Token_Ptr);
         end if;
      end if;
 
      Expect (Tok_Semicolon, "`;`");
 
      --  Check that there is no more text following the end of the project
      --  source.
 
      if Token = Tok_Semicolon then
         Set_Previous_End_Node (Project);
         Scan (In_Tree);
 
         if Token /= Tok_EOF then
            Error_Msg
              (Flags, "unexpected text following end of project", Token_Ptr);
         end if;
      end if;
 
      if not Duplicated and then Name_Of_Project /= No_Name then
 
         --  Add the name of the project to the hash table, so that we can
         --  check that no other subsequent project will have the same name.
 
         Tree_Private_Part.Projects_Htable.Set
           (T => In_Tree.Projects_HT,
            K => Name_Of_Project,
            E => (Name           => Name_Of_Project,
                  Display_Name   => Display_Name_Of_Project,
                  Node           => Project,
                  Canonical_Path => Canonical_Path_Name,
                  Extended       => Extended,
                  Proj_Qualifier => Proj_Qualifier));
      end if;
 
      declare
         From_Ext : Extension_Origin := None;
 
      begin
         --  Extending_All is always propagated
 
         if From_Extended = Extending_All or else Extends_All then
            From_Ext := Extending_All;
 
            --  Otherwise, From_Extended is set to Extending_Single if the
            --  current project is an extending project.
 
         elsif Extended then
            From_Ext := Extending_Simple;
         end if;
 
         Post_Parse_Context_Clause
           (In_Tree           => In_Tree,
            Context_Clause    => First_With,
            Limited_Withs     => True,
            Imported_Projects => Imported_Projects,
            Project_Directory => Project_Directory,
            From_Extended     => From_Ext,
            In_Limited        => In_Limited,
            Packages_To_Check => Packages_To_Check,
            Depth             => Depth + 1,
            Current_Dir       => Current_Dir,
            Is_Config_File    => Is_Config_File,
            Flags             => Flags);
         Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
      end;
 
      --  Restore the scan state, in case we are not the main project
 
      Restore_Project_Scan_State (Project_Scan_State);
 
      --  And remove the project from the project stack
 
      Project_Stack.Decrement_Last;
 
      --  Indicate if there are unkept comments
 
      Tree.Set_Project_File_Includes_Unkept_Comments
        (Node    => Project,
         In_Tree => In_Tree,
         To      => Tree.There_Are_Unkept_Comments);
 
      --  And restore the comment state that was saved
 
      Tree.Restore_And_Free (Project_Comment_State);
   end Parse_Single_Project;
 
   -----------------------
   -- Project_Name_From --
   -----------------------
 
   function Project_Name_From
     (Path_Name      : String;
      Is_Config_File : Boolean) return Name_Id
   is
      Canonical : String (1 .. Path_Name'Length) := Path_Name;
      First     : Natural := Canonical'Last;
      Last      : Natural := First;
      Index     : Positive;
 
   begin
      if Current_Verbosity = High then
         Write_Str ("Project_Name_From (""");
         Write_Str (Canonical);
         Write_Line (""")");
      end if;
 
      --  If the path name is empty, return No_Name to indicate failure
 
      if First = 0 then
         return No_Name;
      end if;
 
      Canonical_Case_File_Name (Canonical);
 
      --  Look for the last dot in the path name
 
      while First > 0
        and then
        Canonical (First) /= '.'
      loop
         First := First - 1;
      end loop;
 
      --  If we have a dot, check that it is followed by the correct extension
 
      if First > 0 and then Canonical (First) = '.' then
         if (not Is_Config_File
              and then Canonical (First .. Last) = Project_File_Extension
              and then First /= 1)
           or else
             (Is_Config_File
               and then
                 Canonical (First .. Last) = Config_Project_File_Extension
               and then First /= 1)
         then
            --  Look for the last directory separator, if any
 
            First := First - 1;
            Last := First;
            while First > 0
              and then Canonical (First) /= '/'
              and then Canonical (First) /= Dir_Sep
            loop
               First := First - 1;
            end loop;
 
         else
            --  Not the correct extension, return No_Name to indicate failure
 
            return No_Name;
         end if;
 
      --  If no dot in the path name, return No_Name to indicate failure
 
      else
         return No_Name;
      end if;
 
      First := First + 1;
 
      --  If the extension is the file name, return No_Name to indicate failure
 
      if First > Last then
         return No_Name;
      end if;
 
      --  Put the name in lower case into Name_Buffer
 
      Name_Len := Last - First + 1;
      Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
 
      Index := 1;
 
      --  Check if it is a well formed project name. Return No_Name if it is
      --  ill formed.
 
      loop
         if not Is_Letter (Name_Buffer (Index)) then
            return No_Name;
 
         else
            loop
               Index := Index + 1;
 
               exit when Index >= Name_Len;
 
               if Name_Buffer (Index) = '_' then
                  if Name_Buffer (Index + 1) = '_' then
                     return No_Name;
                  end if;
               end if;
 
               exit when Name_Buffer (Index) = '-';
 
               if Name_Buffer (Index) /= '_'
                 and then not Is_Alphanumeric (Name_Buffer (Index))
               then
                  return No_Name;
               end if;
 
            end loop;
         end if;
 
         if Index >= Name_Len then
            if Is_Alphanumeric (Name_Buffer (Name_Len)) then
 
               --  All checks have succeeded. Return name in Name_Buffer
 
               return Name_Find;
 
            else
               return No_Name;
            end if;
 
         elsif Name_Buffer (Index) = '-' then
            Index := Index + 1;
         end if;
      end loop;
   end Project_Name_From;
 
   --------------------------
   -- Project_Path_Name_Of --
   --------------------------
 
   function Project_Path_Name_Of
     (In_Tree           : Project_Node_Tree_Ref;
      Project_File_Name : String;
      Directory         : String) return String
   is
 
      function Try_Path_Name (Path : String) return String_Access;
      pragma Inline (Try_Path_Name);
      --  Try the specified Path
 
      -------------------
      -- Try_Path_Name --
      -------------------
 
      function Try_Path_Name (Path : String) return String_Access is
         Prj_Path : constant String := Project_Path (In_Tree);
         First    : Natural;
         Last     : Natural;
         Result   : String_Access := null;
 
      begin
         if Current_Verbosity = High then
            Write_Str  ("   Trying ");
            Write_Line (Path);
         end if;
 
         if Is_Absolute_Path (Path) then
            if Is_Regular_File (Path) then
               Result := new String'(Path);
            end if;
 
         else
            --  Because we don't want to resolve symbolic links, we cannot use
            --  Locate_Regular_File. So, we try each possible path
            --  successively.
 
            First := Prj_Path'First;
            while First <= Prj_Path'Last loop
               while First <= Prj_Path'Last
                 and then Prj_Path (First) = Path_Separator
               loop
                  First := First + 1;
               end loop;
 
               exit when First > Prj_Path'Last;
 
               Last := First;
               while Last < Prj_Path'Last
                 and then Prj_Path (Last + 1) /= Path_Separator
               loop
                  Last := Last + 1;
               end loop;
 
               Name_Len := 0;
 
               if not Is_Absolute_Path (Prj_Path (First .. Last)) then
                  Add_Str_To_Name_Buffer (Get_Current_Dir);
                  Add_Char_To_Name_Buffer (Directory_Separator);
               end if;
 
               Add_Str_To_Name_Buffer (Prj_Path (First .. Last));
               Add_Char_To_Name_Buffer (Directory_Separator);
               Add_Str_To_Name_Buffer (Path);
 
               if Is_Regular_File (Name_Buffer (1 .. Name_Len)) then
                  Result := new String'(Name_Buffer (1 .. Name_Len));
                  exit;
               end if;
 
               First := Last + 1;
            end loop;
         end if;
 
         return Result;
      end Try_Path_Name;
 
      --  Local Declarations
 
      Result    : String_Access;
      Result_Id : Path_Name_Type;
      Has_Dot   : Boolean := False;
      Key       : Name_Id;
 
   --  Start of processing for Project_Path_Name_Of
 
   begin
      if Current_Verbosity = High then
         Write_Str  ("Project_Path_Name_Of (""");
         Write_Str  (Project_File_Name);
         Write_Str  (""", """);
         Write_Str  (Directory);
         Write_Line (""");");
      end if;
 
      --  Check the project cache
 
      Name_Len := Project_File_Name'Length;
      Name_Buffer (1 .. Name_Len) := Project_File_Name;
      Key := Name_Find;
      Result_Id := Projects_Paths.Get (Key);
 
      if Result_Id /= No_Path then
         return Get_Name_String (Result_Id);
      end if;
 
      --  Check if Project_File_Name contains an extension (a dot before a
      --  directory separator). If it is the case we do not try project file
      --  with an added extension as it is not possible to have multiple dots
      --  on a project file name.
 
      Check_Dot : for K in reverse Project_File_Name'Range loop
         if Project_File_Name (K) = '.' then
            Has_Dot := True;
            exit Check_Dot;
         end if;
 
         exit Check_Dot when Project_File_Name (K) = Directory_Separator
           or else Project_File_Name (K) = '/';
      end loop Check_Dot;
 
      if not Is_Absolute_Path (Project_File_Name) then
 
         --  First we try <directory>/<file_name>.<extension>
 
         if not Has_Dot then
            Result := Try_Path_Name
              (Directory & Directory_Separator &
               Project_File_Name & Project_File_Extension);
         end if;
 
         --  Then we try <directory>/<file_name>
 
         if Result = null then
            Result := Try_Path_Name
              (Directory & Directory_Separator & Project_File_Name);
         end if;
      end if;
 
      --  Then we try <file_name>.<extension>
 
      if Result = null and then not Has_Dot then
         Result := Try_Path_Name (Project_File_Name & Project_File_Extension);
      end if;
 
      --  Then we try <file_name>
 
      if Result = null then
         Result := Try_Path_Name (Project_File_Name);
      end if;
 
      --  If we cannot find the project file, we return an empty string
 
      if Result = null then
         return "";
 
      else
         declare
            Final_Result : constant String :=
                             GNAT.OS_Lib.Normalize_Pathname
                               (Result.all,
                                Directory      => Directory,
                                Resolve_Links  => Opt.Follow_Links_For_Files,
                                Case_Sensitive => True);
         begin
            Free (Result);
            Name_Len := Final_Result'Length;
            Name_Buffer (1 .. Name_Len) := Final_Result;
            Result_Id := Name_Find;
 
            Projects_Paths.Set (Key, Result_Id);
            return Final_Result;
         end;
      end if;
   end Project_Path_Name_Of;
 
end Prj.Part;

Compare with Previous | Blame | View Log

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.