Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                             P R J . P A R T                              --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 2001-2011, 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.Env;  use Prj.Env;

with Prj.Err;  use Prj.Err;

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.HTable;               use GNAT.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 GNAT.HTable.Simple_HTable

     (Header_Num => Header_Num,

      Element    => Project_Node_Id,

      No_Element => Project_Node_High_Bound,

      Key        => Project_Node_Id,

      Hash       => Prj.Tree.Hash,

      Equal      => "=");

   --  Hash table to store the node ids of projects for which a virtual

   --  extending project need to be created. The corresponding value is the

   --  head of a list of WITH clauses corresponding to the context of the

   --  enclosing EXTEND ALL projects. Note: Default_Element is Project_Node_

   --  High_Bound because we want Empty_Node to be a possible value.

   package Processed_Hash is new GNAT.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.

   function Has_Circular_Dependencies

     (Flags               : Processing_Flags;

      Normed_Path_Name    : Path_Name_Type;

      Canonical_Path_Name : Path_Name_Type) return Boolean;

   --  Check for a circular dependency in the loaded project.

   --  Generates an error message in such a case.

   procedure Read_Project_Qualifier

     (Flags              : Processing_Flags;

      In_Tree            : Project_Node_Tree_Ref;

      Is_Config_File     : Boolean;

      Qualifier_Location : out Source_Ptr;

      Project            : Project_Node_Id);

   --  Check if there is a qualifier before the reserved word "project"

   --  Hash table to cache project path to avoid looking for them on the path

   procedure Check_Extending_All_Imports

     (Flags : Processing_Flags;

      In_Tree : Project_Node_Tree_Ref;

      Project : Project_Node_Id);

   --  Check that a non extending-all project does not import an

   --  extending-all project.

   procedure Check_Aggregate_Imports

     (Flags   : Processing_Flags;

      In_Tree : Project_Node_Tree_Ref;

      Project : Project_Node_Id);

   --  Check that an aggregate project only imports abstract projects

   procedure Create_Virtual_Extending_Project

     (For_Project     : Project_Node_Id;

      Main_Project    : Project_Node_Id;

      Extension_Withs : Project_Node_Id;

      In_Tree         : Project_Node_Tree_Ref);

   --  Create a virtual extending project of For_Project. Main_Project is

   --  the extending all project. Extension_Withs is the head of a WITH clause

   --  list to be added to the created virtual 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_Id      : Path_Name_Type;

      Extended          : Boolean;

      From_Extended     : Extension_Origin;

      In_Limited        : Boolean;

      Packages_To_Check : String_List_Access;

      Depth             : Natural;

      Current_Dir       : String;

      Is_Config_File    : Boolean;

      Env               : in out Environment);

   --  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;

      Packages_To_Check : String_List_Access;

      Depth             : Natural;

      Current_Dir       : String;

      Is_Config_File    : Boolean;

      Env               : in out Environment);

   --  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_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.

   function Copy_With_Clause

     (With_Clause : Project_Node_Id;

      In_Tree     : Project_Node_Tree_Ref;

      Next_Clause : Project_Node_Id) return Project_Node_Id;

   --  Return a copy of With_Clause in In_Tree, whose Next_With_Clause is the

   --  indicated one.

   ----------------------

   -- Copy_With_Clause --

   ----------------------

   function Copy_With_Clause

     (With_Clause : Project_Node_Id;

      In_Tree     : Project_Node_Tree_Ref;

      Next_Clause : Project_Node_Id) return Project_Node_Id

   is

      New_With_Clause : constant Project_Node_Id :=

                          Default_Project_Node (In_Tree, N_With_Clause);

   begin

      Set_Name_Of (New_With_Clause, In_Tree,

        Name_Of (With_Clause, In_Tree));

      Set_Path_Name_Of (New_With_Clause, In_Tree,

        Path_Name_Of (With_Clause, In_Tree));

      Set_Project_Node_Of (New_With_Clause, In_Tree,

        Project_Node_Of (With_Clause, In_Tree));

      Set_Next_With_Clause_Of (New_With_Clause, In_Tree, Next_Clause);

      return New_With_Clause;

   end Copy_With_Clause;

   --------------------------------------

   -- Create_Virtual_Extending_Project --

   --------------------------------------

   procedure Create_Virtual_Extending_Project

     (For_Project     : Project_Node_Id;

      Main_Project    : Project_Node_Id;

      Extension_Withs : 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);

      --  Add a WITH clause to the main project to import the newly created

      --  virtual extending project.

      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);

      --  Copy with clauses for projects imported by the extending-all project

      declare

         Org_With_Clause : Project_Node_Id := Extension_Withs;

         New_With_Clause : Project_Node_Id := Empty_Node;

      begin

         while Present (Org_With_Clause) loop

            New_With_Clause :=

              Copy_With_Clause (Org_With_Clause, In_Tree, New_With_Clause);

            Org_With_Clause := Next_With_Clause_Of (Org_With_Clause, In_Tree);

         end loop;

         Set_First_With_Clause_Of (Virtual_Project, In_Tree, New_With_Clause);

      end;

      --  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 --

   -----------------------------------

   Extension_Withs : Project_Node_Id;

   --  Head of the current EXTENDS ALL imports list. When creating virtual

   --  projects for an EXTENDS ALL, we import in each virtual project all

   --  of the projects that appear in WITH clauses of the extending projects.

   --  This ensures that virtual projects share a consistent environment (in

   --  particular if a project imported by one of the extending projects

   --  replaces some runtime units).

   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

      Extends_All : Boolean := False;

      --  Set True if Proj is an EXTENDS ALL project

      Saved_Extension_Withs : constant Project_Node_Id := Extension_Withs;

   begin

      --  Nothing to do if Proj is undefined or 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);

            Extends_All := Is_Extending_All (Proj, 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, Extension_Withs);

         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;

            if Extends_All then

               --  This is an EXTENDS ALL project: prepend each of its WITH

               --  clauses to the currently active list of extension deps.

               Extension_Withs :=

                 Copy_With_Clause (With_Clause, In_Tree, Extension_Withs);

            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);

         Extension_Withs := Saved_Extension_Withs;

      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;

      Errout_Handling   : Errout_Mode := Always_Finalize;

      Packages_To_Check : String_List_Access;

      Store_Comments    : Boolean := False;

      Current_Directory : String := "";

      Is_Config_File    : Boolean;

      Env               : in out Prj.Tree.Environment;

      Target_Name       : String := "")

   is

      Dummy : Boolean;

      pragma Warnings (Off, Dummy);

      Real_Project_File_Name : String_Access :=

                                 Osint.To_Canonical_File_Spec

                                   (Project_File_Name);

      Path_Name_Id : Path_Name_Type;

   begin

      In_Tree.Incomplete_With := False;

      if not Is_Initialized (Env.Project_Path) then

         Prj.Env.Initialize_Default_Project_Path

           (Env.Project_Path, Target_Name);

      end if;

      if Real_Project_File_Name = null then

         Real_Project_File_Name := new String'(Project_File_Name);

      end if;

      Project := Empty_Node;

      Find_Project (Env.Project_Path,

                    Project_File_Name => Real_Project_File_Name.all,

                    Directory         => Current_Directory,

                    Path              => Path_Name_Id);

      Free (Real_Project_File_Name);

      if Errout_Handling /= Never_Finalize then

         Prj.Err.Initialize;

      end if;

      Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);

      Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);

      if Path_Name_Id = No_Path then

         declare

            P : String_Access;

         begin

            Get_Path (Env.Project_Path, Path => P);

            Prj.Com.Fail

              ("project file """

               & Project_File_Name

               & """ not found in "

               & P.all);

            Project := Empty_Node;

            return;

         end;

      end if;

      --  Parse the main project file

      begin

         Parse_Single_Project

           (In_Tree           => In_Tree,

            Project           => Project,

            Extends_All       => Dummy,

            Path_Name_Id      => Path_Name_Id,

            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,

            Env               => Env);

      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

            Extension_Withs := First_With_Clause_Of (Project, In_Tree);

            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 := Empty_Node;

            Withs : Project_Node_Id;

         begin

            Virtual_Hash.Get_First (Proj, Withs);

            while Withs /= Project_Node_High_Bound loop

               Create_Virtual_Extending_Project

                 (Proj, Project, Withs, In_Tree);

               Virtual_Hash.Get_Next (Proj, Withs);

            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;

      case Errout_Handling is

         when Always_Finalize =>

            Prj.Err.Finalize;

            --  Reinitialize to avoid duplicate warnings later on

            Prj.Err.Initialize;

         when Finalize_If_Error =>

            if No (Project) then

               Prj.Err.Finalize;

               Prj.Err.Initialize;

            end if;

         when Never_Finalize =>

            null;

      end case;

   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);  --  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 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;