gnatcmd.adb, [...] (Prj.Tree.Environment): new type.
authorEmmanuel Briot <briot@adacore.com>
Wed, 3 Aug 2011 09:36:24 +0000 (09:36 +0000)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 3 Aug 2011 09:36:24 +0000 (11:36 +0200)
2011-08-03  Emmanuel Briot  <briot@adacore.com>

* gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, prj-part.adb,
prj-part.ads, switch-m.adb, switch-m.ads, prj-makr.adb, clean.adb,
prj-pars.adb, prj-pars.ads, prj-conf.adb, prj-conf.ads, prj-tree.adb,
prj-tree.ads (Prj.Tree.Environment): new type.

From-SVN: r177248

17 files changed:
gcc/ada/ChangeLog
gcc/ada/clean.adb
gcc/ada/gnatcmd.adb
gcc/ada/make.adb
gcc/ada/prj-conf.adb
gcc/ada/prj-conf.ads
gcc/ada/prj-makr.adb
gcc/ada/prj-pars.adb
gcc/ada/prj-pars.ads
gcc/ada/prj-part.adb
gcc/ada/prj-part.ads
gcc/ada/prj-proc.adb
gcc/ada/prj-proc.ads
gcc/ada/prj-tree.adb
gcc/ada/prj-tree.ads
gcc/ada/switch-m.adb
gcc/ada/switch-m.ads

index f415e5973ffb72d7df2531ac91dc387db99aa122..4287e95e1e86fee854f27b62070f240069f40c33 100644 (file)
@@ -1,3 +1,10 @@
+2011-08-03  Emmanuel Briot  <briot@adacore.com>
+
+       * gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, prj-part.adb,
+       prj-part.ads, switch-m.adb, switch-m.ads, prj-makr.adb, clean.adb,
+       prj-pars.adb, prj-pars.ads, prj-conf.adb, prj-conf.ads, prj-tree.adb,
+       prj-tree.ads (Prj.Tree.Environment): new type.
+
 2011-08-03  Emmanuel Briot  <briot@adacore.com>
 
        * prj-proc.adb, prj.ads, makeutl.adb, makeutl.ads, prj-conf.adb,
index 16897bf3030f4f94dad70a9b988484ca654ed003..49cc5cc24ba2a57090a6618c4bf8e79c6475d078 100644 (file)
@@ -93,6 +93,8 @@ package body Clean is
 
    Project_Node_Tree : Project_Node_Tree_Ref;
 
+   Root_Environment : Prj.Tree.Environment;
+
    Main_Project : Prj.Project_Id := Prj.No_Project;
 
    All_Projects : Boolean := False;
@@ -1400,15 +1402,12 @@ package body Clean is
          --  Parse the project file. If there is an error, Main_Project
          --  will still be No_Project.
 
-         Prj.Env.Initialize_Default_Project_Path
-            (Project_Node_Tree.Project_Path, Target_Name => "");
-
          Prj.Pars.Parse
            (Project           => Main_Project,
             In_Tree           => Project_Tree,
             In_Node_Tree      => Project_Node_Tree,
             Project_File_Name => Project_File_Name.all,
-            Flags             => Gnatmake_Flags,
+            Env               => Root_Environment,
             Packages_To_Check => Packages_To_Check_By_Gnatmake);
 
          if Main_Project = No_Project then
@@ -1561,6 +1560,10 @@ package body Clean is
          Csets.Initialize;
          Snames.Initialize;
 
+         Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
+         Prj.Env.Initialize_Default_Project_Path
+            (Root_Environment.Project_Path, Target_Name => "");
+
          Project_Node_Tree := new Project_Node_Tree_Data;
          Prj.Tree.Initialize (Project_Node_Tree);
 
@@ -1696,7 +1699,7 @@ package body Clean is
 
                         elsif Arg (3) = 'P' then
                            Prj.Env.Add_Directories
-                             (Project_Node_Tree.Project_Path,
+                             (Root_Environment.Project_Path,
                               Arg (4 .. Arg'Last));
 
                         else
@@ -1858,7 +1861,6 @@ package body Clean is
                            Ext_Asgn  : constant String := Arg (3 .. Arg'Last);
                            Start     : Positive := Ext_Asgn'First;
                            Stop      : Natural  := Ext_Asgn'Last;
-                           Equal_Pos : Natural;
                            OK        : Boolean  := True;
 
                         begin
@@ -1872,27 +1874,11 @@ package body Clean is
                               end if;
                            end if;
 
-                           Equal_Pos := Start;
-
-                           while Equal_Pos <= Stop
-                             and then Ext_Asgn (Equal_Pos) /= '='
-                           loop
-                              Equal_Pos := Equal_Pos + 1;
-                           end loop;
-
-                           if Equal_Pos = Start or else Equal_Pos > Stop then
-                              OK := False;
-                           end if;
-
-                           if OK then
-                              Prj.Ext.Add
-                                (Project_Node_Tree.External,
-                                 External_Name =>
-                                   Ext_Asgn (Start .. Equal_Pos - 1),
-                                 Value         =>
-                                   Ext_Asgn (Equal_Pos + 1 .. Stop));
-
-                           else
+                           if not OK
+                              or else not Prj.Ext.Check
+                                (Root_Environment.External,
+                                 Ext_Asgn (Start .. Stop))
+                           then
                               Fail
                                 ("illegal external assignment '"
                                  & Ext_Asgn
index 09b95488a12cf4d365e2469c2fc2d7f86cb0addc..2f72c8d584cbb7efc5d5710b806873ca7f4d1590 100644 (file)
@@ -58,6 +58,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
 
 procedure GNATCmd is
    Project_Node_Tree : Project_Node_Tree_Ref;
+   Root_Environment  : Prj.Tree.Environment;
    Project_File      : String_Access;
    Project           : Prj.Project_Id;
    Current_Verbosity : Prj.Verbosity := Prj.Default;
@@ -246,9 +247,6 @@ procedure GNATCmd is
    --  Get the sources in the closure of the ASIS_Main and add them to the
    --  list of arguments.
 
-   function Index (Char : Character; Str : String) return Natural;
-   --  Returns first occurrence of Char in Str, returns 0 if Char not in Str
-
    procedure Non_VMS_Usage;
    --  Display usage for platforms other than VMS
 
@@ -922,21 +920,6 @@ procedure GNATCmd is
       end if;
    end Get_Closure;
 
-   -----------
-   -- Index --
-   -----------
-
-   function Index (Char : Character; Str : String) return Natural is
-   begin
-      for Index in Str'Range loop
-         if Str (Index) = Char then
-            return Index;
-         end if;
-      end loop;
-
-      return 0;
-   end Index;
-
    ------------------
    -- Mapping_File --
    ------------------
@@ -1364,10 +1347,11 @@ begin
    Csets.Initialize;
    Snames.Initialize;
 
-   Project_Node_Tree := new Project_Node_Tree_Data;
+   Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
    Prj.Env.Initialize_Default_Project_Path
-      (Project_Node_Tree.Project_Path, Target_Name => "");
+      (Root_Environment.Project_Path, Target_Name => "");
 
+   Project_Node_Tree := new Project_Node_Tree_Data;
    Prj.Tree.Initialize (Project_Node_Tree);
 
    Prj.Initialize (Project_Tree);
@@ -1725,7 +1709,7 @@ begin
                     and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP"
                   then
                      Prj.Env.Add_Directories
-                       (Project_Node_Tree.Project_Path,
+                       (Root_Environment.Project_Path,
                         Argv (Argv'First + 3 .. Argv'Last));
 
                      Remove_Switch (Arg_Num);
@@ -1813,25 +1797,12 @@ begin
                   elsif Argv'Length >= 5
                     and then Argv (Argv'First + 1) = 'X'
                   then
-                     declare
-                        Equal_Pos : constant Natural :=
-                                      Index
-                                        ('=',
-                                         Argv (Argv'First + 2 .. Argv'Last));
-                     begin
-                        if Equal_Pos >= Argv'First + 3
-                          and then Equal_Pos /= Argv'Last
-                        then
-                           Add (Project_Node_Tree.External,
-                                External_Name =>
-                                  Argv (Argv'First + 2 .. Equal_Pos - 1),
-                                Value => Argv (Equal_Pos + 1 .. Argv'Last));
-                        else
-                           Fail
-                             (Argv.all
+                     if not Check (Root_Environment.External,
+                                    Argv (Argv'First + 2 .. Argv'Last))
+                     then
+                        Fail (Argv.all
                               & " is not a valid external assignment.");
-                        end if;
-                     end;
+                     end if;
 
                      Remove_Switch (Arg_Num);
 
@@ -1884,7 +1855,7 @@ begin
             In_Tree           => Project_Tree,
             In_Node_Tree      => Project_Node_Tree,
             Project_File_Name => Project_File.all,
-            Flags             => Gnatmake_Flags,
+            Env               => Root_Environment,
             Packages_To_Check => Packages_To_Check);
 
          if Project = Prj.No_Project then
index 2de96c85b65c79abbdfb457af7224de006adaaf5..4901928ccd689a91d9192b12c0318c467e30c0d0 100644 (file)
@@ -645,7 +645,7 @@ package body Make is
    --  directory of the ultimate extending project. If it is not, we ignore
    --  the fact that this ALI file is read-only.
 
-   procedure Process_Multilib (Project_Node_Tree : Project_Node_Tree_Ref);
+   procedure Process_Multilib (Env : in out Prj.Tree.Environment);
    --  Add appropriate --RTS argument to handle multilib
 
    ----------------------------------------------------
@@ -723,7 +723,8 @@ package body Make is
       Index                            : Int;
       Program                          : Make_Program_Type;
       Unknown_Switches_To_The_Compiler : Boolean := True;
-      Project_Node_Tree                : Project_Node_Tree_Ref);
+      Project_Node_Tree                : Project_Node_Tree_Ref;
+      Env                              : in out Prj.Tree.Environment);
    procedure Add_Switch
      (S             : String_Access;
       Program       : Make_Program_Type;
@@ -1021,7 +1022,9 @@ package body Make is
    --  Call the CodePeer globalizer on all the project's object directories,
    --  or on the current directory if no projects.
 
-   procedure Initialize (Project_Node_Tree : out Project_Node_Tree_Ref);
+   procedure Initialize
+      (Project_Node_Tree : out Project_Node_Tree_Ref;
+       Env               : out Prj.Tree.Environment);
    --  Performs default and package initialization. Therefore,
    --  Compile_Sources can be called by an external unit.
 
@@ -1034,7 +1037,7 @@ package body Make is
    --  succeeded or not.
 
    procedure Scan_Make_Arg
-     (Project_Node_Tree : Project_Node_Tree_Ref;
+     (Env               : in out Prj.Tree.Environment;
       Argv              : String;
       And_Save          : Boolean);
    --  Scan make arguments. Argv is a single argument to be processed.
@@ -1262,7 +1265,8 @@ package body Make is
       Index                            : Int;
       Program                          : Make_Program_Type;
       Unknown_Switches_To_The_Compiler : Boolean := True;
-      Project_Node_Tree                : Project_Node_Tree_Ref)
+      Project_Node_Tree                : Project_Node_Tree_Ref;
+      Env                              : in out Prj.Tree.Environment)
    is
       Switches    : Variable_Value;
       Switch_List : String_List_Id;
@@ -1303,8 +1307,7 @@ package body Make is
                         Write_Line (Argv);
                      end if;
 
-                     Scan_Make_Arg
-                       (Project_Node_Tree, Argv, And_Save => False);
+                     Scan_Make_Arg (Env, Argv, And_Save => False);
 
                      if not Gnatmake_Switch_Found
                        and then not Switch_May_Be_Passed_To_The_Compiler
@@ -4234,6 +4237,7 @@ package body Make is
       --  The path name of the mapping file
 
       Project_Node_Tree : Project_Node_Tree_Ref;
+      Root_Environment  : Prj.Tree.Environment;
 
       Discard : Boolean;
       pragma Warnings (Off, Discard);
@@ -4397,7 +4401,7 @@ package body Make is
 
       Obsoleted.Reset;
 
-      Make.Initialize (Project_Node_Tree);
+      Make.Initialize (Project_Node_Tree, Root_Environment);
 
       Bind_Shared := No_Shared_Switch'Access;
       Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access;
@@ -4880,6 +4884,7 @@ package body Make is
 
                   Add_Switches
                     (Project_Node_Tree                => Project_Node_Tree,
+                     Env                              => Root_Environment,
                      File_Name                        => Main_Unit_File_Name,
                      Index                            => Main_Index,
                      The_Package                      => Builder_Package,
@@ -4936,6 +4941,7 @@ package body Make is
 
                         Add_Switches
                           (Project_Node_Tree              => Project_Node_Tree,
+                           Env                            => Root_Environment,
                            File_Name                        => " ",
                            Index                            => 0,
                            The_Package                      => Builder_Package,
@@ -4953,6 +4959,7 @@ package body Make is
 
                         Add_Switches
                           (Project_Node_Tree => Project_Node_Tree,
+                           Env               => Root_Environment,
                            File_Name   => " ",
                            Index       => 0,
                            The_Package => Builder_Package,
@@ -5045,6 +5052,7 @@ package body Make is
 
                Add_Switches
                  (Project_Node_Tree => Project_Node_Tree,
+                  Env               => Root_Environment,
                   File_Name         => Main_Unit_File_Name,
                   Index             => Main_Index,
                   The_Package       => Binder_Package,
@@ -5062,6 +5070,7 @@ package body Make is
 
                Add_Switches
                  (Project_Node_Tree => Project_Node_Tree,
+                  Env               => Root_Environment,
                   File_Name         => Main_Unit_File_Name,
                   Index             => Main_Index,
                   The_Package       => Linker_Package,
@@ -6401,6 +6410,7 @@ package body Make is
 
                      Add_Switches
                        (Project_Node_Tree => Project_Node_Tree,
+                        Env               => Root_Environment,
                         File_Name         => Main_Unit_File_Name,
                         Index             => Main_Index,
                         The_Package       => Binder_Package,
@@ -6419,6 +6429,7 @@ package body Make is
 
                      Add_Switches
                        (Project_Node_Tree => Project_Node_Tree,
+                        Env               => Root_Environment,
                         File_Name         => Main_Unit_File_Name,
                         Index             => Main_Index,
                         The_Package       => Linker_Package,
@@ -6623,8 +6634,10 @@ package body Make is
    -- Initialize --
    ----------------
 
-   procedure Initialize (Project_Node_Tree : out Project_Node_Tree_Ref) is
-
+   procedure Initialize
+      (Project_Node_Tree : out Project_Node_Tree_Ref;
+       Env               : out Prj.Tree.Environment)
+   is
       procedure Check_Version_And_Help is
          new Check_Version_And_Help_G (Makeusg);
 
@@ -6635,10 +6648,11 @@ package body Make is
       --  references, project path and other attributes that can be impacted by
       --  the command line switches
 
-      Project_Node_Tree := new Project_Node_Tree_Data;
+      Prj.Tree.Initialize (Env, Gnatmake_Flags);
       Prj.Env.Initialize_Default_Project_Path
-         (Project_Node_Tree.Project_Path, Target_Name => "");
+         (Env.Project_Path, Target_Name => "");
 
+      Project_Node_Tree := new Project_Node_Tree_Data;
       Prj.Tree.Initialize (Project_Node_Tree);
 
       --  Override default initialization of Check_Object_Consistency since
@@ -6721,12 +6735,11 @@ package body Make is
       --  do not include --version or --help.
 
       Scan_Args : for Next_Arg in 1 .. Argument_Count loop
-         Scan_Make_Arg
-           (Project_Node_Tree, Argument (Next_Arg), And_Save => True);
+         Scan_Make_Arg (Env, Argument (Next_Arg), And_Save => True);
       end loop Scan_Args;
 
       if N_M_Switch > 0 and RTS_Specified = null then
-         Process_Multilib (Project_Node_Tree);
+         Process_Multilib (Env);
       end if;
 
       if Commands_To_Stdout then
@@ -6811,7 +6824,7 @@ package body Make is
             In_Tree           => Project_Tree,
             Project_File_Name => Project_File_Name.all,
             Packages_To_Check => Packages_To_Check_By_Gnatmake,
-            Flags             => Gnatmake_Flags,
+            Env               => Env,
             In_Node_Tree      => Project_Node_Tree);
 
          --  The parsing of project files may have changed the current output
@@ -7347,9 +7360,7 @@ package body Make is
    -- Process_Multilib --
    ----------------------
 
-   procedure Process_Multilib
-     (Project_Node_Tree : Project_Node_Tree_Ref)
-   is
+   procedure Process_Multilib (Env : in out Prj.Tree.Environment) is
       Output_FD         : File_Descriptor;
       Output_Name       : String_Access;
       Arg_Index         : Natural := 0;
@@ -7450,9 +7461,8 @@ package body Make is
 
       --  Otherwise add -margs --RTS=output
 
-      Scan_Make_Arg (Project_Node_Tree, "-margs", And_Save => True);
-      Scan_Make_Arg
-        (Project_Node_Tree, "--RTS=" & Line (1 .. N_Read), And_Save => True);
+      Scan_Make_Arg (Env, "-margs", And_Save => True);
+      Scan_Make_Arg (Env, "--RTS=" & Line (1 .. N_Read), And_Save => True);
    end Process_Multilib;
 
    -----------
@@ -7839,7 +7849,7 @@ package body Make is
    -------------------
 
    procedure Scan_Make_Arg
-     (Project_Node_Tree : Project_Node_Tree_Ref;
+     (Env               : in out Prj.Tree.Environment;
       Argv              : String;
       And_Save          : Boolean)
    is
@@ -8129,7 +8139,7 @@ package body Make is
                 (Argv (Create_Map_File_Switch'Length + 2 .. Argv'Last));
 
          else
-            Scan_Make_Switches (Project_Node_Tree, Argv, Success);
+            Scan_Make_Switches (Env, Argv, Success);
          end if;
 
       --  If we have seen a regular switch process it
@@ -8265,7 +8275,7 @@ package body Make is
                  ("-D cannot be used in conjunction with a project file");
 
             else
-               Scan_Make_Switches (Project_Node_Tree, Argv, Success);
+               Scan_Make_Switches (Env, Argv, Success);
             end if;
 
          --  -d
@@ -8280,13 +8290,13 @@ package body Make is
                Make_Failed
                  ("-i cannot be used in conjunction with a project file");
             else
-               Scan_Make_Switches (Project_Node_Tree, Argv, Success);
+               Scan_Make_Switches (Env, Argv, Success);
             end if;
 
          --  -j (need to save the result)
 
          elsif Argv (2) = 'j' then
-            Scan_Make_Switches (Project_Node_Tree, Argv, Success);
+            Scan_Make_Switches (Env, Argv, Success);
 
             if And_Save then
                Saved_Maximum_Processes := Maximum_Processes;
@@ -8371,7 +8381,7 @@ package body Make is
          --  -Xext=val  (External assignment)
 
          elsif Argv (2) = 'X'
-           and then Is_External_Assignment (Project_Node_Tree, Argv)
+           and then Is_External_Assignment (Env, Argv)
          then
             --  Is_External_Assignment has side effects when it returns True
 
@@ -8419,8 +8429,7 @@ package body Make is
          --  is passed to the compiler.
 
          else
-            Scan_Make_Switches
-              (Project_Node_Tree, Argv, Gnatmake_Switch_Found);
+            Scan_Make_Switches (Env, Argv, Gnatmake_Switch_Found);
 
             if not Gnatmake_Switch_Found then
                Add_Switch (Argv, Compiler, And_Save => And_Save);
index de25dce40fba6f41b387ae294f5c3f0ef79d0e4c..978d4130ddf91e54836e0d0f6126b7df4ae311c0 100644 (file)
@@ -573,7 +573,7 @@ package body Prj.Conf is
      (Project                    : Project_Id;
       Project_Tree               : Project_Tree_Ref;
       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
-      Env                        : Prj.Tree.Environment;
+      Env                        : in out Prj.Tree.Environment;
       Allow_Automatic_Generation : Boolean;
       Config_File_Name           : String := "";
       Autoconf_Specified         : Boolean;
@@ -583,7 +583,6 @@ package body Prj.Conf is
       Config                     : out Prj.Project_Id;
       Config_File_Path           : out String_Access;
       Automatically_Generated    : out Boolean;
-      Flags                      : Processing_Flags;
       On_Load_Config             : Config_File_Hook := null)
    is
 
@@ -933,13 +932,13 @@ package body Prj.Conf is
             end if;
 
             if not Is_Directory (Obj_Dir) then
-               case Flags.Require_Obj_Dirs is
+               case Env.Flags.Require_Obj_Dirs is
                   when Error =>
                      Raise_Invalid_Config
                        ("object directory " & Obj_Dir & " does not exist");
                   when Warning =>
                      Prj.Err.Error_Msg
-                       (Flags,
+                       (Env.Flags,
                         "?object directory " & Obj_Dir & " does not exist");
                      Obj_Dir_Exists := False;
                   when Silent =>
@@ -1124,7 +1123,7 @@ package body Prj.Conf is
             Packages_To_Check      => Packages_To_Check,
             Current_Directory      => Current_Directory,
             Is_Config_File         => True,
-            Flags                  => Flags);
+            Env                    => Env);
       else
          Config_Project_Node := Empty_Node;
       end if;
@@ -1136,7 +1135,7 @@ package body Prj.Conf is
             Success                => Success,
             From_Project_Node      => Config_Project_Node,
             From_Project_Node_Tree => Project_Node_Tree,
-            Flags                  => Flags,
+            Env                    => Env,
             Reset_Tree             => False);
       end if;
 
@@ -1190,17 +1189,17 @@ package body Prj.Conf is
       Project_File_Name          : String;
       Project_Tree               : Prj.Project_Tree_Ref;
       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
+      Env                        : in out Prj.Tree.Environment;
       Packages_To_Check          : String_List_Access;
       Allow_Automatic_Generation : Boolean := True;
       Automatically_Generated    : out Boolean;
       Config_File_Path           : out String_Access;
       Target_Name                : String := "";
       Normalized_Hostname        : String;
-      Flags                      : Processing_Flags;
       On_Load_Config             : Config_File_Hook := null)
    is
    begin
-      pragma Assert (Prj.Env.Is_Initialized (Project_Node_Tree.Project_Path));
+      pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
 
       --  Parse the user project tree
 
@@ -1217,7 +1216,7 @@ package body Prj.Conf is
          Packages_To_Check      => Packages_To_Check,
          Current_Directory      => Current_Directory,
          Is_Config_File         => False,
-         Flags                  => Flags);
+         Env                    => Env);
 
       if User_Project_Node = Empty_Node then
          User_Project_Node := Empty_Node;
@@ -1231,13 +1230,13 @@ package body Prj.Conf is
          Autoconf_Specified         => Autoconf_Specified,
          Project_Tree               => Project_Tree,
          Project_Node_Tree          => Project_Node_Tree,
+         Env                        => Env,
          Packages_To_Check          => Packages_To_Check,
          Allow_Automatic_Generation => Allow_Automatic_Generation,
          Automatically_Generated    => Automatically_Generated,
          Config_File_Path           => Config_File_Path,
          Target_Name                => Target_Name,
          Normalized_Hostname        => Normalized_Hostname,
-         Flags                      => Flags,
          On_Load_Config             => On_Load_Config);
    end Parse_Project_And_Apply_Config;
 
@@ -1252,13 +1251,13 @@ package body Prj.Conf is
       Autoconf_Specified         : Boolean;
       Project_Tree               : Prj.Project_Tree_Ref;
       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
+      Env                        : in out Prj.Tree.Environment;
       Packages_To_Check          : String_List_Access;
       Allow_Automatic_Generation : Boolean := True;
       Automatically_Generated    : out Boolean;
       Config_File_Path           : out String_Access;
       Target_Name                : String := "";
       Normalized_Hostname        : String;
-      Flags                      : Processing_Flags;
       On_Load_Config             : Config_File_Hook := null;
       Reset_Tree                 : Boolean := True)
    is
@@ -1275,7 +1274,7 @@ package body Prj.Conf is
          Success                => Success,
          From_Project_Node      => User_Project_Node,
          From_Project_Node_Tree => Project_Node_Tree,
-         Flags                  => Flags,
+         Env                    => Env,
          Reset_Tree             => Reset_Tree);
 
       if not Success then
@@ -1326,6 +1325,7 @@ package body Prj.Conf is
          Project                    => Main_Project,
          Project_Tree               => Project_Tree,
          Project_Node_Tree          => Project_Node_Tree,
+         Env                        => Env,
          Allow_Automatic_Generation => Allow_Automatic_Generation,
          Config_File_Name           => Config_File_Name,
          Autoconf_Specified         => Autoconf_Specified,
@@ -1334,7 +1334,6 @@ package body Prj.Conf is
          Packages_To_Check          => Packages_To_Check,
          Config_File_Path           => Config_File_Path,
          Automatically_Generated    => Automatically_Generated,
-         Flags                      => Flags,
          On_Load_Config             => On_Load_Config);
 
       Apply_Config_File (Main_Config_Project, Project_Tree);
@@ -1347,7 +1346,7 @@ package body Prj.Conf is
          Success                    => Success,
          From_Project_Node          => User_Project_Node,
          From_Project_Node_Tree     => Project_Node_Tree,
-         Flags                      => Flags);
+         Env                        => Env);
 
       if Success then
          if Project_Tree.Source_Info_File_Name /= null and then
index 199e3e8094741ad1f0ba871537f453d85d914c63..af331846ce43f8a8246141c55f545aa005d4e83f 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---            Copyright (C) 2006-2009, Free Software Foundation, Inc.       --
+--            Copyright (C) 2006-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- --
@@ -48,13 +48,13 @@ package Prj.Conf is
       Project_File_Name          : String;
       Project_Tree               : Prj.Project_Tree_Ref;
       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
+      Env                        : in out Prj.Tree.Environment;
       Packages_To_Check          : String_List_Access;
       Allow_Automatic_Generation : Boolean := True;
       Automatically_Generated    : out Boolean;
       Config_File_Path           : out String_Access;
       Target_Name                : String := "";
       Normalized_Hostname        : String;
-      Flags                      : Processing_Flags;
       On_Load_Config             : Config_File_Hook := null);
    --  Find the main configuration project and parse the project tree rooted at
    --  this configuration project.
@@ -93,13 +93,13 @@ package Prj.Conf is
       Autoconf_Specified         : Boolean;
       Project_Tree               : Prj.Project_Tree_Ref;
       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
+      Env                        : in out Prj.Tree.Environment;
       Packages_To_Check          : String_List_Access;
       Allow_Automatic_Generation : Boolean := True;
       Automatically_Generated    : out Boolean;
       Config_File_Path           : out String_Access;
       Target_Name                : String := "";
       Normalized_Hostname        : String;
-      Flags                      : Processing_Flags;
       On_Load_Config             : Config_File_Hook := null;
       Reset_Tree                 : Boolean := True);
    --  Same as above, except the project must already have been parsed through
@@ -121,6 +121,7 @@ package Prj.Conf is
      (Project                    : Prj.Project_Id;
       Project_Tree               : Prj.Project_Tree_Ref;
       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
+      Env                        : in out Prj.Tree.Environment;
       Allow_Automatic_Generation : Boolean;
       Config_File_Name           : String := "";
       Autoconf_Specified         : Boolean;
@@ -130,7 +131,6 @@ package Prj.Conf is
       Config                     : out Prj.Project_Id;
       Config_File_Path           : out String_Access;
       Automatically_Generated    : out Boolean;
-      Flags                      : Processing_Flags;
       On_Load_Config             : Config_File_Hook := null);
    --  Compute the name of the configuration file that should be used. If no
    --  default configuration file is found, a new one will be automatically
index 2910a3a3d0d6e6f202ee608c724012ca248db45f..439ac0598a4f79fc0d0e8fdf98f4f007f095712f 100644 (file)
@@ -61,6 +61,8 @@ package body Prj.Makr is
    Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data;
    --  The project tree where the project file is parsed
 
+   Root_Environment : Prj.Tree.Environment;
+
    Args : Argument_List_Access;
    --  The list of arguments for calls to the compiler to get the unit names
    --  and kinds (spec or body) in the Ada sources.
@@ -795,10 +797,14 @@ package body Prj.Makr is
 
       Csets.Initialize;
       Snames.Initialize;
+
       Prj.Initialize (No_Project_Tree);
-      Prj.Tree.Initialize (Tree);
+
+      Prj.Tree.Initialize (Root_Environment, Flags);
       Prj.Env.Initialize_Default_Project_Path
-         (Tree.Project_Path, Target_Name => "");
+         (Root_Environment.Project_Path, Target_Name => "");
+
+      Prj.Tree.Initialize (Tree);
 
       Sources.Set_Last (0);
       Source_Directories.Set_Last (0);
@@ -866,7 +872,7 @@ package body Prj.Makr is
                Errout_Handling        => Part.Finalize_If_Error,
                Store_Comments         => True,
                Is_Config_File         => False,
-               Flags                  => Flags,
+               Env                    => Root_Environment,
                Current_Directory      => Get_Current_Dir,
                Packages_To_Check      => Packages_To_Check_By_Gnatname);
 
index c638d9e6d9b2c5c0ed0241c6cfb56001252b5066..f2d289f5c3872ba76c2a60af5ef621a3bd28893c 100644 (file)
@@ -28,7 +28,6 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations;
 
 with Output;   use Output;
 with Prj.Conf; use Prj.Conf;
-with Prj.Env;
 with Prj.Err;  use Prj.Err;
 with Prj.Part;
 with Prj.Tree; use Prj.Tree;
@@ -45,9 +44,9 @@ package body Prj.Pars is
       Project           : out Project_Id;
       Project_File_Name : String;
       Packages_To_Check : String_List_Access := All_Packages;
-      Flags             : Processing_Flags;
       Reset_Tree        : Boolean := True;
-      In_Node_Tree      : Prj.Tree.Project_Node_Tree_Ref := null)
+      In_Node_Tree      : Prj.Tree.Project_Node_Tree_Ref := null;
+      Env               : in out Prj.Tree.Environment)
    is
       Project_Node            : Project_Node_Id := Empty_Node;
       The_Project             : Project_Id      := No_Project;
@@ -61,8 +60,6 @@ package body Prj.Pars is
       if Project_Node_Tree = null then
          Project_Node_Tree := new Project_Node_Tree_Data;
          Prj.Tree.Initialize (Project_Node_Tree);
-         Prj.Env.Initialize_Default_Project_Path
-            (Project_Node_Tree.Project_Path, Target_Name => "");
       end if;
 
       --  Parse the main project file into a tree
@@ -75,7 +72,7 @@ package body Prj.Pars is
          Errout_Handling        => Prj.Part.Finalize_If_Error,
          Packages_To_Check      => Packages_To_Check,
          Current_Directory      => Current_Dir,
-         Flags                  => Flags,
+         Env                    => Env,
          Is_Config_File         => False);
 
       --  If there were no error, process the tree
@@ -97,7 +94,7 @@ package body Prj.Pars is
                Allow_Automatic_Generation => False,
                Automatically_Generated    => Automatically_Generated,
                Config_File_Path           => Config_File_Path,
-               Flags                      => Flags,
+               Env                        => Env,
                Normalized_Hostname        => "",
                On_Load_Config             =>
                  Add_Default_GNAT_Naming_Scheme'Access,
index 4e7d4808d4a074168b61cfea11619a3138d36051..fcfde9161179f37743f18c81bd9b8901bb7304ce 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2000-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-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- --
@@ -37,9 +37,9 @@ package Prj.Pars is
       Project           : out Project_Id;
       Project_File_Name : String;
       Packages_To_Check : String_List_Access := All_Packages;
-      Flags             : Processing_Flags;
       Reset_Tree        : Boolean := True;
-      In_Node_Tree      : Prj.Tree.Project_Node_Tree_Ref := null);
+      In_Node_Tree      : Prj.Tree.Project_Node_Tree_Ref := null;
+      Env               : in out Prj.Tree.Environment);
    --  Parse and process a project files and all its imported project files, in
    --  the project tree In_Tree.
    --  All the project files are parsed (through Prj.Tree) to create a tree in
index 3438fdee6793e87cd3214ae60fa8f25b0725ae25..b75716729b74ffd1b4a0a4fb876b44b21b038fa5 100644 (file)
@@ -185,7 +185,7 @@ package body Prj.Part is
       Depth             : Natural;
       Current_Dir       : String;
       Is_Config_File    : Boolean;
-      Flags             : Processing_Flags);
+      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
@@ -220,7 +220,7 @@ package body Prj.Part is
       Depth             : Natural;
       Current_Dir       : String;
       Is_Config_File    : Boolean;
-      Flags             : Processing_Flags);
+      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
@@ -448,7 +448,7 @@ package body Prj.Part is
       Store_Comments         : Boolean := False;
       Current_Directory      : String := "";
       Is_Config_File         : Boolean;
-      Flags                  : Processing_Flags;
+      Env                    : in out Prj.Tree.Environment;
       Target_Name            : String := "")
    is
       Dummy : Boolean;
@@ -460,9 +460,9 @@ package body Prj.Part is
       Path_Name_Id : Path_Name_Type;
 
    begin
-      if not Is_Initialized (In_Tree.Project_Path) then
+      if not Is_Initialized (Env.Project_Path) then
          Prj.Env.Initialize_Default_Project_Path
-           (In_Tree.Project_Path, Target_Name);
+           (Env.Project_Path, Target_Name);
       end if;
 
       if Real_Project_File_Name = null then
@@ -471,7 +471,7 @@ package body Prj.Part is
 
       Project := Empty_Node;
 
-      Find_Project (In_Tree.Project_Path,
+      Find_Project (Env.Project_Path,
                     Project_File_Name => Real_Project_File_Name.all,
                     Directory         => Current_Directory,
                     Path              => Path_Name_Id);
@@ -488,7 +488,7 @@ package body Prj.Part is
          declare
             P : String_Access;
          begin
-            Get_Path (In_Tree.Project_Path, Path => P);
+            Get_Path (Env.Project_Path, Path => P);
 
             Prj.Com.Fail
               ("project file """
@@ -515,7 +515,7 @@ package body Prj.Part is
             Depth             => 0,
             Current_Dir       => Current_Directory,
             Is_Config_File    => Is_Config_File,
-            Flags             => Flags);
+            Env               => Env);
 
       exception
          when Types.Unrecoverable_Error =>
@@ -755,7 +755,7 @@ package body Prj.Part is
       Depth             : Natural;
       Current_Dir       : String;
       Is_Config_File    : Boolean;
-      Flags             : Processing_Flags)
+      Env               : in out Environment)
    is
       Current_With_Clause : With_Id := Context_Clause;
 
@@ -788,7 +788,7 @@ package body Prj.Part is
 
          if Limited_Withs = Current_With.Limited_With then
             Find_Project
-              (In_Tree.Project_Path,
+              (Env.Project_Path,
                Project_File_Name => Get_Name_String (Current_With.Path),
                Directory         => Project_Directory_Path,
                Path              => Imported_Path_Name_Id);
@@ -799,7 +799,7 @@ package body Prj.Part is
 
                Error_Msg_File_1 := File_Name_Type (Current_With.Path);
                Error_Msg
-                 (Flags, "unknown project file: {", Current_With.Location);
+                 (Env.Flags, "unknown project file: {", Current_With.Location);
 
                --  If this is not imported by the main project file, display
                --  the import path.
@@ -810,7 +810,7 @@ package body Prj.Part is
                        File_Name_Type
                          (Project_Stack.Table (Index).Path_Name);
                      Error_Msg
-                       (Flags, "\imported by {", Current_With.Location);
+                       (Env.Flags, "\imported by {", Current_With.Location);
                   end loop;
                end if;
 
@@ -895,7 +895,7 @@ package body Prj.Part is
                         Depth             => Depth,
                         Current_Dir       => Current_Dir,
                         Is_Config_File    => Is_Config_File,
-                        Flags             => Flags);
+                        Env               => Env);
 
                   else
                      Extends_All := Is_Extending_All (Withed_Project, In_Tree);
@@ -1138,7 +1138,7 @@ package body Prj.Part is
       Depth             : Natural;
       Current_Dir       : String;
       Is_Config_File    : Boolean;
-      Flags             : Processing_Flags)
+      Env               : in out Environment)
    is
       Path_Name : constant String := Get_Name_String (Path_Name_Id);
 
@@ -1196,7 +1196,7 @@ package body Prj.Part is
       end;
 
       if Has_Circular_Dependencies
-           (Flags, Normed_Path_Name, Canonical_Path_Name)
+           (Env.Flags, Normed_Path_Name, Canonical_Path_Name)
       then
          Project := Empty_Node;
          return;
@@ -1221,13 +1221,13 @@ package body Prj.Part is
                if A_Project_Name_And_Node.Extended then
                   if A_Project_Name_And_Node.Proj_Qualifier /= Dry then
                      Error_Msg
-                       (Flags,
+                       (Env.Flags,
                         "cannot extend the same project file several times",
                         Token_Ptr);
                   end if;
                else
                   Error_Msg
-                    (Flags,
+                    (Env.Flags,
                      "cannot extend an already imported project file",
                      Token_Ptr);
                end if;
@@ -1268,7 +1268,7 @@ package body Prj.Part is
                   end;
                else
                   Error_Msg
-                    (Flags,
+                    (Env.Flags,
                      "cannot import an already extended project file",
                      Token_Ptr);
                end if;
@@ -1308,7 +1308,7 @@ package body Prj.Part is
          --  following Ada identifier's syntax).
 
          Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
-         Error_Msg (Flags,
+         Error_Msg (Env.Flags,
                     "?{ is not a valid path name for a project file",
                     Token_Ptr);
       end if;
@@ -1326,7 +1326,7 @@ package body Prj.Part is
         (In_Tree        => In_Tree,
          Is_Config_File => Is_Config_File,
          Context_Clause => First_With,
-         Flags          => Flags);
+         Flags          => Env.Flags);
 
       Project := Default_Project_Node
                    (Of_Kind => N_Project, In_Tree => In_Tree);
@@ -1335,7 +1335,7 @@ package body Prj.Part is
       Set_Path_Name_Of (Project, In_Tree,  Normed_Path_Name);
 
       Read_Project_Qualifier
-        (Flags, In_Tree, Is_Config_File, Qualifier_Location, Project);
+        (Env.Flags, In_Tree, Is_Config_File, Qualifier_Location, Project);
 
       Set_Location_Of (Project, In_Tree, Token_Ptr);
 
@@ -1388,7 +1388,7 @@ package body Prj.Part is
 
          if Is_Config_File then
             Error_Msg
-              (Flags,
+              (Env.Flags,
                "extending configuration project not allowed", Token_Ptr);
          end if;
 
@@ -1451,7 +1451,7 @@ package body Prj.Part is
                end if;
 
                Error_Msg
-                 (Flags,
+                 (Env.Flags,
                   "?file name does not match project name, should be `%%"
                   & Extension.all & "`",
                   Token_Ptr);
@@ -1501,7 +1501,7 @@ package body Prj.Part is
                Depth             => Depth + 1,
                Current_Dir       => Current_Dir,
                Is_Config_File    => Is_Config_File,
-               Flags             => Flags);
+               Env               => Env);
             Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
          end;
 
@@ -1530,12 +1530,13 @@ package body Prj.Part is
                   Duplicated := True;
                   Error_Msg_Name_1 := Project_Name;
                   Error_Msg
-                    (Flags, "duplicate project name %%",
+                    (Env.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));
+                    (Env.Flags,
+                     "\already in %%", Location_Of (Project, In_Tree));
                end if;
             end;
          end if;
@@ -1559,7 +1560,7 @@ package body Prj.Part is
 
             begin
                Find_Project
-                 (In_Tree.Project_Path,
+                 (Env.Project_Path,
                   Project_File_Name => Original_Path_Name,
                   Directory         => Get_Name_String (Project_Directory),
                   Path              => Extended_Project_Path_Name_Id);
@@ -1570,7 +1571,7 @@ package body Prj.Part is
 
                   Error_Msg_Name_1 := Token_Name;
 
-                  Error_Msg (Flags, "unknown project file: %%", Token_Ptr);
+                  Error_Msg (Env.Flags, "unknown project file: %%", Token_Ptr);
 
                   --  If not in the main project file, display the import path
 
@@ -1578,13 +1579,13 @@ package body Prj.Part is
                      Error_Msg_Name_1 :=
                        Name_Id
                          (Project_Stack.Table (Project_Stack.Last).Path_Name);
-                     Error_Msg (Flags, "\extended by %%", Token_Ptr);
+                     Error_Msg (Env.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);
+                        Error_Msg (Env.Flags, "\imported by %%", Token_Ptr);
                      end loop;
                   end if;
 
@@ -1609,7 +1610,7 @@ package body Prj.Part is
                         Depth             => Depth + 1,
                         Current_Dir       => Current_Dir,
                         Is_Config_File    => Is_Config_File,
-                        Flags             => Flags);
+                        Env               => Env);
                   end;
 
                   if Present (Extended_Project) then
@@ -1630,7 +1631,7 @@ package body Prj.Part is
                        Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
                      then
                         Error_Msg
-                          (Flags, "an abstract project can only extend " &
+                          (Env.Flags, "an abstract project can only extend " &
                            "another abstract project",
                            Qualifier_Location);
                      end if;
@@ -1642,8 +1643,8 @@ package body Prj.Part is
          end if;
       end if;
 
-      Check_Extending_All_Imports (Flags, In_Tree, Project);
-      Check_Aggregate_Imports (Flags, In_Tree, Project);
+      Check_Extending_All_Imports (Env.Flags, In_Tree, Project);
+      Check_Aggregate_Imports (Env.Flags, In_Tree, Project);
 
       --  Check that a project with a name including a dot either imports
       --  or extends the project whose name precedes the last dot.
@@ -1710,7 +1711,7 @@ package body Prj.Part is
 
                Error_Msg_Name_1 := Name_Of_Project;
                Error_Msg_Name_2 := Parent_Name;
-               Error_Msg (Flags,
+               Error_Msg (Env.Flags,
                           "project %% does not import or extend project %%",
                           Location_Of (Project, In_Tree));
             end if;
@@ -1735,7 +1736,7 @@ package body Prj.Part is
             Extends           => Extended_Project,
             Packages_To_Check => Packages_To_Check,
             Is_Config_File    => Is_Config_File,
-            Flags             => Flags);
+            Flags             => Env.Flags);
          Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
 
          if Present (Extended_Project)
@@ -1794,7 +1795,7 @@ package body Prj.Part is
          then
             --  Invalid name: report an error
 
-            Error_Msg (Flags, "expected """ &
+            Error_Msg (Env.Flags, "expected """ &
                        Get_Name_String (Name_Of (Project, In_Tree)) & """",
                        Token_Ptr);
          end if;
@@ -1811,7 +1812,8 @@ package body Prj.Part is
 
          if Token /= Tok_EOF then
             Error_Msg
-              (Flags, "unexpected text following end of project", Token_Ptr);
+              (Env.Flags,
+               "unexpected text following end of project", Token_Ptr);
          end if;
       end if;
 
@@ -1859,7 +1861,7 @@ package body Prj.Part is
             Depth             => Depth + 1,
             Current_Dir       => Current_Dir,
             Is_Config_File    => Is_Config_File,
-            Flags             => Flags);
+            Env               => Env);
          Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
       end;
 
index c4468a41531f0ba62c76cb39d7cba31bfbea8585..16b84abb502c14720b4bd5a937e222ffa3548962 100644 (file)
@@ -46,7 +46,7 @@ package Prj.Part is
       Store_Comments         : Boolean := False;
       Current_Directory      : String := "";
       Is_Config_File         : Boolean;
-      Flags                  : Processing_Flags;
+      Env                    : in out Prj.Tree.Environment;
       Target_Name            : String := "");
    --  Parse project file and all its imported project files and create a tree.
    --  Return the node for the project (or Empty_Node if parsing failed). If
index 9c9c3b5f32c73ef0bb36cb270fd9329d6321b93c..6dd3ca7311df4aabf5e23b4f50fc1f845eedea89 100644 (file)
@@ -104,9 +104,9 @@ package body Prj.Proc is
    function Expression
      (Project                : Project_Id;
       In_Tree                : Project_Tree_Ref;
-      Flags                  : Processing_Flags;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
+      Env                    : Prj.Tree.Environment;
       Pkg                    : Package_Id;
       First_Term             : Project_Node_Id;
       Kind                   : Variable_Kind) return Variable_Value;
@@ -127,9 +127,9 @@ package body Prj.Proc is
    procedure Process_Declarative_Items
      (Project                : Project_Id;
       In_Tree                : Project_Tree_Ref;
-      Flags                  : Processing_Flags;
       From_Project_Node      : Project_Node_Id;
       Node_Tree              : Project_Node_Tree_Ref;
+      Env                    : Prj.Tree.Environment;
       Pkg                    : Package_Id;
       Item                   : Project_Node_Id);
    --  Process declarative items starting with From_Project_Node, and put them
@@ -139,9 +139,9 @@ package body Prj.Proc is
    procedure Recursive_Process
      (In_Tree                : Project_Tree_Ref;
       Project                : out Project_Id;
-      Flags                  : Processing_Flags;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
+      Env                    : in out Prj.Tree.Environment;
       Extended_By            : Project_Id);
    --  Process project with node From_Project_Node in the tree. Do nothing if
    --  From_Project_Node is Empty_Node. If project has already been processed,
@@ -502,9 +502,9 @@ package body Prj.Proc is
    function Expression
      (Project                : Project_Id;
       In_Tree                : Project_Tree_Ref;
-      Flags                  : Processing_Flags;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
+      Env                    : Prj.Tree.Environment;
       Pkg                    : Package_Id;
       First_Term             : Project_Node_Id;
       Kind                   : Variable_Kind) return Variable_Value
@@ -607,9 +607,9 @@ package body Prj.Proc is
                      Value := Expression
                        (Project                => Project,
                         In_Tree                => In_Tree,
-                        Flags                  => Flags,
                         From_Project_Node      => From_Project_Node,
                         From_Project_Node_Tree => From_Project_Node_Tree,
+                        Env                    => Env,
                         Pkg                    => Pkg,
                         First_Term             =>
                           Tree.First_Term
@@ -657,9 +657,9 @@ package body Prj.Proc is
                           Expression
                             (Project                => Project,
                              In_Tree                => In_Tree,
-                             Flags                  => Flags,
                              From_Project_Node      => From_Project_Node,
                              From_Project_Node_Tree => From_Project_Node_Tree,
+                             Env                    => Env,
                              Pkg                    => Pkg,
                              First_Term             =>
                                Tree.First_Term
@@ -1044,9 +1044,9 @@ package body Prj.Proc is
                      Def_Var := Expression
                        (Project                => Project,
                         In_Tree                => In_Tree,
-                        Flags                  => Flags,
                         From_Project_Node      => From_Project_Node,
                         From_Project_Node_Tree => From_Project_Node_Tree,
+                        Env                    => Env,
                         Pkg                    => Pkg,
                         First_Term             =>
                           Tree.First_Term
@@ -1063,9 +1063,7 @@ package body Prj.Proc is
                                 From_Project_Node_Tree) = List;
 
                   if Ext_List then
-                     Value :=
-                       Prj.Ext.Value_Of
-                         (From_Project_Node_Tree.External, Name, No_Name);
+                     Value := Prj.Ext.Value_Of (Env.External, Name, No_Name);
 
                      if Value /= No_Name then
                         declare
@@ -1169,14 +1167,12 @@ package body Prj.Proc is
                   else
                      --  Get the value
 
-                     Value :=
-                       Prj.Ext.Value_Of
-                         (From_Project_Node_Tree.External, Name, Default);
+                     Value := Prj.Ext.Value_Of (Env.External, Name, Default);
 
                      if Value = No_Name then
                         if not Quiet_Output then
                            Error_Msg
-                             (Flags, "?undefined external reference",
+                             (Env.Flags, "?undefined external reference",
                               Location_Of
                                 (The_Current_Term, From_Project_Node_Tree),
                               Project);
@@ -1387,7 +1383,7 @@ package body Prj.Proc is
       Success                : out Boolean;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
-      Flags                  : Processing_Flags;
+      Env                    : in out Prj.Tree.Environment;
       Reset_Tree             : Boolean       := True)
    is
    begin
@@ -1397,7 +1393,7 @@ package body Prj.Proc is
          Success                => Success,
          From_Project_Node      => From_Project_Node,
          From_Project_Node_Tree => From_Project_Node_Tree,
-         Flags                  => Flags,
+         Env                    => Env,
          Reset_Tree             => Reset_Tree);
 
       if Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree) /=
@@ -1409,7 +1405,7 @@ package body Prj.Proc is
             Success                => Success,
             From_Project_Node      => From_Project_Node,
             From_Project_Node_Tree => From_Project_Node_Tree,
-            Flags                  => Flags);
+            Env                    => Env);
       end if;
    end Process;
 
@@ -1420,9 +1416,9 @@ package body Prj.Proc is
    procedure Process_Declarative_Items
      (Project                : Project_Id;
       In_Tree                : Project_Tree_Ref;
-      Flags                  : Processing_Flags;
       From_Project_Node      : Project_Node_Id;
-      Node_Tree : Project_Node_Tree_Ref;
+      Node_Tree              : Project_Node_Tree_Ref;
+      Env                    : Prj.Tree.Environment;
       Pkg                    : Package_Id;
       Item                   : Project_Node_Id)
    is
@@ -1470,12 +1466,14 @@ package body Prj.Proc is
          if Value.Value = Empty_String then
             Error_Msg_Name_1 := Name_Of (Declaration, Node_Tree);
 
-            case Flags.Allow_Invalid_External is
+            case Env.Flags.Allow_Invalid_External is
                when Error =>
-                  Error_Msg (Flags, "no value defined for %%", Loc, Project);
+                  Error_Msg
+                    (Env.Flags, "no value defined for %%", Loc, Project);
                when Warning =>
                   Reset_Value := True;
-                  Error_Msg (Flags, "?no value defined for %%", Loc, Project);
+                  Error_Msg
+                    (Env.Flags, "?no value defined for %%", Loc, Project);
                when Silent =>
                   Reset_Value := True;
             end case;
@@ -1501,14 +1499,14 @@ package body Prj.Proc is
                Error_Msg_Name_1 := Value.Value;
                Error_Msg_Name_2 := Name_Of (Declaration, Node_Tree);
 
-               case Flags.Allow_Invalid_External is
+               case Env.Flags.Allow_Invalid_External is
                   when Error =>
                      Error_Msg
-                       (Flags, "value %% is illegal for typed string %%",
+                       (Env.Flags, "value %% is illegal for typed string %%",
                         Loc, Project);
                   when Warning =>
                      Error_Msg
-                       (Flags, "?value %% is illegal for typed string %%",
+                       (Env.Flags, "?value %% is illegal for typed string %%",
                         Loc, Project);
                      Reset_Value := True;
                   when Silent =>
@@ -1618,9 +1616,9 @@ package body Prj.Proc is
                Process_Declarative_Items
                  (Project                => Project,
                   In_Tree                => In_Tree,
-                  Flags                  => Flags,
                   From_Project_Node      => From_Project_Node,
-                  Node_Tree => Node_Tree,
+                  Node_Tree              => Node_Tree,
+                  Env                    => Env,
                   Pkg                    => New_Pkg,
                   Item                   =>
                     First_Declarative_Item_Of (Current_Item, Node_Tree));
@@ -1778,7 +1776,7 @@ package body Prj.Proc is
 
          if Orig_Array = No_Array then
             Error_Msg
-              (Flags,
+              (Env.Flags,
                "associative array value not found",
                Location_Of (Current_Item, Node_Tree),
                Project);
@@ -2085,9 +2083,9 @@ package body Prj.Proc is
            Expression
              (Project                => Project,
               In_Tree                => In_Tree,
-              Flags                  => Flags,
               From_Project_Node      => From_Project_Node,
               From_Project_Node_Tree => Node_Tree,
+              Env                    => Env,
               Pkg                    => Pkg,
               First_Term             =>
                 Tree.First_Term
@@ -2275,9 +2273,9 @@ package body Prj.Proc is
             Process_Declarative_Items
               (Project                => Project,
                In_Tree                => In_Tree,
-               Flags                  => Flags,
                From_Project_Node      => From_Project_Node,
                Node_Tree              => Node_Tree,
+               Env                    => Env,
                Pkg                    => Pkg,
                Item                   => Decl_Item);
          end if;
@@ -2330,7 +2328,7 @@ package body Prj.Proc is
       Success                : out Boolean;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
-      Flags                  : Processing_Flags;
+      Env                    : in out Prj.Tree.Environment;
       Reset_Tree             : Boolean := True)
    is
    begin
@@ -2351,9 +2349,9 @@ package body Prj.Proc is
       Recursive_Process
         (Project                => Project,
          In_Tree                => In_Tree,
-         Flags                  => Flags,
          From_Project_Node      => From_Project_Node,
          From_Project_Node_Tree => From_Project_Node_Tree,
+         Env                    => Env,
          Extended_By            => No_Project);
 
       Success :=
@@ -2377,7 +2375,7 @@ package body Prj.Proc is
       Success                : out Boolean;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
-      Flags                  : Processing_Flags)
+      Env                    : Environment)
    is
       Obj_Dir    : Path_Name_Type;
       Extending  : Project_Id;
@@ -2392,7 +2390,7 @@ package body Prj.Proc is
       Debug_Increase_Indent ("Process tree, phase 2");
 
       if Project /= No_Project then
-         Check (In_Tree, Project, From_Project_Node_Tree, Flags);
+         Check (In_Tree, Project, From_Project_Node_Tree, Env.Flags);
       end if;
 
       --  If main project is an extending all project, set object directory of
@@ -2441,7 +2439,7 @@ package body Prj.Proc is
                      if Extending2.Virtual then
                         Error_Msg_Name_1 := Prj.Project.Display_Name;
                         Error_Msg
-                          (Flags,
+                          (Env.Flags,
                            "project %% cannot be extended by a virtual" &
                            " project with the same object directory",
                            Prj.Project.Location, Project);
@@ -2450,11 +2448,11 @@ package body Prj.Proc is
                         Error_Msg_Name_1 := Extending2.Display_Name;
                         Error_Msg_Name_2 := Prj.Project.Display_Name;
                         Error_Msg
-                          (Flags,
+                          (Env.Flags,
                            "project %% cannot extend project %%",
                            Extending2.Location, Project);
                         Error_Msg
-                          (Flags,
+                          (Env.Flags,
                            "\they share the same object directory",
                            Extending2.Location, Project);
                      end if;
@@ -2485,9 +2483,9 @@ package body Prj.Proc is
    procedure Recursive_Process
      (In_Tree                : Project_Tree_Ref;
       Project                : out Project_Id;
-      Flags                  : Processing_Flags;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
+      Env                    : in out Prj.Tree.Environment;
       Extended_By            : Project_Id)
    is
       procedure Process_Imported_Projects
@@ -2537,11 +2535,11 @@ package body Prj.Proc is
                Recursive_Process
                  (In_Tree                => In_Tree,
                   Project                => New_Project,
-                  Flags                  => Flags,
                   From_Project_Node      =>
                     Project_Node_Of
                       (With_Clause, From_Project_Node_Tree),
                   From_Project_Node_Tree => From_Project_Node_Tree,
+                  Env                    => Env,
                   Extended_By            => No_Project);
 
                --  Imported is the id of the last imported project. If
@@ -2585,7 +2583,7 @@ package body Prj.Proc is
            (Tree         => In_Tree,
             Project      => Project,
             Node_Tree    => From_Project_Node_Tree,
-            Flags        => Flags);
+            Flags        => Env.Flags);
 
          List := Project.Aggregated_Projects;
          while Success and then List /= null loop
@@ -2596,7 +2594,7 @@ package body Prj.Proc is
                Errout_Handling   => Prj.Part.Never_Finalize,
                Current_Directory => Get_Name_String (Project.Directory.Name),
                Is_Config_File    => False,
-               Flags             => Flags);
+               Env               => Env);
 
             Success := not Prj.Tree.No (Loaded_Tree);
 
@@ -2604,9 +2602,9 @@ package body Prj.Proc is
                Recursive_Process
                  (In_Tree                => In_Tree,
                   Project                => List.Project,
-                  Flags                  => Flags,
                   From_Project_Node      => Loaded_Tree,
                   From_Project_Node_Tree => From_Project_Node_Tree,
+                  Env                    => Env,
                   Extended_By            => No_Project);
             else
                Debug_Output ("Failed to parse", Name_Id (List.Path));
@@ -2812,18 +2810,18 @@ package body Prj.Proc is
             Recursive_Process
               (In_Tree                => In_Tree,
                Project                => Project.Extends,
-               Flags                  => Flags,
                From_Project_Node      => Extended_Project_Of
                  (Declaration_Node, From_Project_Node_Tree),
                From_Project_Node_Tree => From_Project_Node_Tree,
+               Env                    => Env,
                Extended_By            => Project);
 
             Process_Declarative_Items
               (Project                => Project,
                In_Tree                => In_Tree,
-               Flags                  => Flags,
                From_Project_Node      => From_Project_Node,
                Node_Tree              => From_Project_Node_Tree,
+               Env                    => Env,
                Pkg                    => No_Package,
                Item                   => First_Declarative_Item_Of
                  (Declaration_Node, From_Project_Node_Tree));
index 4257c9004f82ef91f0bb3e767eb10a3aef391907..4610fdfc99b10c159d97c291fb87cb71fab27047 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2001-2009, Free Software Foundation, Inc.         --
+--          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- --
@@ -37,7 +37,7 @@ package Prj.Proc is
       Success                : out Boolean;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
-      Flags                  : Prj.Processing_Flags;
+      Env                    : in out Prj.Tree.Environment;
       Reset_Tree             : Boolean := True);
    --  Process a project tree (ie the direct resulting of parsing a .gpr file)
    --  based on the current external references.
@@ -57,7 +57,7 @@ package Prj.Proc is
       Success                : out Boolean;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
-      Flags                  : Processing_Flags);
+      Env                    : Prj.Tree.Environment);
    --  Perform the second phase of the processing, filling the rest of the
    --  project with the information extracted from the project tree. This phase
    --  requires that the configuration file has already been parsed (in fact
@@ -71,7 +71,7 @@ package Prj.Proc is
       Success                : out Boolean;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
-      Flags                  : Processing_Flags;
+      Env                    : in out Prj.Tree.Environment;
       Reset_Tree             : Boolean       := True);
    --  Performs the two phases of the processing
 
index 6fa56ce975df4147fced9e105e664126c045b866..2d1b55633b323cc3a38973fff945ad0e4c2336ae 100644 (file)
@@ -982,19 +982,28 @@ package body Prj.Tree is
    -- Initialize --
    ----------------
 
-   procedure Initialize
-     (Tree : Project_Node_Tree_Ref; Env : in out Environment) is
+   procedure Initialize (Tree : Project_Node_Tree_Ref) is
    begin
       Project_Node_Table.Init (Tree.Project_Nodes);
       Projects_Htable.Reset (Tree.Projects_HT);
-      Initialize (Env);
    end Initialize;
 
+   --------------------
+   -- Override_Flags --
+   --------------------
+
+   procedure Override_Flags
+     (Self : in out Environment; Flags : Prj.Processing_Flags) is
+   begin
+      Self.Flags := Flags;
+   end Override_Flags;
+
    ----------------
    -- Initialize --
    ----------------
 
-   procedure Initialize (Self : in out Environment) is
+   procedure Initialize
+     (Self : in out Environment; Flags : Processing_Flags) is
    begin
       --  Do not reset the external references, in case we are reloading a
       --  project, since we want to preserve the current environment.
@@ -1003,6 +1012,8 @@ package body Prj.Tree is
 
       Prj.Ext.Initialize (Self.External);
       --  Prj.Ext.Reset (Tree.External);
+
+      Self.Flags := Flags;
    end Initialize;
 
    ----------
@@ -1019,10 +1030,7 @@ package body Prj.Tree is
    -- Free --
    ----------
 
-   procedure Free
-     (Proj : in out Project_Node_Tree_Ref;
-      Env  : in out Environment)
-   is
+   procedure Free (Proj : in out Project_Node_Tree_Ref) is
       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
         (Project_Node_Tree_Data, Project_Node_Tree_Ref);
    begin
@@ -1031,7 +1039,6 @@ package body Prj.Tree is
          Projects_Htable.Reset (Proj.Projects_HT);
          Unchecked_Free (Proj);
       end if;
-      Free (Env);
    end Free;
 
    -------------------------------
index ae0d046366f029fb5d7b01b1cdca061c369ae679..f391e9d64fe3358fdc051c574ccf8a1c57f86025 100644 (file)
@@ -41,7 +41,7 @@ package Prj.Tree is
    -----------------
 
    type Environment is record
-      External : Prj.Ext.External_References;
+      External     : Prj.Ext.External_References;
       --  External references are stored in this hash table (and manipulated
       --  through subprograms in prj-ext.ads). External references are
       --  project-tree specific so that one can load the same tree twice but
@@ -52,16 +52,26 @@ package Prj.Tree is
       --  simultaneously multiple projects, each with its own search path, in
       --  particular when using different compilers with different default
       --  search directories.
+
+      Flags        : Prj.Processing_Flags;
+      --  Configure errors and warnings
    end record;
    --  This record contains the context in which projects are parsed and
    --  processed (finding importing project, resolving external values,...)
 
-   procedure Initialize (Self : in out Environment);
+   procedure Initialize (Self : in out Environment; Flags : Processing_Flags);
    --  Initialize a new environment
 
    procedure Free (Self : in out Environment);
    --  Free the memory used by Self
 
+   procedure Override_Flags
+     (Self : in out Environment; Flags : Prj.Processing_Flags);
+   --  Override the subprogram called in case there are parsing errors. This
+   --  is needed in applications that do their own error handling, since the
+   --  error handler is likely to be a local subprogram in this case (which
+   --  can't be stored when the flags are created).
+
    -------------------
    -- Project nodes --
    -------------------
@@ -130,8 +140,7 @@ package Prj.Tree is
    pragma Inline (No);
    --  Return True if Node = Empty_Node
 
-   procedure Initialize (Tree : Project_Node_Tree_Ref;
-                         Env : in out Environment);
+   procedure Initialize (Tree : Project_Node_Tree_Ref);
    --  Initialize the Project File tree: empty the Project_Nodes table
    --  and reset the Projects_Htable.
 
@@ -1490,8 +1499,7 @@ package Prj.Tree is
       Projects_HT   : Tree_Private_Part.Projects_Htable.Instance;
    end record;
 
-   procedure Free (Proj : in out Project_Node_Tree_Ref;
-                   Env : in out Environment);
+   procedure Free (Proj : in out Project_Node_Tree_Ref);
    --  Free memory used by Prj
 
 private
index ab775b53f33b83a4b6118089dfd4ca69016cad3a..4d2751c53d6f2365169bd2a459c03239b0e812ae 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2010, Free Software Foundation, Inc.         --
+--          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- --
@@ -602,7 +602,7 @@ package body Switch.M is
    ------------------------
 
    procedure Scan_Make_Switches
-     (Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
+     (Env               : in out Prj.Tree.Environment;
       Switch_Chars      : String;
       Success           : out Boolean)
    is
@@ -667,7 +667,7 @@ package body Switch.M is
            and then Switch_Chars (Ptr .. Ptr + 1) = "aP"
          then
             Add_Directories
-              (Project_Node_Tree.Project_Path,
+              (Env.Project_Path,
                Switch_Chars (Ptr + 2 .. Switch_Chars'Last));
 
          elsif C = 'v' and then Switch_Chars'Length = 3 then
index de7ccaf5d5dd8a8d4532acafe4af612f3a68d441..b1daf1491c0b913a7d942d367711de375caeeaa1 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2001-2010, Free Software Foundation, Inc.         --
+--          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- --
@@ -39,7 +39,7 @@ with Prj.Tree;
 package Switch.M is
 
    procedure Scan_Make_Switches
-     (Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
+     (Env               : in out Prj.Tree.Environment;
       Switch_Chars      : String;
       Success           : out Boolean);
    --  Scan a gnatmake switch and act accordingly. For switches that are