gnatcmd.adb: Call Prj.Env.Initialize with the Project_Tree

2009-04-24  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb: Call Prj.Env.Initialize with the Project_Tree

	* prj-env.adb: Move all global variables to the private part of the
	project tree data.
	Access these new components instead of the global variables no longer
	in existence.
	(Add_To_Path): New Project_Tree_Ref parameter, to access the new
	components that were previously global variables.

	* prj-env.ads (Initialize): New Project_Tree_Ref parameter
	(Set_Mapping_File_Initial_State_To_Empty): New Project_Tree_Ref
	parameter.

	* prj-nmsc.adb (Compute_Unit_Name): New Project_Tree_Ref parameter to
	be able to call Set_Mapping_File_Initial_State_To_Empty with it.

	* prj.adb (Initialize): Do not call Prj.Env.Initialize
	(Reset): Do not call Prj.Env.Initialize. Instead, initialize the new
	components in the private part of the project tree data.

	* prj.ads (Private_Project_Tree_Data): new components moved from
	Prj.Env: Current_Source_Path_File, Current_Object_Path_File,
	Ada_Path_Buffer, Ada_Path_Length, Ada_Prj_Include_File_Set,
	Ada_Prj_Objects_File_Set, Fill_Mapping_File.

From-SVN: r146696

gcc/ada/ChangeLog

 2009-04-24  Vincent Celier  <celier@adacore.com>
 
+	* gnatcmd.adb: Call Prj.Env.Initialize with the Project_Tree
+
+	* prj-env.adb: Move all global variables to the private part of the
+	project tree data.
+	Access these new components instead of the global variables no longer
+	in existence.
+	(Add_To_Path): New Project_Tree_Ref parameter, to access the new
+	components that were previously global variables.
+
+	* prj-env.ads (Initialize): New Project_Tree_Ref parameter
+	(Set_Mapping_File_Initial_State_To_Empty): New Project_Tree_Ref
+	parameter.
+
+	* prj-nmsc.adb (Compute_Unit_Name): New Project_Tree_Ref parameter to
+	be able to call Set_Mapping_File_Initial_State_To_Empty with it.
+
+	* prj.adb (Initialize): Do not call Prj.Env.Initialize
+	(Reset): Do not call Prj.Env.Initialize. Instead, initialize the new
+	components in the private part of the project tree data.
+
+	* prj.ads (Private_Project_Tree_Data): new components moved from
+	Prj.Env: Current_Source_Path_File, Current_Object_Path_File,
+	Ada_Path_Buffer, Ada_Path_Length, Ada_Prj_Include_File_Set,
+	Ada_Prj_Objects_File_Set, Fill_Mapping_File.
+
+2009-04-24  Vincent Celier  <celier@adacore.com>
+
 	* opt.ads (Unchecked_Shared_Lib_Imports): New Boolean flag.
 
 	* prj-nmsc.adb (Check_Library): No error for imports by shared library

gcc/ada/gnatcmd.adb

@@ -2411,7 +2411,7 @@ begin
 
                --  First make sure that the recorded file names are empty
 
-               Prj.Env.Initialize;
+               Prj.Env.Initialize (Project_Tree);
 
                Prj.Env.Set_Ada_Paths
                  (Project, Project_Tree, Including_Libraries => False);

gcc/ada/prj-env.ads

@@ -28,9 +28,8 @@
 
 package Prj.Env is
 
-   procedure Initialize;
-   --  Called by Prj.Initialize to perform required initialization steps for
-   --  this package.
+   procedure Initialize (In_Tree : Project_Tree_Ref);
+   --  Initialize global components relative to environment variables
 
    procedure Print_Sources (In_Tree : Project_Tree_Ref);
    --  Output the list of sources, after Project files have been scanned
@@ -58,7 +57,8 @@ package Prj.Env is
    --  for the specified project, and that is not information available in
    --  buildgpr.adb.
 
-   procedure Set_Mapping_File_Initial_State_To_Empty;
+   procedure Set_Mapping_File_Initial_State_To_Empty
+     (In_Tree : Project_Tree_Ref);
    --  When creating a mapping file, create an empty map. This case occurs when
    --  run time source files are found in the project files. This only applies
    --  to the Ada_Only mode.

gcc/ada/prj-nmsc.adb

@@ -487,7 +487,8 @@ package body Prj.Nmsc is
       Spec_Suffix     : File_Name_Type;
       Casing          : Casing_Type;
       Kind            : out Source_Kind;
-      Unit            : out Name_Id);
+      Unit            : out Name_Id;
+      In_Tree         : Project_Tree_Ref);
    --  Check whether the file matches the naming scheme. If it does,
    --  compute its unit name. If Unit is set to No_Name on exit, none of the
    --  other out parameters are relevant.
@@ -723,14 +724,14 @@ package body Prj.Nmsc is
       Id.Project             := Project;
       Id.Language            := Lang_Id;
       Id.Lang_Kind           := Lang_Kind;
-      Id.Compiled            :=
-        Lang_Id.Config.Compiler_Driver /= Empty_File_Name;
+      Id.Compiled            := Lang_Id.Config.Compiler_Driver /=
+                                                             Empty_File_Name;
       Id.Kind                := Kind;
       Id.Alternate_Languages := Alternate_Languages;
       Id.Other_Part          := Other_Part;
 
-      Id.Object_Exists := Config.Object_Generated;
-      Id.Object_Linked := Config.Objects_Linked;
+      Id.Object_Exists       := Config.Object_Generated;
+      Id.Object_Linked       := Config.Objects_Linked;
 
       if Other_Part /= No_Source then
          Other_Part.Other_Part := Id;
@@ -906,9 +907,10 @@ package body Prj.Nmsc is
             begin
                Language := Data.Languages;
                while Language /= No_Language_Index loop
+
                   --  If there are no sources for this language, check whether
                   --  there are sources for which this is an alternate
-                  --  language
+                  --  language.
 
                   if Language.First_Source = No_Source then
                      Iter := For_Each_Source (In_Tree => In_Tree,
@@ -2515,11 +2517,11 @@ package body Prj.Nmsc is
                         Data.Decl.Attributes,
                         In_Tree);
 
-      List    : String_List_Id;
-      Element : String_Element;
-      Name    : File_Name_Type;
-      Iter    : Source_Iterator;
-      Source   : Source_Id;
+      List      : String_List_Id;
+      Element   : String_Element;
+      Name      : File_Name_Type;
+      Iter      : Source_Iterator;
+      Source    : Source_Id;
       Project_2 : Project_Id;
 
    begin
@@ -2855,8 +2857,8 @@ package body Prj.Nmsc is
       -----------------------------------
 
       procedure Process_Exceptions_File_Based
-        (Lang_Id        : Language_Ptr;
-         Kind           : Source_Kind)
+        (Lang_Id : Language_Ptr;
+         Kind    : Source_Kind)
       is
          Lang           : constant Name_Id := Lang_Id.Name;
          Exceptions     : Array_Element_Id;
@@ -2949,8 +2951,8 @@ package body Prj.Nmsc is
       -----------------------------------
 
       procedure Process_Exceptions_Unit_Based
-        (Lang_Id        : Language_Ptr;
-         Kind           : Source_Kind)
+        (Lang_Id : Language_Ptr;
+         Kind    : Source_Kind)
       is
          Lang              : constant Name_Id := Lang_Id.Name;
          Exceptions        : Array_Element_Id;
@@ -6419,7 +6421,8 @@ package body Prj.Nmsc is
       Spec_Suffix     : File_Name_Type;
       Casing          : Casing_Type;
       Kind            : out Source_Kind;
-      Unit            : out Name_Id)
+      Unit            : out Name_Id;
+      In_Tree         : Project_Tree_Ref)
    is
       Filename : constant String := Get_Name_String (File_Name);
       Last     : Integer := Filename'Last;
@@ -6575,7 +6578,7 @@ package body Prj.Nmsc is
                   --  If it is potentially a run time source, disable filling
                   --  of the mapping file to avoid warnings.
 
-                  Set_Mapping_File_Initial_State_To_Empty;
+                  Set_Mapping_File_Initial_State_To_Empty (In_Tree);
                end if;
             end if;
          end;
@@ -6684,7 +6687,8 @@ package body Prj.Nmsc is
             Spec_Suffix     => Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming),
             Casing          => Naming.Casing,
             Kind            => Kind,
-            Unit            => Unit_Name);
+            Unit            => Unit_Name,
+            In_Tree         => In_Tree);
 
          case Kind is
             when Spec       => Unit_Kind := Specification;
@@ -7551,7 +7555,8 @@ package body Prj.Nmsc is
                      Spec_Suffix     => Config.Naming_Data.Spec_Suffix,
                      Casing          => Config.Naming_Data.Casing,
                      Kind            => Kind,
-                     Unit            => Unit);
+                     Unit            => Unit,
+                     In_Tree         => In_Tree);
 
                   if Unit /= No_Name then
                      Language    := Tmp_Lang;

gcc/ada/prj.adb

@@ -29,7 +29,6 @@ with Ada.Unchecked_Deallocation;
 with Debug;
 with Osint;    use Osint;
 with Prj.Attr;
-with Prj.Env;
 with Prj.Err;  use Prj.Err;
 with Snames;   use Snames;
 with Table;
@@ -408,6 +407,7 @@ package body Prj is
    procedure Language_Changed (Iter : in out Source_Iterator) is
    begin
       Iter.Current  := No_Source;
+
       if Iter.Language_Name /= No_Name then
          while Iter.Language /= null
            and then Iter.Language.Name /= Iter.Language_Name
@@ -421,16 +421,20 @@ package body Prj is
       if Iter.Language = No_Language_Index then
          if Iter.All_Projects then
             Iter.Project := Iter.Project + 1;
+
             if Iter.Project > Project_Table.Last (Iter.In_Tree.Projects) then
                Iter.Project := No_Project;
             else
                Project_Changed (Iter);
             end if;
+
          else
             Iter.Project := No_Project;
          end if;
+
       else
          Iter.Current := Iter.Language.First_Source;
+
          if Iter.Current = No_Source then
             Iter.Language := Iter.Language.Next;
             Language_Changed (Iter);
@@ -610,7 +614,6 @@ package body Prj is
          Name_Buffer (1) := '/';
          Slash_Id := Name_Find;
 
-         Prj.Env.Initialize;
          Prj.Attr.Initialize;
          Set_Name_Table_Byte (Name_Project,  Token_Type'Pos (Tok_Project));
          Set_Name_Table_Byte (Name_Extends,  Token_Type'Pos (Tok_Extends));
@@ -630,8 +633,10 @@ package body Prj is
      (Data          : Project_Data;
       Language_Name : Name_Id) return Boolean
    is
-      Lang_Ind  : Language_Ptr := Data.Languages;
+      Lang_Ind : Language_Ptr;
+
    begin
+      Lang_Ind := Data.Languages;
       while Lang_Ind /= No_Language_Index loop
          if Lang_Ind.Name = Language_Name then
             return True;
@@ -673,8 +678,7 @@ package body Prj is
 
    function Object_Name
      (Source_File_Name   : File_Name_Type;
-      Object_File_Suffix : Name_Id := No_Name)
-      return File_Name_Type
+      Object_File_Suffix : Name_Id := No_Name) return File_Name_Type
    is
    begin
       if Object_File_Suffix = No_Name then
@@ -706,9 +710,9 @@ package body Prj is
       Default_Body_Suffix : File_Name_Type;
       In_Tree             : Project_Tree_Ref)
    is
-      Lang : Name_Id;
-      Suffix : Array_Element_Id;
-      Found : Boolean := False;
+      Lang    : Name_Id;
+      Suffix  : Array_Element_Id;
+      Found   : Boolean := False;
       Element : Array_Element;
 
    begin
@@ -853,6 +857,7 @@ package body Prj is
    procedure Free (Tree : in out Project_Tree_Ref) is
       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
         (Project_Tree_Data, Project_Tree_Ref);
+
    begin
       if Tree /= null then
          Name_List_Table.Free (Tree.Name_Lists);
@@ -898,8 +903,6 @@ package body Prj is
 
    procedure Reset (Tree : Project_Tree_Ref) is
    begin
-      Prj.Env.Initialize;
-
       --  Visible tables
 
       Name_List_Table.Init          (Tree.Name_Lists);
@@ -945,6 +948,13 @@ package body Prj is
             In_Tree             => Tree);
          Tree.Private_Part.Default_Naming.Separate_Suffix :=
            Default_Ada_Body_Suffix;
+
+         Tree.Private_Part.Current_Source_Path_File := No_Path;
+         Tree.Private_Part.Current_Object_Path_File := No_Path;
+         Tree.Private_Part.Ada_Path_Length := 0;
+         Tree.Private_Part.Ada_Prj_Include_File_Set := False;
+         Tree.Private_Part.Ada_Prj_Objects_File_Set := False;
+         Tree.Private_Part.Fill_Mapping_File := True;
       end if;
    end Reset;
 

gcc/ada/prj.ads

@@ -1563,19 +1563,19 @@ private
    --  Initialize.
 
    type Source_Iterator is record
-      In_Tree       : Project_Tree_Ref;
+      In_Tree : Project_Tree_Ref;
 
-      Project       : Project_Id;
-      All_Projects  : Boolean;
+      Project      : Project_Id;
+      All_Projects : Boolean;
       --  Current project and whether we should move on to the next
 
-      Language      : Language_Ptr;
+      Language : Language_Ptr;
       --  Current language processed
 
       Language_Name : Name_Id;
       --  Only sources of this language will be returned (or all if No_Name)
 
-      Current       : Source_Id;
+      Current : Source_Id;
    end record;
 
    procedure Add_To_Buffer
@@ -1625,6 +1625,33 @@ private
       Source_Paths   : Source_Path_Table.Instance;
       Object_Paths   : Object_Path_Table.Instance;
       Default_Naming : Naming_Data;
+
+      Current_Source_Path_File : Path_Name_Type := No_Path;
+      --  Current value of project source path file env var. Used to avoid
+      --  setting the env var to the same value.
+
+      Current_Object_Path_File : Path_Name_Type := No_Path;
+      --  Current value of project object path file env var. Used to avoid
+      --  setting the env var to the same value.
+
+      Ada_Path_Buffer : String_Access := new String (1 .. 1024);
+      --  A buffer where values for ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are
+      --  stored.
+
+      Ada_Path_Length : Natural := 0;
+      --  Index of the last valid character in Ada_Path_Buffer
+
+      Ada_Prj_Include_File_Set : Boolean := False;
+      Ada_Prj_Objects_File_Set : Boolean := False;
+      --  These flags are set to True when the corresponding environment
+      --  variables are set and are used to give these environment variables an
+      --  empty string value at the end of the program. This has no practical
+      --  effect on most platforms, except on VMS where the logical names are
+      --  deassigned, thus avoiding the pollution of the environment of the
+      --  caller.
+
+      Fill_Mapping_File : Boolean := True;
+
    end record;
    --  Type to represent the part of a project tree which is private to the
    --  Project Manager.