From: Emmanuel Briot Date: Wed, 3 Aug 2011 09:36:24 +0000 (+0000) Subject: gnatcmd.adb, [...] (Prj.Tree.Environment): new type. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=4437a53072c556b2a81eb96c842c5448ffafa838;p=gcc.git gnatcmd.adb, [...] (Prj.Tree.Environment): new type. 2011-08-03 Emmanuel Briot * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f415e5973ff..4287e95e1e8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2011-08-03 Emmanuel Briot + + * 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 * prj-proc.adb, prj.ads, makeutl.adb, makeutl.ads, prj-conf.adb, diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 16897bf3030..49cc5cc24ba 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -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 diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 09b95488a12..2f72c8d584c 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -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 diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 2de96c85b65..4901928ccd6 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -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); diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index de25dce40fb..978d4130ddf 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -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 diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads index 199e3e80947..af331846ce4 100644 --- a/gcc/ada/prj-conf.ads +++ b/gcc/ada/prj-conf.ads @@ -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 diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index 2910a3a3d0d..439ac0598a4 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -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); diff --git a/gcc/ada/prj-pars.adb b/gcc/ada/prj-pars.adb index c638d9e6d9b..f2d289f5c38 100644 --- a/gcc/ada/prj-pars.adb +++ b/gcc/ada/prj-pars.adb @@ -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, diff --git a/gcc/ada/prj-pars.ads b/gcc/ada/prj-pars.ads index 4e7d4808d4a..fcfde916117 100644 --- a/gcc/ada/prj-pars.ads +++ b/gcc/ada/prj-pars.ads @@ -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 diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 3438fdee679..b75716729b7 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -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; diff --git a/gcc/ada/prj-part.ads b/gcc/ada/prj-part.ads index c4468a41531..16b84abb502 100644 --- a/gcc/ada/prj-part.ads +++ b/gcc/ada/prj-part.ads @@ -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 diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 9c9c3b5f32c..6dd3ca7311d 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -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)); diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads index 4257c9004f8..4610fdfc99b 100644 --- a/gcc/ada/prj-proc.ads +++ b/gcc/ada/prj-proc.ads @@ -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 diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index 6fa56ce975d..2d1b55633b3 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -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; ------------------------------- diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index ae0d046366f..f391e9d64fe 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -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 diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb index ab775b53f33..4d2751c53d6 100644 --- a/gcc/ada/switch-m.adb +++ b/gcc/ada/switch-m.adb @@ -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 diff --git a/gcc/ada/switch-m.ads b/gcc/ada/switch-m.ads index de7ccaf5d5d..b1daf1491c0 100644 --- a/gcc/ada/switch-m.ads +++ b/gcc/ada/switch-m.ads @@ -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