From: Emmanuel Briot Date: Wed, 3 Aug 2011 10:19:32 +0000 (+0000) Subject: gnatcmd.adb, [...] (Shared_Project_Tree_Data): new type An aggregate project and... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=40ecf2f5d19ba2b046c65168aa8acc80ad399a08;p=gcc.git gnatcmd.adb, [...] (Shared_Project_Tree_Data): new type An aggregate project and its aggregated trees need to share the common... 2011-08-03 Emmanuel Briot * gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, mlib-prj.adb, prj.adb, prj.ads, makeutl.adb, makeutl.ads, clean.adb, prj-nmsc.adb, prj-util.adb, prj-util.ads, prj-conf.adb, prj-conf.ads, prj-env.adb, prj-env.ads (Shared_Project_Tree_Data): new type An aggregate project and its aggregated trees need to share the common data structures used for lists of strings, packages,... This makes the code simpler since otherwise we have to pass the root tree (also used for the configuration file data) in addition to the current project tree. This also avoids ambiguities as to which tree should be used. And finally this saves a bit of memory. (For_Every_Project_Imported): new parameter Tree. Since aggregated projects are using a different tree, we need to let the caller know which tree to use to manipulate the returned project. From-SVN: r177261 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7cb3c194feb..5fa9661a903 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2011-08-03 Emmanuel Briot + + * gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, mlib-prj.adb, + prj.adb, prj.ads, makeutl.adb, makeutl.ads, clean.adb, prj-nmsc.adb, + prj-util.adb, prj-util.ads, prj-conf.adb, prj-conf.ads, prj-env.adb, + prj-env.ads (Shared_Project_Tree_Data): new type + An aggregate project and its aggregated trees need to share the common + data structures used for lists of strings, packages,... This makes the + code simpler since otherwise we have to pass the root tree (also used + for the configuration file data) in addition to the current project + tree. This also avoids ambiguities as to which tree should be used. + And finally this saves a bit of memory. + (For_Every_Project_Imported): new parameter Tree. + Since aggregated projects are using a different tree, we need to let + the caller know which tree to use to manipulate the returned project. + 2011-08-03 Robert Dewar * prj-proc.adb, exp_util.ads, exp_ch9.adb, make.adb, prj-ext.adb, diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 9bbf1159051..82f70816c9e 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -1170,7 +1170,7 @@ package body Clean is Executable := Executable_Of (Main_Project, - Project_Tree, + Project_Tree.Shared, Main_Source_File, Current_File_Index); @@ -1425,7 +1425,7 @@ package body Clean is -- Add source directories and object directories to the search paths Add_Source_Directories (Main_Project, Project_Tree); - Add_Object_Directories (Main_Project); + Add_Object_Directories (Main_Project, Project_Tree); end if; Osint.Add_Default_Search_Dirs; @@ -1440,7 +1440,7 @@ package body Clean is Value : String_List_Id := Main_Project.Mains; begin while Value /= Prj.Nil_String loop - Main := Project_Tree.String_Elements.Table (Value); + Main := Project_Tree.Shared.String_Elements.Table (Value); Osint.Add_File (File_Name => Get_Name_String (Main.Value), Index => Main.Index); diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 99d6953c423..623b188ed81 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -255,6 +255,7 @@ procedure GNATCmd is procedure Set_Library_For (Project : Project_Id; + Tree : Project_Tree_Ref; Libraries_Present : in out Boolean); -- If Project is a library project, add the correct -L and -l switches to -- the linker invocation. @@ -445,7 +446,7 @@ procedure GNATCmd is B_Start.all & MLib.Fil.Ext_To (Get_Name_String - (Project_Tree.String_Elements.Table + (Project_Tree.Shared.String_Elements.Table (Main).Value), "ci")); @@ -463,13 +464,13 @@ procedure GNATCmd is "b__" & MLib.Fil.Ext_To (Get_Name_String - (Project_Tree.String_Elements.Table - (Main).Value), + (Project_Tree.Shared + .String_Elements.Table (Main).Value), "ci")); end if; - Main := - Project_Tree.String_Elements.Table (Main).Next; + Main := Project_Tree.Shared.String_Elements.Table + (Main).Next; end loop; if Proj.Project.Library then @@ -960,7 +961,7 @@ procedure GNATCmd is -- Check if there are library project files if MLib.Tgt.Support_For_Libraries /= None then - Set_Libraries (Project, Libraries_Present); + Set_Libraries (Project, Project_Tree, Libraries_Present); end if; -- If there are, add the necessary additional switches @@ -1236,8 +1237,10 @@ procedure GNATCmd is procedure Set_Library_For (Project : Project_Id; + Tree : Project_Tree_Ref; Libraries_Present : in out Boolean) is + pragma Unreferenced (Tree); Path_Option : constant String_Access := MLib.Linker_Library_Path_Option; @@ -1870,7 +1873,7 @@ begin Prj.Util.Value_Of (Name => Tool_Package_Name, In_Packages => Project.Decl.Packages, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Element : Package_Element; @@ -1884,7 +1887,7 @@ begin begin if Pkg /= No_Package then - Element := Project_Tree.Packages.Table (Pkg); + Element := Project_Tree.Shared.Packages.Table (Pkg); -- Packages Gnatls and Gnatstack have a single attribute -- Switches, that is not an associative array. @@ -1894,7 +1897,7 @@ begin Prj.Util.Value_Of (Variable_Name => Snames.Name_Switches, In_Variables => Element.Decl.Attributes, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); -- Packages Binder (for gnatbind), Cross_Reference (for -- gnatxref), Linker (for gnatlink), Finder (for gnatfind), @@ -1926,14 +1929,14 @@ begin Prj.Util.Value_Of (Name => Name_Switches, In_Arrays => Element.Decl.Arrays, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Name_Len := 0; Add_Str_To_Name_Buffer (Main.all); The_Switches := Prj.Util.Value_Of (Index => Name_Find, Src_Index => 0, In_Array => Switches_Array, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); end if; if The_Switches.Kind = Prj.Undefined then @@ -1941,12 +1944,12 @@ begin Prj.Util.Value_Of (Name => Name_Default_Switches, In_Arrays => Element.Decl.Arrays, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); The_Switches := Prj.Util.Value_Of (Index => Name_Ada, Src_Index => 0, In_Array => Switches_Array, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); end if; end if; @@ -1973,7 +1976,7 @@ begin when Prj.List => Current := The_Switches.Values; while Current /= Prj.Nil_String loop - The_String := Project_Tree.String_Elements. + The_String := Project_Tree.Shared.String_Elements. Table (Current); declare @@ -2024,7 +2027,7 @@ begin Prj.Util.Value_Of (Name => Name_Compiler, In_Packages => Project.Decl.Packages, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Element : Package_Element; @@ -2054,7 +2057,7 @@ begin end if; end loop; - Element := Project_Tree.Packages.Table (Pkg); + Element := Project_Tree.Shared.Packages.Table (Pkg); -- If there is a single main and there is compilation -- switches specified in the project file, use them. @@ -2069,12 +2072,12 @@ begin Prj.Util.Value_Of (Name => Name_Switches, In_Arrays => Element.Decl.Arrays, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); The_Switches := Prj.Util.Value_Of (Index => Main_Id, Src_Index => 0, In_Array => Switches_Array, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); end if; -- Otherwise, get the Default_Switches ("Ada") @@ -2084,12 +2087,12 @@ begin Prj.Util.Value_Of (Name => Name_Default_Switches, In_Arrays => Element.Decl.Arrays, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); The_Switches := Prj.Util.Value_Of (Index => Name_Ada, Src_Index => 0, In_Array => Switches_Array, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); end if; -- If there are switches specified, put them in the @@ -2112,8 +2115,8 @@ begin when Prj.List => Current := The_Switches.Values; while Current /= Prj.Nil_String loop - The_String := - Project_Tree.String_Elements.Table (Current); + The_String := Project_Tree.Shared.String_Elements + .Table (Current); declare Switch : constant String := @@ -2244,7 +2247,7 @@ begin Prj.Util.Value_Of (Name => Name_Builder, In_Packages => Project.Decl.Packages, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Variable : Variable_Value := Prj.Util.Value_Of @@ -2252,7 +2255,7 @@ begin Attribute_Or_Array_Name => Name_Global_Configuration_Pragmas, In_Package => Pkg, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); begin if (Variable = Nil_Variable_Value @@ -2265,7 +2268,7 @@ begin Attribute_Or_Array_Name => Name_Global_Config_File, In_Package => Pkg, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); end if; if Variable /= Nil_Variable_Value @@ -2283,7 +2286,7 @@ begin Prj.Util.Value_Of (Name => Name_Compiler, In_Packages => Project.Decl.Packages, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Variable : Variable_Value := Prj.Util.Value_Of @@ -2291,7 +2294,7 @@ begin Attribute_Or_Array_Name => Name_Local_Configuration_Pragmas, In_Package => Pkg, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); begin if (Variable = Nil_Variable_Value @@ -2304,7 +2307,7 @@ begin Attribute_Or_Array_Name => Name_Local_Config_File, In_Package => Pkg, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); end if; if Variable /= Nil_Variable_Value diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index d62ec018ac3..9d52a28d626 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -1288,7 +1288,8 @@ package body Make is Switch_List := Switches.Values; while Switch_List /= Nil_String loop - Element := Project_Tree.String_Elements.Table (Switch_List); + Element := + Project_Tree.Shared.String_Elements.Table (Switch_List); Get_Name_String (Element.Value); if Name_Len > 0 then @@ -2301,7 +2302,7 @@ package body Make is Prj.Util.Value_Of (Name => Name_Compiler, In_Packages => Arguments_Project.Decl.Packages, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); if Compiler_Package /= No_Package then @@ -2332,7 +2333,7 @@ package body Make is begin while Current /= Nil_String loop - Element := Project_Tree.String_Elements. + Element := Project_Tree.Shared.String_Elements. Table (Current); Number := Number + 1; Current := Element.Next; @@ -2348,7 +2349,7 @@ package body Make is Current := Switches.Values; for Index in New_Args'Range loop - Element := Project_Tree.String_Elements. + Element := Project_Tree.Shared.String_Elements. Table (Current); Get_Name_String (Element.Value); @@ -3851,14 +3852,14 @@ package body Make is Prj.Util.Value_Of (Name => Name_Builder, In_Packages => The_Packages, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); if Gnatmake /= No_Package then Global_Attribute := Prj.Util.Value_Of (Variable_Name => Name_Global_Configuration_Pragmas, - In_Variables => Project_Tree.Packages.Table + In_Variables => Project_Tree.Shared.Packages.Table (Gnatmake).Decl.Attributes, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Global_Attribute_Present := Global_Attribute /= Nil_Variable_Value and then Get_Name_String (Global_Attribute.Value) /= ""; @@ -3894,14 +3895,14 @@ package body Make is Prj.Util.Value_Of (Name => Name_Compiler, In_Packages => The_Packages, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); if Compiler /= No_Package then Local_Attribute := Prj.Util.Value_Of (Variable_Name => Name_Local_Configuration_Pragmas, - In_Variables => Project_Tree.Packages.Table + In_Variables => Project_Tree.Shared.Packages.Table (Compiler).Decl.Attributes, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Local_Attribute_Present := Local_Attribute /= Nil_Variable_Value and then Get_Name_String (Local_Attribute.Value) /= ""; @@ -4183,7 +4184,7 @@ package body Make is if Main_Project = No_Project then GNAT.OS_Lib.Spawn (Globalizer_Path.all, Globalizer_Args, Success); else - Globalize_Dirs (Main_Project); + Globalize_Dirs (Main_Project, Project_Tree); end if; end Globalize; @@ -4535,7 +4536,7 @@ package body Make is Prj.Util.Value_Of (Name_Languages, Main_Project.Decl.Attributes, - Project_Tree); + Project_Tree.Shared); Current : String_List_Id; Element : String_Element; @@ -4551,7 +4552,7 @@ package body Make is Current := Languages.Values; Look_For_Foreign : while Current /= Nil_String loop - Element := Project_Tree.String_Elements. + Element := Project_Tree.Shared.String_Elements. Table (Current); Get_Name_String (Element.Value); To_Lower (Name_Buffer (1 .. Name_Len)); @@ -4574,12 +4575,13 @@ package body Make is -- line. Get_Name_String - (Project_Tree.String_Elements.Table (Value).Value); + (Project_Tree.Shared.String_Elements.Table + (Value).Value); declare Main_Name : constant String := Get_Name_String - (Project_Tree.String_Elements.Table + (Project_Tree.Shared.String_Elements.Table (Value).Value); Proj : constant Project_Id := Prj.Env.Project_Of @@ -4591,10 +4593,10 @@ package body Make is At_Least_One_Main := True; Osint.Add_File (Get_Name_String - (Project_Tree.String_Elements.Table + (Project_Tree.Shared.String_Elements.Table (Value).Value), Index => - Project_Tree.String_Elements.Table + Project_Tree.Shared.String_Elements.Table (Value).Index); elsif not Foreign_Language then @@ -4605,7 +4607,7 @@ package body Make is end if; end; - Value := Project_Tree.String_Elements.Table + Value := Project_Tree.Shared.String_Elements.Table (Value).Next; end loop; @@ -4765,19 +4767,19 @@ package body Make is Prj.Util.Value_Of (Name => Name_Builder, In_Packages => The_Packages, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Binder_Package : constant Prj.Package_Id := Prj.Util.Value_Of (Name => Name_Binder, In_Packages => The_Packages, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Linker_Package : constant Prj.Package_Id := Prj.Util.Value_Of (Name => Name_Linker, In_Packages => The_Packages, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Default_Switches_Array : Array_Id; @@ -4832,20 +4834,20 @@ package body Make is Global_Compilation_Array := Prj.Util.Value_Of (Name => Name_Global_Compilation_Switches, - In_Arrays => Project_Tree.Packages.Table + In_Arrays => Project_Tree.Shared.Packages.Table (Builder_Package).Decl.Arrays, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Default_Switches_Array := - Project_Tree.Packages.Table + Project_Tree.Shared.Packages.Table (Builder_Package).Decl.Arrays; while Default_Switches_Array /= No_Array and then - Project_Tree.Arrays.Table (Default_Switches_Array).Name /= - Name_Default_Switches + Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Name + /= Name_Default_Switches loop - Default_Switches_Array := - Project_Tree.Arrays.Table (Default_Switches_Array).Next; + Default_Switches_Array := Project_Tree.Shared.Arrays.Table + (Default_Switches_Array).Next; end loop; if Global_Compilation_Array /= No_Array_Element and then @@ -4854,7 +4856,7 @@ package body Make is Errutil.Error_Msg ("Default_Switches forbidden in presence of " & "Global_Compilation_Switches. Use Switches instead.", - Project_Tree.Arrays.Table + Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Location); Errutil.Finalize; Make_Failed @@ -4899,15 +4901,15 @@ package body Make is Name_Default_Switches, In_Package => Builder_Package, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Switches : constant Array_Element_Id := Prj.Util.Value_Of (Name => Name_Switches, In_Arrays => - Project_Tree.Packages.Table + Project_Tree.Shared.Packages.Table (Builder_Package).Decl.Arrays, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Other_Switches : constant Variable_Value := Prj.Util.Value_Of @@ -4916,13 +4918,13 @@ package body Make is Attribute_Or_Array_Name => Name_Switches, In_Package => Builder_Package, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); begin if Other_Switches /= Nil_Variable_Value then if not Quiet_Output and then Switches /= No_Array_Element - and then Project_Tree.Array_Elements.Table + and then Project_Tree.Shared.Array_Elements.Table (Switches).Next /= No_Array_Element then Write_Line @@ -4977,7 +4979,7 @@ package body Make is begin while Global_Compilation_Array /= No_Array_Element loop Global_Compilation_Elem := - Project_Tree.Array_Elements.Table + Project_Tree.Shared.Array_Elements.Table (Global_Compilation_Array); Get_Name_String (Global_Compilation_Elem.Index); @@ -4999,7 +5001,8 @@ package body Make is while List /= Nil_String loop Elem := - Project_Tree.String_Elements.Table (List); + Project_Tree.Shared.String_Elements.Table + (List); if Elem.Value /= No_Name then Add_Switch @@ -5431,7 +5434,8 @@ package body Make is Executable := Prj.Util.Executable_Of - (Main_Project, Project_Tree, Main_Source_File, Main_Index); + (Main_Project, Project_Tree.Shared, + Main_Source_File, Main_Index); end if; end if; @@ -6337,13 +6341,13 @@ package body Make is Prj.Util.Value_Of (Name => Name_Binder, In_Packages => The_Packages, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Linker_Package : constant Prj.Package_Id := Prj.Util.Value_Of (Name => Name_Linker, In_Packages => The_Packages, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); begin -- We fail if we cannot find the main source file @@ -6848,7 +6852,7 @@ package body Make is -- has its own directories anyway Add_Source_Directories (Main_Project, Project_Tree); - Add_Object_Directories (Main_Project); + Add_Object_Directories (Main_Project, Project_Tree); Recursive_Compute_Depth (Main_Project); Compute_All_Imported_Projects (Project_Tree); @@ -8457,7 +8461,7 @@ package body Make is (Source_File => Source_File, Source_Lang => Name_Ada, Source_Prj => Project, - Pkg_Name => Project_Tree.Packages.Table (In_Package).Name, + Pkg_Name => Project_Tree.Shared.Packages.Table (In_Package).Name, Project_Tree => Project_Tree, Value => Switches, Is_Default => Is_Default, diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 63731dd480b..6d82e4ba698 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -695,7 +695,7 @@ package body Makeutl is Prj.Util.Value_Of (Name => Pkg_Name, In_Packages => Project.Decl.Packages, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); Lang : Language_Ptr; begin @@ -706,7 +706,7 @@ package body Makeutl is (Name => Name_Id (Source_File), Attribute_Or_Array_Name => Name_Switches, In_Package => Pkg, - In_Tree => Project_Tree, + Shared => Project_Tree.Shared, Allow_Wildcards => True); end if; @@ -756,7 +756,7 @@ package body Makeutl is (Name => Name_Find, Attribute_Or_Array_Name => Name_Switches, In_Package => Pkg, - In_Tree => Project_Tree, + Shared => Project_Tree.Shared, Allow_Wildcards => True); end if; @@ -776,7 +776,7 @@ package body Makeutl is (Name => Name_Find, Attribute_Or_Array_Name => Name_Switches, In_Package => Pkg, - In_Tree => Project_Tree, + Shared => Project_Tree.Shared, Allow_Wildcards => True); end if; end; @@ -790,7 +790,7 @@ package body Makeutl is (Name => Source_Lang, Attribute_Or_Array_Name => Name_Switches, In_Package => Pkg, - In_Tree => Project_Tree, + Shared => Project_Tree.Shared, Force_Lower_Case_Index => True); end if; @@ -800,7 +800,7 @@ package body Makeutl is (Name => All_Other_Names, Attribute_Or_Array_Name => Name_Switches, In_Package => Pkg, - In_Tree => Project_Tree, + Shared => Project_Tree.Shared, Force_Lower_Case_Index => True); end if; @@ -810,7 +810,7 @@ package body Makeutl is (Name => Source_Lang, Attribute_Or_Array_Name => Name_Default_Switches, In_Package => Pkg, - In_Tree => Project_Tree); + Shared => Project_Tree.Shared); end if; end Get_Switches; @@ -910,14 +910,21 @@ package body Makeutl is (Project : Project_Id; In_Tree : Project_Tree_Ref) return String_List is - procedure Recursive_Add (Proj : Project_Id; Dummy : in out Boolean); + procedure Recursive_Add + (Proj : Project_Id; + In_Tree : Project_Tree_Ref; + Dummy : in out Boolean); -- The recursive routine used to add linker options ------------------- -- Recursive_Add -- ------------------- - procedure Recursive_Add (Proj : Project_Id; Dummy : in out Boolean) is + procedure Recursive_Add + (Proj : Project_Id; + In_Tree : Project_Tree_Ref; + Dummy : in out Boolean) + is pragma Unreferenced (Dummy); Linker_Package : Package_Id; @@ -928,7 +935,7 @@ package body Makeutl is Prj.Util.Value_Of (Name => Name_Linker, In_Packages => Proj.Decl.Packages, - In_Tree => In_Tree); + Shared => In_Tree.Shared); Options := Prj.Util.Value_Of @@ -936,7 +943,7 @@ package body Makeutl is Index => 0, Attribute_Or_Array_Name => Name_Linker_Options, In_Package => Linker_Package, - In_Tree => In_Tree); + Shared => In_Tree.Shared); -- If attribute is present, add the project with -- the attribute to table Linker_Opts. @@ -958,7 +965,7 @@ package body Makeutl is begin Linker_Opts.Init; - For_All_Projects (Project, Dummy, Imported_First => True); + For_All_Projects (Project, In_Tree, Dummy, Imported_First => True); Last_Linker_Option := 0; @@ -974,7 +981,7 @@ package body Makeutl is begin Options := Linker_Opts.Table (Index).Options; while Options /= Nil_String loop - Option := In_Tree.String_Elements.Table (Options).Value; + Option := In_Tree.Shared.String_Elements.Table (Options).Value; Get_Name_String (Option); -- Do not consider empty linker options @@ -991,7 +998,7 @@ package body Makeutl is Including_L_Switch => True); end if; - Options := In_Tree.String_Elements.Table (Options).Next; + Options := In_Tree.Shared.String_Elements.Table (Options).Next; end loop; end; end loop; diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 325dd830d0e..f23291076ec 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -40,7 +40,8 @@ package Makeutl is -- Failing procedure called from procedure Test_If_Relative_Path below. May -- be redirected. - Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data; + Project_Tree : constant Project_Tree_Ref := + new Project_Tree_Data (Is_Root_Tree => True); -- The project tree Source_Info_Option : constant String := "--source-info="; diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 656b9d4e824..af988ba78d3 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2010, AdaCore -- +-- Copyright (C) 2001-2011, AdaCore -- -- -- -- 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- -- @@ -901,7 +901,7 @@ package body MLib.Prj is Value_Of (Name => Name_Binder, In_Packages => For_Project.Decl.Packages, - In_Tree => In_Tree); + Shared => In_Tree.Shared); begin if Binder_Package /= No_Package then @@ -910,9 +910,9 @@ package body MLib.Prj is Value_Of (Name => Name_Default_Switches, In_Arrays => - In_Tree.Packages.Table + In_Tree.Shared.Packages.Table (Binder_Package).Decl.Arrays, - In_Tree => In_Tree); + Shared => In_Tree.Shared); Switches : Variable_Value := Nil_Variable_Value; Switch : String_List_Id := Nil_String; @@ -924,7 +924,7 @@ package body MLib.Prj is (Index => Name_Ada, Src_Index => 0, In_Array => Defaults, - In_Tree => In_Tree); + Shared => In_Tree.Shared); if not Switches.Default then Switch := Switches.Values; @@ -932,9 +932,9 @@ package body MLib.Prj is while Switch /= Nil_String loop Add_Argument (Get_Name_String - (In_Tree.String_Elements.Table + (In_Tree.Shared.String_Elements.Table (Switch).Value)); - Switch := In_Tree.String_Elements. + Switch := In_Tree.Shared.String_Elements. Table (Switch).Next; end loop; end if; @@ -1277,7 +1277,8 @@ package body MLib.Prj is -- If attribute Library_Options was specified, add these options Library_Options := Value_Of - (Name_Library_Options, For_Project.Decl.Attributes, In_Tree); + (Name_Library_Options, For_Project.Decl.Attributes, + In_Tree.Shared); if not Library_Options.Default then declare @@ -1287,7 +1288,7 @@ package body MLib.Prj is begin Current := Library_Options.Values; while Current /= Nil_String loop - Element := In_Tree.String_Elements.Table (Current); + Element := In_Tree.Shared.String_Elements.Table (Current); Get_Name_String (Element.Value); if Name_Len /= 0 then @@ -1756,12 +1757,12 @@ package body MLib.Prj is while Iface /= Nil_String loop ALI := File_Name_Type - (In_Tree.String_Elements.Table (Iface).Value); + (In_Tree.Shared.String_Elements.Table (Iface).Value); Interface_ALIs.Set (ALI, True); Get_Name_String - (In_Tree.String_Elements.Table (Iface).Value); + (In_Tree.Shared.String_Elements.Table (Iface).Value); Add_Argument (Name_Buffer (1 .. Name_Len)); - Iface := In_Tree.String_Elements.Table (Iface).Next; + Iface := In_Tree.Shared.String_Elements.Table (Iface).Next; end loop; Iface := For_Project.Lib_Interface_ALIs; @@ -1775,9 +1776,10 @@ package body MLib.Prj is while Iface /= Nil_String loop ALI := File_Name_Type - (In_Tree.String_Elements.Table (Iface).Value); + (In_Tree.Shared.String_Elements.Table (Iface).Value); Process (ALI); - Iface := In_Tree.String_Elements.Table (Iface).Next; + Iface := + In_Tree.Shared.String_Elements.Table (Iface).Next; end loop; end if; end; diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 978d4130ddf..3c39e6190a4 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -101,6 +101,17 @@ package body Prj.Conf is pragma No_Return (Raise_Invalid_Config); -- Raises exception Invalid_Config with given message + procedure Apply_Config_File + (Config_File : Prj.Project_Id; + Project_Tree : Prj.Project_Tree_Ref); + -- Apply the configuration file settings to all the projects in the + -- project tree. The Project_Tree must have been parsed first, and + -- processed through the first phase so that all its projects are known. + -- + -- Currently, this will add new attributes and packages in the various + -- projects, so that when the second phase of the processing is performed + -- these attributes are automatically taken into account. + -------------------- -- Add_Attributes -- -------------------- @@ -110,6 +121,7 @@ package body Prj.Conf is Conf_Decl : Declarations; User_Decl : in out Declarations) is + Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared; Conf_Attr_Id : Variable_Id; Conf_Attr : Variable; Conf_Array_Id : Array_Id; @@ -130,10 +142,8 @@ package body Prj.Conf is Conf_Attr_Id := Conf_Decl.Attributes; User_Attr_Id := User_Decl.Attributes; while Conf_Attr_Id /= No_Variable loop - Conf_Attr := - Project_Tree.Variable_Elements.Table (Conf_Attr_Id); - User_Attr := - Project_Tree.Variable_Elements.Table (User_Attr_Id); + Conf_Attr := Shared.Variable_Elements.Table (Conf_Attr_Id); + User_Attr := Shared.Variable_Elements.Table (User_Attr_Id); if not Conf_Attr.Value.Default then if User_Attr.Value.Default then @@ -142,8 +152,7 @@ package body Prj.Conf is -- value of the configuration attribute. User_Attr.Value := Conf_Attr.Value; - Project_Tree.Variable_Elements.Table (User_Attr_Id) := - User_Attr; + Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr; elsif User_Attr.Value.Kind = List and then Conf_Attr.Value.Values /= Nil_String @@ -164,22 +173,20 @@ package body Prj.Conf is -- Create new list String_Element_Table.Increment_Last - (Project_Tree.String_Elements); + (Shared.String_Elements); New_List := String_Element_Table.Last - (Project_Tree.String_Elements); + (Shared.String_Elements); -- Value of attribute is new list User_Attr.Value.Values := New_List; - Project_Tree.Variable_Elements.Table (User_Attr_Id) := - User_Attr; + Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr; loop -- Get each element of configuration list - Conf_Elem := - Project_Tree.String_Elements.Table (Conf_List); + Conf_Elem := Shared.String_Elements.Table (Conf_List); New_Elem := Conf_Elem; Conf_List := Conf_Elem.Next; @@ -189,8 +196,7 @@ package body Prj.Conf is -- first element of user list, and we are done. New_Elem.Next := User_List; - Project_Tree.String_Elements.Table - (New_List) := New_Elem; + Shared.String_Elements.Table (New_List) := New_Elem; exit; else @@ -198,12 +204,10 @@ package body Prj.Conf is -- new list. String_Element_Table.Increment_Last - (Project_Tree.String_Elements); + (Shared.String_Elements); New_Elem.Next := - String_Element_Table.Last - (Project_Tree.String_Elements); - Project_Tree.String_Elements.Table - (New_List) := New_Elem; + String_Element_Table.Last (Shared.String_Elements); + Shared.String_Elements.Table (New_List) := New_Elem; New_List := New_Elem.Next; end if; end loop; @@ -217,11 +221,11 @@ package body Prj.Conf is Conf_Array_Id := Conf_Decl.Arrays; while Conf_Array_Id /= No_Array loop - Conf_Array := Project_Tree.Arrays.Table (Conf_Array_Id); + Conf_Array := Shared.Arrays.Table (Conf_Array_Id); User_Array_Id := User_Decl.Arrays; while User_Array_Id /= No_Array loop - User_Array := Project_Tree.Arrays.Table (User_Array_Id); + User_Array := Shared.Arrays.Table (User_Array_Id); exit when User_Array.Name = Conf_Array.Name; User_Array_Id := User_Array.Next; end loop; @@ -230,11 +234,11 @@ package body Prj.Conf is -- do a shallow copy of the full associative array. if User_Array_Id = No_Array then - Array_Table.Increment_Last (Project_Tree.Arrays); + Array_Table.Increment_Last (Shared.Arrays); User_Array := Conf_Array; User_Array.Next := User_Decl.Arrays; - User_Decl.Arrays := Array_Table.Last (Project_Tree.Arrays); - Project_Tree.Arrays.Table (User_Decl.Arrays) := User_Array; + User_Decl.Arrays := Array_Table.Last (Shared.Arrays); + Shared.Arrays.Table (User_Decl.Arrays) := User_Array; else -- Otherwise, check each array element @@ -242,12 +246,12 @@ package body Prj.Conf is Conf_Array_Elem_Id := Conf_Array.Value; while Conf_Array_Elem_Id /= No_Array_Element loop Conf_Array_Elem := - Project_Tree.Array_Elements.Table (Conf_Array_Elem_Id); + Shared.Array_Elements.Table (Conf_Array_Elem_Id); User_Array_Elem_Id := User_Array.Value; while User_Array_Elem_Id /= No_Array_Element loop User_Array_Elem := - Project_Tree.Array_Elements.Table (User_Array_Elem_Id); + Shared.Array_Elements.Table (User_Array_Elem_Id); exit when User_Array_Elem.Index = Conf_Array_Elem.Index; User_Array_Elem_Id := User_Array_Elem.Next; end loop; @@ -257,15 +261,14 @@ package body Prj.Conf is -- user array. if User_Array_Elem_Id = No_Array_Element then - Array_Element_Table.Increment_Last - (Project_Tree.Array_Elements); + Array_Element_Table.Increment_Last (Shared.Array_Elements); User_Array_Elem := Conf_Array_Elem; User_Array_Elem.Next := User_Array.Value; User_Array.Value := - Array_Element_Table.Last (Project_Tree.Array_Elements); - Project_Tree.Array_Elements.Table (User_Array.Value) := + Array_Element_Table.Last (Shared.Array_Elements); + Shared.Array_Elements.Table (User_Array.Value) := User_Array_Elem; - Project_Tree.Arrays.Table (User_Array_Id) := User_Array; + Shared.Arrays.Table (User_Array_Id) := User_Array; -- Otherwise, if the value is a string list, prepend the -- user array element with the conf array element value. @@ -283,23 +286,22 @@ package body Prj.Conf is begin loop Conf_List_Elem := - Project_Tree.String_Elements.Table - (Conf_List); + Shared.String_Elements.Table (Conf_List); String_Element_Table.Increment_Last - (Project_Tree.String_Elements); + (Shared.String_Elements); Next := String_Element_Table.Last - (Project_Tree.String_Elements); - Project_Tree.String_Elements.Table (Next) := + (Shared.String_Elements); + Shared.String_Elements.Table (Next) := Conf_List_Elem; if Previous = Nil_String then User_Array_Elem.Value.Values := Next; - Project_Tree.Array_Elements.Table + Shared.Array_Elements.Table (User_Array_Elem_Id) := User_Array_Elem; else - Project_Tree.String_Elements.Table + Shared.String_Elements.Table (Previous).Next := Next; end if; @@ -308,8 +310,8 @@ package body Prj.Conf is Conf_List := Conf_List_Elem.Next; if Conf_List = Nil_String then - Project_Tree.String_Elements.Table - (Previous).Next := Link; + Shared.String_Elements.Table (Previous).Next := + Link; exit; end if; end loop; @@ -454,9 +456,10 @@ package body Prj.Conf is ----------------------- procedure Apply_Config_File - (Config_File : Prj.Project_Id; - Project_Tree : Prj.Project_Tree_Ref) + (Config_File : Prj.Project_Id; + Project_Tree : Prj.Project_Tree_Ref) is + Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared; Conf_Decl : constant Declarations := Config_File.Decl; Conf_Pack_Id : Package_Id; Conf_Pack : Package_Element; @@ -467,47 +470,67 @@ package body Prj.Conf is Proj : Project_List; begin + Debug_Output ("Applying config file to a project tree"); + Proj := Project_Tree.Projects; while Proj /= null loop if Proj.Project /= Config_File then User_Decl := Proj.Project.Decl; Add_Attributes - (Project_Tree => Project_Tree, - Conf_Decl => Conf_Decl, - User_Decl => User_Decl); + (Project_Tree => Project_Tree, + Conf_Decl => Conf_Decl, + User_Decl => User_Decl); Conf_Pack_Id := Conf_Decl.Packages; while Conf_Pack_Id /= No_Package loop - Conf_Pack := Project_Tree.Packages.Table (Conf_Pack_Id); + Conf_Pack := Shared.Packages.Table (Conf_Pack_Id); User_Pack_Id := User_Decl.Packages; while User_Pack_Id /= No_Package loop - User_Pack := Project_Tree.Packages.Table (User_Pack_Id); + User_Pack := Shared.Packages.Table (User_Pack_Id); exit when User_Pack.Name = Conf_Pack.Name; User_Pack_Id := User_Pack.Next; end loop; if User_Pack_Id = No_Package then - Package_Table.Increment_Last (Project_Tree.Packages); + Package_Table.Increment_Last (Shared.Packages); User_Pack := Conf_Pack; User_Pack.Next := User_Decl.Packages; - User_Decl.Packages := - Package_Table.Last (Project_Tree.Packages); - Project_Tree.Packages.Table (User_Decl.Packages) := - User_Pack; + User_Decl.Packages := Package_Table.Last (Shared.Packages); + Shared.Packages.Table (User_Decl.Packages) := User_Pack; else Add_Attributes - (Project_Tree => Project_Tree, - Conf_Decl => Conf_Pack.Decl, - User_Decl => Project_Tree.Packages.Table - (User_Pack_Id).Decl); + (Project_Tree => Project_Tree, + Conf_Decl => Conf_Pack.Decl, + User_Decl => + Shared.Packages.Table (User_Pack_Id).Decl); end if; Conf_Pack_Id := Conf_Pack.Next; end loop; Proj.Project.Decl := User_Decl; + + -- For aggregate projects, we need to apply the config to all + -- their aggregated trees as well. + + if Proj.Project.Qualifier = Aggregate then + declare + List : Aggregated_Project_List := + Proj.Project.Aggregated_Projects; + begin + while List /= null loop + Debug_Output + ("Recursively apply config to aggregated tree", + List.Project.Name); + Apply_Config_File + (Config_File, + Project_Tree => List.Tree); + List := List.Next; + end loop; + end; + end if; end if; Proj := Proj.Next; @@ -524,9 +547,10 @@ package body Prj.Conf is Project_Tree : Prj.Project_Tree_Ref; Target : String := "") return Boolean is + Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared; Variable : constant Variable_Value := Value_Of - (Name_Target, Config_File.Decl.Attributes, Project_Tree); + (Name_Target, Config_File.Decl.Attributes, Shared); Tgt_Name : Name_Id := No_Name; OK : Boolean; @@ -585,6 +609,7 @@ package body Prj.Conf is Automatically_Generated : out Boolean; On_Load_Config : Config_File_Hook := null) is + Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared; At_Least_One_Compiler_Command : Boolean := False; -- Set to True if at least one attribute Ide'Compiler_Command is @@ -655,7 +680,7 @@ package body Prj.Conf is Value_Of (Name_Source_Dirs, Project.Decl.Attributes, - Project_Tree); + Shared); if Variable = Nil_Variable_Value or else Variable.Default @@ -665,7 +690,7 @@ package body Prj.Conf is Value_Of (Name_Source_Files, Project.Decl.Attributes, - Project_Tree); + Shared); return Variable = Nil_Variable_Value or else Variable.Default or else Variable.Values /= Nil_String; @@ -690,10 +715,7 @@ package body Prj.Conf is -- Hash table to keep the languages used in the project tree IDE : constant Package_Id := - Value_Of - (Name_Ide, - Project.Decl.Packages, - Project_Tree); + Value_Of (Name_Ide, Project.Decl.Packages, Shared); Prj_Iter : Project_List; List : String_List_Id; @@ -714,7 +736,7 @@ package body Prj.Conf is Value_Of (Name_Languages, Prj_Iter.Project.Decl.Attributes, - Project_Tree); + Shared); if Variable = Nil_Variable_Value or else Variable.Default @@ -730,7 +752,7 @@ package body Prj.Conf is Value_Of (Name_Languages, Prj_Iter.Project.Extends.Decl.Attributes, - Project_Tree); + Shared); Check_Default := Variable /= Nil_Variable_Value and then Variable.Values = Nil_String; @@ -741,7 +763,7 @@ package body Prj.Conf is Value_Of (Name_Default_Language, Prj_Iter.Project.Decl.Attributes, - Project_Tree); + Shared); if Variable /= Nil_Variable_Value and then not Variable.Default @@ -765,7 +787,7 @@ package body Prj.Conf is List := Variable.Values; while List /= Nil_String loop - Elem := Project_Tree.String_Elements.Table (List); + Elem := Shared.String_Elements.Table (List); Get_Name_String (Elem.Value); To_Lower (Name_Buffer (1 .. Name_Len)); @@ -800,7 +822,7 @@ package body Prj.Conf is (Name, Attribute_Or_Array_Name => Name_Compiler_Command, In_Package => IDE, - In_Tree => Project_Tree, + Shared => Shared, Force_Lower_Case_Index => True); declare @@ -857,7 +879,7 @@ package body Prj.Conf is Value_Of (Name_Object_Dir, Project.Decl.Attributes, - Project_Tree); + Shared); Gprconfig_Path : String_Access; Success : Boolean; @@ -1261,6 +1283,7 @@ package body Prj.Conf is On_Load_Config : Config_File_Hook := null; Reset_Tree : Boolean := True) is + Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared; Main_Config_Project : Project_Id; Success : Boolean; @@ -1289,7 +1312,7 @@ package body Prj.Conf is Value_Of (Name_Object_Dir, Main_Project.Decl.Attributes, - Project_Tree); + Shared); begin if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads index af331846ce4..38e46bef426 100644 --- a/gcc/ada/prj-conf.ads +++ b/gcc/ada/prj-conf.ads @@ -162,17 +162,6 @@ package Prj.Conf is -- processed (and Packages_To_Check is used to indicate which packages -- should be processed) - procedure Apply_Config_File - (Config_File : Prj.Project_Id; - Project_Tree : Prj.Project_Tree_Ref); - -- Apply the configuration file settings to all the projects in the - -- project tree. The Project_Tree must have been parsed first, and - -- processed through the first phase so that all its projects are known. - -- - -- Currently, this will add new attributes and packages in the various - -- projects, so that when the second phase of the processing is performed - -- these attributes are automatically taken into account. - procedure Add_Default_GNAT_Naming_Scheme (Config_File : in out Prj.Tree.Project_Node_Id; Project_Tree : Prj.Tree.Project_Node_Tree_Ref); diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 222efe021bf..b5102c74f99 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -76,7 +76,7 @@ package body Prj.Env is procedure Add_To_Path (Source_Dirs : String_List_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; Buffer : in out String_Access; Buffer_Last : in out Natural); -- Add to Ada_Path_Buffer all the source directories in string list @@ -91,7 +91,7 @@ package body Prj.Env is procedure Add_To_Source_Path (Source_Dirs : String_List_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; Source_Paths : in out Source_Path_Table.Instance); -- Add to Ada_Path_B all the source directories in string list -- Source_Dirs, if any. Increment Ada_Path_Length. @@ -122,17 +122,25 @@ package body Prj.Env is Buffer : String_Access; Buffer_Last : Natural := 0; - procedure Add (Project : Project_Id; Dummy : in out Boolean); + procedure Add + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Dummy : in out Boolean); -- Add source dirs of Project to the path --------- -- Add -- --------- - procedure Add (Project : Project_Id; Dummy : in out Boolean) is + procedure Add + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Dummy : in out Boolean) + is pragma Unreferenced (Dummy); begin - Add_To_Path (Project.Source_Dirs, In_Tree, Buffer, Buffer_Last); + Add_To_Path + (Project.Source_Dirs, In_Tree.Shared, Buffer, Buffer_Last); end Add; procedure For_All_Projects is @@ -150,7 +158,8 @@ package body Prj.Env is if Project.Ada_Include_Path = null then Buffer := new String (1 .. 4096); - For_All_Projects (Project, Dummy); + For_All_Projects + (Project, In_Tree, Dummy, Include_Aggregated => True); Project.Ada_Include_Path := new String'(Buffer (1 .. Buffer_Last)); Free (Buffer); end if; @@ -159,7 +168,8 @@ package body Prj.Env is else Buffer := new String (1 .. 4096); - Add_To_Path (Project.Source_Dirs, In_Tree, Buffer, Buffer_Last); + Add_To_Path + (Project.Source_Dirs, In_Tree.Shared, Buffer, Buffer_Last); declare Result : constant String := Buffer (1 .. Buffer_Last); @@ -176,20 +186,28 @@ package body Prj.Env is function Ada_Objects_Path (Project : Project_Id; + In_Tree : Project_Tree_Ref; Including_Libraries : Boolean := True) return String_Access is Buffer : String_Access; Buffer_Last : Natural := 0; - procedure Add (Project : Project_Id; Dummy : in out Boolean); + procedure Add + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Dummy : in out Boolean); -- Add all the object directories of a project to the path --------- -- Add -- --------- - procedure Add (Project : Project_Id; Dummy : in out Boolean) is - pragma Unreferenced (Dummy); + procedure Add + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Dummy : in out Boolean) + is + pragma Unreferenced (Dummy, In_Tree); Path : constant Path_Name_Type := Get_Object_Directory (Project, @@ -214,7 +232,7 @@ package body Prj.Env is if Project.Ada_Objects_Path = null then Buffer := new String (1 .. 4096); - For_All_Projects (Project, Dummy); + For_All_Projects (Project, In_Tree, Dummy); Project.Ada_Objects_Path := new String'(Buffer (1 .. Buffer_Last)); Free (Buffer); @@ -291,7 +309,7 @@ package body Prj.Env is procedure Add_To_Path (Source_Dirs : String_List_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; Buffer : in out String_Access; Buffer_Last : in out Natural) is @@ -299,7 +317,7 @@ package body Prj.Env is Source_Dir : String_Element; begin while Current /= Nil_String loop - Source_Dir := In_Tree.String_Elements.Table (Current); + Source_Dir := Shared.String_Elements.Table (Current); Add_To_Path (Get_Name_String (Source_Dir.Display_Value), Buffer, Buffer_Last); Current := Source_Dir.Next; @@ -395,7 +413,7 @@ package body Prj.Env is procedure Add_To_Source_Path (Source_Dirs : String_List_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; Source_Paths : in out Source_Path_Table.Instance) is Current : String_List_Id := Source_Dirs; @@ -406,7 +424,7 @@ package body Prj.Env is -- Add each source directory while Current /= Nil_String loop - Source_Dir := In_Tree.String_Elements.Table (Current); + Source_Dir := Shared.String_Elements.Table (Current); Add_It := True; -- Check if the source directory is already in the table @@ -461,7 +479,10 @@ package body Prj.Env is Iter : Source_Iterator; Source : Source_Id; - procedure Check (Project : Project_Id; State : in out Integer); + procedure Check + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + State : in out Integer); -- Recursive procedure that put in the config pragmas file any non -- standard naming schemes, if it is not already in the file, then call -- itself for any imported project. @@ -482,23 +503,24 @@ package body Prj.Env is -- Check -- ----------- - procedure Check (Project : Project_Id; State : in out Integer) is - pragma Unreferenced (State); + procedure Check + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + State : in out Integer) + is + pragma Unreferenced (State, In_Tree); Lang : constant Language_Ptr := Get_Language_From_Name (Project, "ada"); Naming : Lang_Naming_Data; begin if Current_Verbosity = High then - Write_Str ("Checking project file """); - Write_Str (Namet.Get_Name_String (Project.Name)); - Write_Str ("""."); - Write_Eol; + Debug_Output ("Checking project file:", Project.Name); end if; if Lang = null then if Current_Verbosity = High then - Write_Line (" Languages does not contain Ada, nothing to do"); + Debug_Output ("Languages does not contain Ada, nothing to do"); end if; return; @@ -665,7 +687,8 @@ package body Prj.Env is -- Check the naming schemes - Check_Imported_Projects (For_Project, Dummy, Imported_First => False); + Check_Imported_Projects + (For_Project, In_Tree, Dummy, Imported_First => False); -- Visit all the files and process those that need an SFN pragma @@ -767,7 +790,10 @@ package body Prj.Env is procedure Put_Name_Buffer; -- Put the line contained in the Name_Buffer in the global buffer - procedure Process (Project : Project_Id; State : in out Integer); + procedure Process + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + State : in out Integer); -- Generate the mapping file for Project (not recursively) --------------------- @@ -789,7 +815,11 @@ package body Prj.Env is -- Process -- ------------- - procedure Process (Project : Project_Id; State : in out Integer) is + procedure Process + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + State : in out Integer) + is pragma Unreferenced (State); Source : Source_Id; Suffix : File_Name_Type; @@ -874,7 +904,7 @@ package body Prj.Env is Debug_Increase_Indent ("Create mapping file ", Name_Id (Name)); end if; - For_Every_Imported_Project (Project, Dummy); + For_Every_Imported_Project (Project, In_Tree, Dummy); declare Last : Natural; @@ -1174,16 +1204,26 @@ package body Prj.Env is -- For_All_Object_Dirs -- ------------------------- - procedure For_All_Object_Dirs (Project : Project_Id) is - procedure For_Project (Prj : Project_Id; Dummy : in out Integer); + procedure For_All_Object_Dirs + (Project : Project_Id; + Tree : Project_Tree_Ref) + is + procedure For_Project + (Prj : Project_Id; + Tree : Project_Tree_Ref; + Dummy : in out Integer); -- Get all object directories of Prj ----------------- -- For_Project -- ----------------- - procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is - pragma Unreferenced (Dummy); + procedure For_Project + (Prj : Project_Id; + Tree : Project_Tree_Ref; + Dummy : in out Integer) + is + pragma Unreferenced (Dummy, Tree); begin -- ??? Set_Ada_Paths has a different behavior for library project -- files, should we have the same ? @@ -1201,7 +1241,7 @@ package body Prj.Env is -- Start of processing for For_All_Object_Dirs begin - Get_Object_Dirs (Project, Dummy); + Get_Object_Dirs (Project, Tree, Dummy); end For_All_Object_Dirs; ------------------------- @@ -1212,14 +1252,21 @@ package body Prj.Env is (Project : Project_Id; In_Tree : Project_Tree_Ref) is - procedure For_Project (Prj : Project_Id; Dummy : in out Integer); + procedure For_Project + (Prj : Project_Id; + In_Tree : Project_Tree_Ref; + Dummy : in out Integer); -- Get all object directories of Prj ----------------- -- For_Project -- ----------------- - procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is + procedure For_Project + (Prj : Project_Id; + In_Tree : Project_Tree_Ref; + Dummy : in out Integer) + is pragma Unreferenced (Dummy); Current : String_List_Id := Prj.Source_Dirs; The_String : String_Element; @@ -1230,7 +1277,7 @@ package body Prj.Env is if Has_Ada_Sources (Project) then while Current /= Nil_String loop - The_String := In_Tree.String_Elements.Table (Current); + The_String := In_Tree.Shared.String_Elements.Table (Current); Action (Get_Name_String (The_String.Display_Value)); Current := The_String.Next; end loop; @@ -1244,7 +1291,7 @@ package body Prj.Env is -- Start of processing for For_All_Source_Dirs begin - Get_Source_Dirs (Project, Dummy); + Get_Source_Dirs (Project, In_Tree, Dummy); end For_All_Source_Dirs; ------------------- @@ -1541,7 +1588,10 @@ package body Prj.Env is Buffer : String_Access := new String (1 .. Buffer_Initial); Buffer_Last : Natural := 0; - procedure Recursive_Add (Project : Project_Id; Dummy : in out Boolean); + procedure Recursive_Add + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Dummy : in out Boolean); -- Recursive procedure to add the source/object paths of extended/ -- imported projects. @@ -1549,7 +1599,11 @@ package body Prj.Env is -- Recursive_Add -- ------------------- - procedure Recursive_Add (Project : Project_Id; Dummy : in out Boolean) is + procedure Recursive_Add + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Dummy : in out Boolean) + is pragma Unreferenced (Dummy); Path : Path_Name_Type; @@ -1563,7 +1617,8 @@ package body Prj.Env is -- Ada sources. if Has_Ada_Sources (Project) then - Add_To_Source_Path (Project.Source_Dirs, In_Tree, Source_Paths); + Add_To_Source_Path + (Project.Source_Dirs, In_Tree.Shared, Source_Paths); end if; end if; @@ -1621,7 +1676,7 @@ package body Prj.Env is -- then call the recursive procedure Add for Project. if Process_Source_Dirs or Process_Object_Dirs then - For_All_Projects (Project, Dummy); + For_All_Projects (Project, In_Tree, Dummy); end if; -- Write and close any file that has been created. Source_FD is not set diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 99bd88064fe..2be3cfe9407 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -88,6 +88,7 @@ package Prj.Env is function Ada_Objects_Path (Project : Project_Id; + In_Tree : Project_Tree_Ref; Including_Libraries : Boolean := True) return String_Access; -- Get the ADA_OBJECTS_PATH of a Project file. For the first call, compute -- it and cache it. When Including_Libraries is False, do not include the @@ -149,7 +150,9 @@ package Prj.Env is generic with procedure Action (Path : String); - procedure For_All_Object_Dirs (Project : Project_Id); + procedure For_All_Object_Dirs + (Project : Project_Id; + Tree : Project_Tree_Ref); -- Iterate through all the object directories of a project, including those -- of imported or modified projects. diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 743a1fc79ca..bc6c8ec9919 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -507,7 +507,8 @@ package body Prj.Nmsc is -- when there are no sources for language Lang_Name. procedure Show_Source_Dirs - (Project : Project_Id; In_Tree : Project_Tree_Ref); + (Project : Project_Id; + Shared : Shared_Project_Tree_Data_Access); -- List all the source directories of a project procedure Write_Attr (Name, Value : String); @@ -651,7 +652,6 @@ package body Prj.Nmsc is Add_Src : Boolean; Source : Source_Id; Prev_Unit : Unit_Index := No_Unit_Index; - Source_To_Replace : Source_Id := No_Source; begin @@ -939,7 +939,7 @@ package body Prj.Nmsc is Prj.Util.Value_Of (Snames.Name_Project_Files, Project.Decl.Attributes, - Tree); + Tree.Shared); Project_Path_For_Aggregate : Prj.Env.Project_Search_Path; @@ -958,22 +958,27 @@ package body Prj.Nmsc is procedure Found_Project_File (Path : Path_Information; Rank : Natural) is pragma Unreferenced (Rank); begin - Debug_Output ("Aggregates: ", Name_Id (Path.Display_Name)); - - -- For usual "with" statement, this phase will have been done when - -- parsing the project itself. However, for aggregate projects, we - -- can only do this when processing the aggregate project, since the - -- exact list of project files or project directories can depend on - -- scenario variables. - -- - -- We only load the projects explicitly here, but do not process - -- them. For the processing, Prj.Proc will take care of processing - -- them, within the same call to Recursive_Process (thus avoiding the - -- processing of a given project multiple times). - -- - -- ??? We might already have loaded the project - - Add_Aggregated_Project (Project, Path => Path.Name); + if Path.Name /= Project.Path.Name then + Debug_Output ("Aggregates: ", Name_Id (Path.Display_Name)); + + -- For usual "with" statement, this phase will have been done when + -- parsing the project itself. However, for aggregate projects, we + -- can only do this when processing the aggregate project, since + -- the exact list of project files or project directories can + -- depend on scenario variables. + -- + -- We only load the projects explicitly here, but do not process + -- them. For the processing, Prj.Proc will take care of processing + -- them, within the same call to Recursive_Process (thus avoiding + -- the processing of a given project multiple times). + -- + -- ??? We might already have loaded the project + + Add_Aggregated_Project (Project, Path => Path.Name); + + else + Debug_Output ("Pattern returned the aggregate itself, ignored"); + end if; end Found_Project_File; -- Start of processing for Check_Aggregate_Project @@ -1021,22 +1026,24 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; + Source_Dirs : constant Variable_Value := Util.Value_Of (Name_Source_Dirs, - Project.Decl.Attributes, Data.Tree); + Project.Decl.Attributes, Shared); Source_Files : constant Variable_Value := Util.Value_Of (Name_Source_Files, - Project.Decl.Attributes, Data.Tree); + Project.Decl.Attributes, Shared); Source_List_File : constant Variable_Value := Util.Value_Of (Name_Source_List_File, - Project.Decl.Attributes, Data.Tree); + Project.Decl.Attributes, Shared); Languages : constant Variable_Value := Util.Value_Of (Name_Languages, - Project.Decl.Attributes, Data.Tree); + Project.Decl.Attributes, Shared); begin if Project.Source_Dirs /= Nil_String then @@ -1065,6 +1072,7 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; Prj_Data : Project_Processing_Data; begin @@ -1079,7 +1087,7 @@ package body Prj.Nmsc is Check_Programming_Languages (Project, Data); if Current_Verbosity = High then - Show_Source_Dirs (Project, Data.Tree); + Show_Source_Dirs (Project, Shared); end if; end if; @@ -1303,6 +1311,9 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is + Shared : constant Shared_Project_Tree_Data_Access := + Data.Tree.Shared; + Dot_Replacement : File_Name_Type := No_File; Casing : Casing_Type := All_Lower_Case; Separate_Suffix : File_Name_Type := No_File; @@ -1364,11 +1375,11 @@ package body Prj.Nmsc is Current_Array_Id := Arrays; while Current_Array_Id /= No_Array loop - Current_Array := Data.Tree.Arrays.Table (Current_Array_Id); + Current_Array := Shared.Arrays.Table (Current_Array_Id); Element_Id := Current_Array.Value; while Element_Id /= No_Array_Element loop - Element := Data.Tree.Array_Elements.Table (Element_Id); + Element := Shared.Array_Elements.Table (Element_Id); if Element.Index /= All_Other_Names then @@ -1441,8 +1452,7 @@ package body Prj.Nmsc is Attribute_Id := Attributes; while Attribute_Id /= No_Variable loop - Attribute := - Data.Tree.Variable_Elements.Table (Attribute_Id); + Attribute := Shared.Variable_Elements.Table (Attribute_Id); if not Attribute.Value.Default then if Attribute.Name = Name_Executable_Suffix then @@ -1475,11 +1485,11 @@ package body Prj.Nmsc is Current_Array_Id := Arrays; while Current_Array_Id /= No_Array loop - Current_Array := Data.Tree.Arrays.Table (Current_Array_Id); + Current_Array := Shared.Arrays.Table (Current_Array_Id); Element_Id := Current_Array.Value; while Element_Id /= No_Array_Element loop - Element := Data.Tree.Array_Elements.Table (Element_Id); + Element := Shared.Array_Elements.Table (Element_Id); if Element.Index /= All_Other_Names then @@ -1806,7 +1816,7 @@ package body Prj.Nmsc is Attribute_Id := Attributes; while Attribute_Id /= No_Variable loop - Attribute := Data.Tree.Variable_Elements.Table (Attribute_Id); + Attribute := Shared.Variable_Elements.Table (Attribute_Id); if not Attribute.Value.Default then if Attribute.Name = Name_Separate_Suffix then @@ -1857,11 +1867,11 @@ package body Prj.Nmsc is Current_Array_Id := Arrays; while Current_Array_Id /= No_Array loop - Current_Array := Data.Tree.Arrays.Table (Current_Array_Id); + Current_Array := Shared.Arrays.Table (Current_Array_Id); Element_Id := Current_Array.Value; while Element_Id /= No_Array_Element loop - Element := Data.Tree.Array_Elements.Table (Element_Id); + Element := Shared.Array_Elements.Table (Element_Id); -- Get the name of the language @@ -1918,8 +1928,7 @@ package body Prj.Nmsc is Attribute_Id := Attributes; while Attribute_Id /= No_Variable loop - Attribute := - Data.Tree.Variable_Elements.Table (Attribute_Id); + Attribute := Shared.Variable_Elements.Table (Attribute_Id); if not Attribute.Value.Default then if Attribute.Name = Name_Driver then @@ -2026,7 +2035,7 @@ package body Prj.Nmsc is begin Packages := Project.Decl.Packages; while Packages /= No_Package loop - Element := Data.Tree.Packages.Table (Packages); + Element := Shared.Packages.Table (Packages); case Element.Name is when Name_Binder => @@ -2082,8 +2091,7 @@ package body Prj.Nmsc is Attribute_Id := Project.Decl.Attributes; while Attribute_Id /= No_Variable loop - Attribute := - Data.Tree.Variable_Elements.Table (Attribute_Id); + Attribute := Shared.Variable_Elements.Table (Attribute_Id); if not Attribute.Value.Default then if Attribute.Name = Name_Target then @@ -2400,11 +2408,11 @@ package body Prj.Nmsc is Current_Array_Id := Project.Decl.Arrays; while Current_Array_Id /= No_Array loop - Current_Array := Data.Tree.Arrays.Table (Current_Array_Id); + Current_Array := Shared.Arrays.Table (Current_Array_Id); Element_Id := Current_Array.Value; while Element_Id /= No_Array_Element loop - Element := Data.Tree.Array_Elements.Table (Element_Id); + Element := Shared.Array_Elements.Table (Element_Id); -- Get the name of the language @@ -2684,10 +2692,11 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; Externally_Built : constant Variable_Value := Util.Value_Of (Name_Externally_Built, - Project.Decl.Attributes, Data.Tree); + Project.Decl.Attributes, Shared); begin if not Externally_Built.Default then @@ -2726,17 +2735,19 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; + Interfaces : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Interfaces, Project.Decl.Attributes, - Data.Tree); + Shared); Library_Interface : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Interface, Project.Decl.Attributes, - Data.Tree); + Shared); List : String_List_Id; Element : String_Element; @@ -2767,7 +2778,7 @@ package body Prj.Nmsc is List := Interfaces.Values; while List /= Nil_String loop - Element := Data.Tree.String_Elements.Table (List); + Element := Shared.String_Elements.Table (List); Name := Canonical_Case_File_Name (Element.Value); Project_2 := Project; @@ -2840,7 +2851,7 @@ package body Prj.Nmsc is List := Library_Interface.Values; while List /= Nil_String loop - Element := Data.Tree.String_Elements.Table (List); + Element := Shared.String_Elements.Table (List); Get_Name_String (Element.Value); To_Lower (Name_Buffer (1 .. Name_Len)); Name := Name_Find; @@ -2913,9 +2924,10 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; Naming_Id : constant Package_Id := Util.Value_Of - (Name_Naming, Project.Decl.Packages, Data.Tree); + (Name_Naming, Project.Decl.Packages, Shared); Naming : Package_Element; Ada_Body_Suffix_Loc : Source_Ptr := No_Location; @@ -2957,17 +2969,17 @@ package body Prj.Nmsc is Util.Value_Of (Name_Dot_Replacement, Naming.Decl.Attributes, - Data.Tree); + Shared); Casing_String : constant Variable_Value := Util.Value_Of (Name_Casing, Naming.Decl.Attributes, - Data.Tree); + Shared); Sep_Suffix : constant Variable_Value := Util.Value_Of (Name_Separate_Suffix, Naming.Decl.Attributes, - Data.Tree); + Shared); Dot_Repl_Loc : Source_Ptr; begin @@ -3105,26 +3117,26 @@ package body Prj.Nmsc is Value_Of (Name_Implementation_Exceptions, In_Arrays => Naming.Decl.Arrays, - In_Tree => Data.Tree); + Shared => Shared); when Spec => Exceptions := Value_Of (Name_Specification_Exceptions, In_Arrays => Naming.Decl.Arrays, - In_Tree => Data.Tree); + Shared => Shared); end case; Exception_List := Value_Of (Index => Lang, In_Array => Exceptions, - In_Tree => Data.Tree); + Shared => Shared); if Exception_List /= Nil_Variable_Value then Element_Id := Exception_List.Values; while Element_Id /= Nil_String loop - Element := Data.Tree.String_Elements.Table (Element_Id); + Element := Shared.String_Elements.Table (Element_Id); File_Name := Canonical_Case_File_Name (Element.Value); Source := @@ -3200,14 +3212,14 @@ package body Prj.Nmsc is Value_Of (Name_Body, In_Arrays => Naming.Decl.Arrays, - In_Tree => Data.Tree); + Shared => Shared); if Exceptions = No_Array_Element then Exceptions := Value_Of (Name_Implementation, In_Arrays => Naming.Decl.Arrays, - In_Tree => Data.Tree); + Shared => Shared); end if; when Spec => @@ -3215,19 +3227,19 @@ package body Prj.Nmsc is Value_Of (Name_Spec, In_Arrays => Naming.Decl.Arrays, - In_Tree => Data.Tree); + Shared => Shared); if Exceptions = No_Array_Element then Exceptions := Value_Of (Name_Spec, In_Arrays => Naming.Decl.Arrays, - In_Tree => Data.Tree); + Shared => Shared); end if; end case; while Exceptions /= No_Array_Element loop - Element := Data.Tree.Array_Elements.Table (Exceptions); + Element := Shared.Array_Elements.Table (Exceptions); File_Name := Canonical_Case_File_Name (Element.Value.Value); Get_Name_String (Element.Index); @@ -3332,14 +3344,14 @@ package body Prj.Nmsc is (Name => Lang, Attribute_Or_Array_Name => Name_Spec_Suffix, In_Package => Naming_Id, - In_Tree => Data.Tree); + Shared => Shared); if Suffix = Nil_Variable_Value then Suffix := Value_Of (Name => Lang, Attribute_Or_Array_Name => Name_Specification_Suffix, In_Package => Naming_Id, - In_Tree => Data.Tree); + Shared => Shared); end if; if Suffix /= Nil_Variable_Value then @@ -3364,7 +3376,7 @@ package body Prj.Nmsc is (Name => Lang, Attribute_Or_Array_Name => Name_Body_Suffix, In_Package => Naming_Id, - In_Tree => Data.Tree); + Shared => Shared); if Suffix = Nil_Variable_Value then Suffix := @@ -3372,7 +3384,7 @@ package body Prj.Nmsc is (Name => Lang, Attribute_Or_Array_Name => Name_Implementation_Suffix, In_Package => Naming_Id, - In_Tree => Data.Tree); + Shared => Shared); end if; if Suffix /= Nil_Variable_Value then @@ -3470,13 +3482,13 @@ package body Prj.Nmsc is Util.Value_Of (Name_Spec_Suffix, Naming.Decl.Arrays, - Data.Tree); + Shared); Impls : Array_Element_Id := Util.Value_Of (Name_Body_Suffix, Naming.Decl.Arrays, - Data.Tree); + Shared); Lang : Language_Ptr; Lang_Name : Name_Id; @@ -3489,7 +3501,7 @@ package body Prj.Nmsc is -- user project, and they override the default. while Specs /= No_Array_Element loop - Lang_Name := Data.Tree.Array_Elements.Table (Specs).Index; + Lang_Name := Shared.Array_Elements.Table (Specs).Index; Lang := Get_Language_From_Name (Project, Name => Get_Name_String (Lang_Name)); @@ -3523,7 +3535,7 @@ package body Prj.Nmsc is Lang_Name); else - Value := Data.Tree.Array_Elements.Table (Specs).Value; + Value := Shared.Array_Elements.Table (Specs).Value; if Value.Kind = Single then Lang.Config.Naming_Data.Spec_Suffix := @@ -3531,11 +3543,11 @@ package body Prj.Nmsc is end if; end if; - Specs := Data.Tree.Array_Elements.Table (Specs).Next; + Specs := Shared.Array_Elements.Table (Specs).Next; end loop; while Impls /= No_Array_Element loop - Lang_Name := Data.Tree.Array_Elements.Table (Impls).Index; + Lang_Name := Shared.Array_Elements.Table (Impls).Index; Lang := Get_Language_From_Name (Project, Name => Get_Name_String (Lang_Name)); @@ -3545,7 +3557,7 @@ package body Prj.Nmsc is ("Ignoring impl naming data (lang. not in project): ", Lang_Name); else - Value := Data.Tree.Array_Elements.Table (Impls).Value; + Value := Shared.Array_Elements.Table (Impls).Value; if Lang.Name = Name_Ada then Ada_Body_Suffix_Loc := Value.Location; @@ -3557,7 +3569,7 @@ package body Prj.Nmsc is end if; end if; - Impls := Data.Tree.Array_Elements.Table (Impls).Next; + Impls := Shared.Array_Elements.Table (Impls).Next; end loop; end Initialize_Naming_Data; @@ -3569,7 +3581,7 @@ package body Prj.Nmsc is if Naming_Id /= No_Package and then Project.Qualifier /= Configuration then - Naming := Data.Tree.Packages.Table (Naming_Id); + Naming := Shared.Packages.Table (Naming_Id); Debug_Increase_Indent ("Checking package Naming for ", Project.Name); Initialize_Naming_Data; Check_Naming; @@ -3585,31 +3597,33 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; + Attributes : constant Prj.Variable_Id := Project.Decl.Attributes; Lib_Dir : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_Dir, Attributes, Data.Tree); + (Snames.Name_Library_Dir, Attributes, Shared); Lib_Name : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_Name, Attributes, Data.Tree); + (Snames.Name_Library_Name, Attributes, Shared); Lib_Version : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_Version, Attributes, Data.Tree); + (Snames.Name_Library_Version, Attributes, Shared); Lib_ALI_Dir : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_Ali_Dir, Attributes, Data.Tree); + (Snames.Name_Library_Ali_Dir, Attributes, Shared); Lib_GCC : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_GCC, Attributes, Data.Tree); + (Snames.Name_Library_GCC, Attributes, Shared); The_Lib_Kind : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_Kind, Attributes, Data.Tree); + (Snames.Name_Library_Kind, Attributes, Shared); Imported_Project_List : Project_List; @@ -3839,7 +3853,7 @@ package body Prj.Nmsc is Dirs_Id := Project.Source_Dirs; while Dirs_Id /= Nil_String loop - Dir_Elem := Data.Tree.String_Elements.Table (Dirs_Id); + Dir_Elem := Shared.String_Elements.Table (Dirs_Id); Dirs_Id := Dir_Elem.Next; if Project.Library_Dir.Name = @@ -3871,7 +3885,7 @@ package body Prj.Nmsc is Dir_Loop : while Dirs_Id /= Nil_String loop Dir_Elem := - Data.Tree.String_Elements.Table (Dirs_Id); + Shared.String_Elements.Table (Dirs_Id); Dirs_Id := Dir_Elem.Next; if Project.Library_Dir.Name = @@ -4027,8 +4041,7 @@ package body Prj.Nmsc is Dirs_Id := Project.Source_Dirs; while Dirs_Id /= Nil_String loop - Dir_Elem := - Data.Tree.String_Elements.Table (Dirs_Id); + Dir_Elem := Shared.String_Elements.Table (Dirs_Id); Dirs_Id := Dir_Elem.Next; if Project.Library_ALI_Dir.Name = @@ -4061,8 +4074,7 @@ package body Prj.Nmsc is ALI_Dir_Loop : while Dirs_Id /= Nil_String loop Dir_Elem := - Data.Tree.String_Elements.Table - (Dirs_Id); + Shared.String_Elements.Table (Dirs_Id); Dirs_Id := Dir_Elem.Next; if Project.Library_ALI_Dir.Name = @@ -4178,14 +4190,14 @@ package body Prj.Nmsc is Value_Of (Name_Linker, Project.Decl.Packages, - Data.Tree); + Shared); Driver : constant Variable_Value := Value_Of (Name => No_Name, Attribute_Or_Array_Name => Name_Driver, In_Package => Linker, - In_Tree => Data.Tree); + Shared => Shared); begin if Driver /= Nil_Variable_Value @@ -4227,26 +4239,26 @@ package body Prj.Nmsc is Linker_Package_Id : constant Package_Id := Util.Value_Of (Name_Linker, - Project.Decl.Packages, Data.Tree); + Project.Decl.Packages, Shared); Linker_Package : Package_Element; Switches : Array_Element_Id := No_Array_Element; begin if Linker_Package_Id /= No_Package then - Linker_Package := Data.Tree.Packages.Table (Linker_Package_Id); + Linker_Package := Shared.Packages.Table (Linker_Package_Id); Switches := Value_Of (Name => Name_Switches, In_Arrays => Linker_Package.Decl.Arrays, - In_Tree => Data.Tree); + Shared => Shared); if Switches = No_Array_Element then Switches := Value_Of (Name => Name_Default_Switches, In_Arrays => Linker_Package.Decl.Arrays, - In_Tree => Data.Tree); + Shared => Shared); end if; if Switches /= No_Array_Element then @@ -4310,6 +4322,8 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; + Languages : Variable_Value := Nil_Variable_Value; Def_Lang : Variable_Value := Nil_Variable_Value; Def_Lang_Id : Name_Id; @@ -4354,10 +4368,10 @@ package body Prj.Nmsc is begin Project.Languages := null; Languages := - Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Data.Tree); + Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Shared); Def_Lang := Prj.Util.Value_Of - (Name_Default_Language, Project.Decl.Attributes, Data.Tree); + (Name_Default_Language, Project.Decl.Attributes, Shared); if Project.Source_Dirs /= Nil_String then @@ -4411,7 +4425,7 @@ package body Prj.Nmsc is -- Languages. while Current /= Nil_String loop - Element := Data.Tree.String_Elements.Table (Current); + Element := Shared.String_Elements.Table (Current); Get_Name_String (Element.Value); To_Lower (Name_Buffer (1 .. Name_Len)); @@ -4435,41 +4449,43 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; + Lib_Interfaces : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Interface, Project.Decl.Attributes, - Data.Tree); + Shared); Lib_Auto_Init : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Auto_Init, Project.Decl.Attributes, - Data.Tree); + Shared); Lib_Src_Dir : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Src_Dir, Project.Decl.Attributes, - Data.Tree); + Shared); Lib_Symbol_File : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Symbol_File, Project.Decl.Attributes, - Data.Tree); + Shared); Lib_Symbol_Policy : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Symbol_Policy, Project.Decl.Attributes, - Data.Tree); + Shared); Lib_Ref_Symbol_File : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Reference_Symbol_File, Project.Decl.Attributes, - Data.Tree); + Shared); Auto_Init_Supported : Boolean; OK : Boolean := True; @@ -4508,14 +4524,14 @@ package body Prj.Nmsc is while Interfaces /= Nil_String loop Get_Name_String - (Data.Tree.String_Elements.Table (Interfaces).Value); + (Shared.String_Elements.Table (Interfaces).Value); To_Lower (Name_Buffer (1 .. Name_Len)); if Name_Len = 0 then Error_Msg (Data.Flags, "an interface cannot be an empty string", - Data.Tree.String_Elements.Table (Interfaces).Location, + Shared.String_Elements.Table (Interfaces).Location, Project); else @@ -4564,8 +4580,8 @@ package body Prj.Nmsc is Error_Msg (Data.Flags, "%% is not a unit of this project", - Data.Tree.String_Elements.Table - (Interfaces).Location, Project); + Shared.String_Elements.Table (Interfaces).Location, + Project); else if Source.Kind = Spec @@ -4575,27 +4591,24 @@ package body Prj.Nmsc is end if; String_Element_Table.Increment_Last - (Data.Tree.String_Elements); + (Shared.String_Elements); - Data.Tree.String_Elements.Table - (String_Element_Table.Last - (Data.Tree.String_Elements)) := + Shared.String_Elements.Table + (String_Element_Table.Last (Shared.String_Elements)) := (Value => Name_Id (Source.Dep_Name), Index => 0, Display_Value => Name_Id (Source.Dep_Name), Location => - Data.Tree.String_Elements.Table - (Interfaces).Location, + Shared.String_Elements.Table (Interfaces).Location, Flag => False, Next => Interface_ALIs); Interface_ALIs := - String_Element_Table.Last - (Data.Tree.String_Elements); + String_Element_Table.Last (Shared.String_Elements); end if; end if; - Interfaces := Data.Tree.String_Elements.Table (Interfaces).Next; + Interfaces := Shared.String_Elements.Table (Interfaces).Next; end loop; -- Put the list of Interface ALIs in the project data @@ -4703,7 +4716,7 @@ package body Prj.Nmsc is Src_Dirs := Project.Source_Dirs; while Src_Dirs /= Nil_String loop - Src_Dir := Data.Tree.String_Elements.Table (Src_Dirs); + Src_Dir := Shared.String_Elements.Table (Src_Dirs); -- Report error if it is one of the source directories @@ -4734,7 +4747,7 @@ package body Prj.Nmsc is Src_Dirs := Pid.Project.Source_Dirs; Dir_Loop : while Src_Dirs /= Nil_String loop Src_Dir := - Data.Tree.String_Elements.Table (Src_Dirs); + Shared.String_Elements.Table (Src_Dirs); -- Report error if it is one of the source -- directories. @@ -5002,41 +5015,43 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; + Object_Dir : constant Variable_Value := Util.Value_Of - (Name_Object_Dir, Project.Decl.Attributes, Data.Tree); + (Name_Object_Dir, Project.Decl.Attributes, Shared); Exec_Dir : constant Variable_Value := Util.Value_Of - (Name_Exec_Dir, Project.Decl.Attributes, Data.Tree); + (Name_Exec_Dir, Project.Decl.Attributes, Shared); Source_Dirs : constant Variable_Value := Util.Value_Of - (Name_Source_Dirs, Project.Decl.Attributes, Data.Tree); + (Name_Source_Dirs, Project.Decl.Attributes, Shared); Ignore_Source_Sub_Dirs : constant Variable_Value := Util.Value_Of (Name_Ignore_Source_Sub_Dirs, Project.Decl.Attributes, - Data.Tree); + Shared); Excluded_Source_Dirs : constant Variable_Value := Util.Value_Of (Name_Excluded_Source_Dirs, Project.Decl.Attributes, - Data.Tree); + Shared); Source_Files : constant Variable_Value := Util.Value_Of (Name_Source_Files, - Project.Decl.Attributes, Data.Tree); + Project.Decl.Attributes, Shared); Last_Source_Dir : String_List_Id := Nil_String; Last_Src_Dir_Rank : Number_List_Index := No_Number_List; Languages : constant Variable_Value := Prj.Util.Value_Of - (Name_Languages, Project.Decl.Attributes, Data.Tree); + (Name_Languages, Project.Decl.Attributes, Shared); Remove_Source_Dirs : Boolean := False; @@ -5070,12 +5085,12 @@ package body Prj.Nmsc is List := Project.Source_Dirs; Rank_List := Project.Source_Dir_Ranks; while List /= Nil_String loop - Element := Data.Tree.String_Elements.Table (List); + Element := Shared.String_Elements.Table (List); exit when Element.Value = Name_Id (Path.Name); Prev := List; List := Element.Next; Prev_Rank := Rank_List; - Rank_List := Data.Tree.Number_Lists.Table (Prev_Rank).Next; + Rank_List := Shared.Number_Lists.Table (Prev_Rank).Next; end loop; -- The directory is in the list if List is not Nil_String @@ -5083,7 +5098,7 @@ package body Prj.Nmsc is if not Remove_Source_Dirs and then List = Nil_String then Debug_Output ("Adding source dir=", Name_Id (Path.Display_Name)); - String_Element_Table.Increment_Last (Data.Tree.String_Elements); + String_Element_Table.Increment_Last (Shared.String_Elements); Element := (Value => Name_Id (Path.Name), Index => 0, @@ -5092,35 +5107,34 @@ package body Prj.Nmsc is Flag => False, Next => Nil_String); - Number_List_Table.Increment_Last (Data.Tree.Number_Lists); + Number_List_Table.Increment_Last (Shared.Number_Lists); if Last_Source_Dir = Nil_String then -- This is the first source directory Project.Source_Dirs := - String_Element_Table.Last (Data.Tree.String_Elements); + String_Element_Table.Last (Shared.String_Elements); Project.Source_Dir_Ranks := - Number_List_Table.Last (Data.Tree.Number_Lists); + Number_List_Table.Last (Shared.Number_Lists); else -- We already have source directories, link the previous -- last to the new one. - Data.Tree.String_Elements.Table (Last_Source_Dir).Next := - String_Element_Table.Last (Data.Tree.String_Elements); - Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank).Next := - Number_List_Table.Last (Data.Tree.Number_Lists); + Shared.String_Elements.Table (Last_Source_Dir).Next := + String_Element_Table.Last (Shared.String_Elements); + Shared.Number_Lists.Table (Last_Src_Dir_Rank).Next := + Number_List_Table.Last (Shared.Number_Lists); end if; -- And register this source directory as the new last Last_Source_Dir := - String_Element_Table.Last (Data.Tree.String_Elements); - Data.Tree.String_Elements.Table (Last_Source_Dir) := Element; - Last_Src_Dir_Rank := - Number_List_Table.Last (Data.Tree.Number_Lists); - Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank) := + String_Element_Table.Last (Shared.String_Elements); + Shared.String_Elements.Table (Last_Source_Dir) := Element; + Last_Src_Dir_Rank := Number_List_Table.Last (Shared.Number_Lists); + Shared.Number_Lists.Table (Last_Src_Dir_Rank) := (Number => Rank, Next => No_Number_List); elsif Remove_Source_Dirs and then List /= Nil_String then @@ -5128,16 +5142,15 @@ package body Prj.Nmsc is -- Remove source dir if present if Prev = Nil_String then - Project.Source_Dirs := - Data.Tree.String_Elements.Table (List).Next; + Project.Source_Dirs := Shared.String_Elements.Table (List).Next; Project.Source_Dir_Ranks := - Data.Tree.Number_Lists.Table (Rank_List).Next; + Shared.Number_Lists.Table (Rank_List).Next; else - Data.Tree.String_Elements.Table (Prev).Next := - Data.Tree.String_Elements.Table (List).Next; - Data.Tree.Number_Lists.Table (Prev_Rank).Next := - Data.Tree.Number_Lists.Table (Rank_List).Next; + Shared.String_Elements.Table (Prev).Next := + Shared.String_Elements.Table (List).Next; + Shared.Number_Lists.Table (Prev_Rank).Next := + Shared.Number_Lists.Table (Rank_List).Next; end if; end if; end Add_To_Or_Remove_From_Source_Dirs; @@ -5357,11 +5370,11 @@ package body Prj.Nmsc is begin while Current /= Nil_String loop - Element := Data.Tree.String_Elements.Table (Current); + Element := Shared.String_Elements.Table (Current); if Element.Value /= No_Name then Element.Value := Name_Id (Canonical_Case_File_Name (Element.Value)); - Data.Tree.String_Elements.Table (Current) := Element; + Shared.String_Elements.Table (Current) := Element; end if; Current := Element.Next; @@ -5377,9 +5390,11 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; + Mains : constant Variable_Value := Prj.Util.Value_Of - (Name_Main, Project.Decl.Attributes, Data.Tree); + (Name_Main, Project.Decl.Attributes, Shared); List : String_List_Id; Elem : String_Element; @@ -5405,7 +5420,7 @@ package body Prj.Nmsc is else List := Mains.Values; while List /= Nil_String loop - Elem := Data.Tree.String_Elements.Table (List); + Elem := Shared.String_Elements.Table (List); if Length_Of_Name (Elem.Value) = 0 then Error_Msg @@ -5972,15 +5987,17 @@ package body Prj.Nmsc is (Project : in out Project_Processing_Data; Data : in out Tree_Processing_Data) is + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; + Excluded_Source_List_File : constant Variable_Value := Util.Value_Of (Name_Excluded_Source_List_File, Project.Project.Decl.Attributes, - Data.Tree); + Shared); Excluded_Sources : Variable_Value := Util.Value_Of (Name_Excluded_Source_Files, Project.Project.Decl.Attributes, - Data.Tree); + Shared); Current : String_List_Id; Element : String_Element; @@ -5999,7 +6016,7 @@ package body Prj.Nmsc is Excluded_Sources := Util.Value_Of (Name_Locally_Removed_Files, - Project.Project.Decl.Attributes, Data.Tree); + Project.Project.Decl.Attributes, Shared); end if; -- If there are excluded sources, put them in the table @@ -6023,7 +6040,7 @@ package body Prj.Nmsc is Current := Excluded_Sources.Values; while Current /= Nil_String loop - Element := Data.Tree.String_Elements.Table (Current); + Element := Shared.String_Elements.Table (Current); Name := Canonical_Case_File_Name (Element.Value); -- If the element has no location, then use the location of @@ -6129,17 +6146,19 @@ package body Prj.Nmsc is (Project : in out Project_Processing_Data; Data : in out Tree_Processing_Data) is + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; + Sources : constant Variable_Value := Util.Value_Of (Name_Source_Files, Project.Project.Decl.Attributes, - Data.Tree); + Shared); Source_List_File : constant Variable_Value := Util.Value_Of (Name_Source_List_File, Project.Project.Decl.Attributes, - Data.Tree); + Shared); Name_Loc : Name_Location; Has_Explicit_Sources : Boolean; @@ -6188,7 +6207,7 @@ package body Prj.Nmsc is end if; while Current /= Nil_String loop - Element := Data.Tree.String_Elements.Table (Current); + Element := Shared.String_Elements.Table (Current); Name := Canonical_Case_File_Name (Element.Value); Get_Name_String (Element.Value); @@ -6810,6 +6829,8 @@ package body Prj.Nmsc is Search_For : Search_Type; Resolve_Links : Boolean) is + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; + package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable (Header_Num => Header_Num, Element => Boolean, @@ -6950,13 +6971,12 @@ package body Prj.Nmsc is while List /= Nil_String loop Get_Name_String - (Data.Tree.String_Elements.Table (List).Value); + (Shared.String_Elements.Table (List).Value); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); OK := Name_Buffer (1 .. Name_Len) /= Dir_Name; exit when not OK; - List := - Data.Tree.String_Elements.Table (List).Next; + List := Shared.String_Elements.Table (List).Next; end loop; end; end if; @@ -7116,7 +7136,7 @@ package body Prj.Nmsc is begin while Pattern_Id /= Nil_String loop - Element := Data.Tree.String_Elements.Table (Pattern_Id); + Element := Shared.String_Elements.Table (Pattern_Id); Find_Pattern (Element.Value, Rank, Element.Location); Rank := Rank + 1; Pattern_Id := Element.Next; @@ -7134,6 +7154,8 @@ package body Prj.Nmsc is Data : in out Tree_Processing_Data; For_All_Sources : Boolean) is + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; + Source_Dir : String_List_Id; Element : String_Element; Src_Dir_Rank : Number_List_Index; @@ -7153,8 +7175,8 @@ package body Prj.Nmsc is Src_Dir_Rank := Project.Project.Source_Dir_Ranks; while Source_Dir /= Nil_String loop begin - Num_Nod := Data.Tree.Number_Lists.Table (Src_Dir_Rank); - Element := Data.Tree.String_Elements.Table (Source_Dir); + Num_Nod := Shared.Number_Lists.Table (Src_Dir_Rank); + Element := Shared.String_Elements.Table (Source_Dir); -- Use Element.Value in this test, not Display_Value, because we -- want the symbolic links to be resolved when appropriate. @@ -7932,7 +7954,7 @@ package body Prj.Nmsc is procedure Show_Source_Dirs (Project : Project_Id; - In_Tree : Project_Tree_Ref) + Shared : Shared_Project_Tree_Data_Access) is Current : String_List_Id; Element : String_Element; @@ -7945,7 +7967,7 @@ package body Prj.Nmsc is Current := Project.Source_Dirs; while Current /= Nil_String loop - Element := In_Tree.String_Elements.Table (Current); + Element := Shared.String_Elements.Table (Current); Debug_Output (Get_Name_String (Element.Display_Value)); Current := Element.Next; end loop; @@ -7965,8 +7987,9 @@ package body Prj.Nmsc is Flags : Processing_Flags) is procedure Recursive_Check - (Project : Project_Id; - Data : in out Tree_Processing_Data); + (Project : Project_Id; + Prj_Tree : Project_Tree_Ref; + Data : in out Tree_Processing_Data); -- Check_Naming_Scheme for the project --------------------- @@ -7974,17 +7997,21 @@ package body Prj.Nmsc is --------------------- procedure Recursive_Check - (Project : Project_Id; - Data : in out Tree_Processing_Data) - is + (Project : Project_Id; + Prj_Tree : Project_Tree_Ref; + Data : in out Tree_Processing_Data) is begin - if Verbose_Mode then - Write_Str ("Processing_Naming_Scheme for project """); - Write_Str (Get_Name_String (Project.Name)); - Write_Line (""""); + if Current_Verbosity = High then + Debug_Increase_Indent + ("Processing_Naming_Scheme for project", Project.Name); end if; + Data.Tree := Prj_Tree; Prj.Nmsc.Check (Project, Data); + + if Current_Verbosity = High then + Debug_Decrease_Indent ("Done Processing_Naming_Scheme"); + end if; end Recursive_Check; procedure Check_All_Projects is new @@ -7996,7 +8023,7 @@ package body Prj.Nmsc is begin Lib_Data_Table.Init; Initialize (Data, Tree => Tree, Node_Tree => Node_Tree, Flags => Flags); - Check_All_Projects (Root_Project, Data, Imported_First => True); + Check_All_Projects (Root_Project, Tree, Data, Imported_First => True); Free (Data); -- Adjust language configs for projects that are extended diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index ac07421eb90..15491996cad 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -71,7 +71,7 @@ package body Prj.Proc is (Project : Project_Id; Project_Name : Name_Id; Project_Dir : Name_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; Decl : in out Declarations; First : Attribute_Node_Id; Project_Level : Boolean); @@ -95,7 +95,7 @@ package body Prj.Proc is To : in out Declarations; New_Loc : Source_Ptr; Restricted : Boolean; - In_Tree : Project_Tree_Ref); + Shared : Shared_Project_Tree_Data_Access); -- Copy a package declaration From to To for a renamed package. Change the -- locations of all the attributes to New_Loc. When Restricted is -- True, do not copy attributes Body, Spec, Implementation, Specification @@ -103,7 +103,7 @@ package body Prj.Proc is function Expression (Project : Project_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; From_Project_Node : Project_Node_Id; From_Project_Node_Tree : Project_Node_Tree_Ref; Env : Prj.Tree.Environment; @@ -120,29 +120,26 @@ package body Prj.Proc is function Package_From (Project : Project_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; With_Name : Name_Id) return Package_Id; -- Find the package of Project whose name is With_Name procedure Process_Declarative_Items - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - From_Project_Node : Project_Node_Id; - Node_Tree : Project_Node_Tree_Ref; - Env : Prj.Tree.Environment; - Pkg : Package_Id; - Item : Project_Node_Id; - Child_Env : in out Prj.Tree.Environment; - Can_Modify_Child_Env : Boolean); + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + From_Project_Node : Project_Node_Id; + Node_Tree : Project_Node_Tree_Ref; + Env : Prj.Tree.Environment; + Pkg : Package_Id; + Item : Project_Node_Id; + Child_Env : in out Prj.Tree.Environment); -- Process declarative items starting with From_Project_Node, and put them -- in declarations Decl. This is a recursive procedure; it calls itself for -- a package declaration or a case construction. -- -- Child_Env is the modified environment after seeing declarations like -- "for External(...) use" or "for Project_Path use" in aggregate projects. - -- It should have been initialized first. This environment can only be - -- modified if Can_Modify_Child_Env is True, otherwise all the above - -- attributes simply have no effect. + -- It should have been initialized first. procedure Recursive_Process (In_Tree : Project_Tree_Ref; @@ -150,20 +147,13 @@ package body Prj.Proc is From_Project_Node : Project_Node_Id; From_Project_Node_Tree : Project_Node_Tree_Ref; Env : in out Prj.Tree.Environment; - Extended_By : Project_Id; - Child_Env : in out Prj.Tree.Environment; - Is_Root_Project : Boolean); + 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, -- simply return its project id. Otherwise create a new project id, mark it -- as processed, call itself recursively for all imported projects and a -- extended project, if any. Then process the declarative items of the -- project. - -- - -- Child_Env is the environment created from an aggregate project (new - -- external values or project path), and should be initialized before the - -- call. - -- -- Is_Root_Project should be true only for the project that the user -- explicitly loaded. In the context of aggregate projects, only that -- project is allowed to modify the environment that will be used to load @@ -209,7 +199,7 @@ package body Prj.Proc is (Project : Project_Id; Project_Name : Name_Id; Project_Dir : Name_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; Decl : in out Declarations; First : Attribute_Node_Id; Project_Level : Boolean) @@ -272,15 +262,14 @@ package body Prj.Proc is end case; Variable_Element_Table.Increment_Last - (In_Tree.Variable_Elements); - In_Tree.Variable_Elements.Table - (Variable_Element_Table.Last - (In_Tree.Variable_Elements)) := + (Shared.Variable_Elements); + Shared.Variable_Elements.Table + (Variable_Element_Table.Last (Shared.Variable_Elements)) := (Next => Decl.Attributes, Name => Attribute_Name_Of (The_Attribute), Value => New_Attribute); Decl.Attributes := Variable_Element_Table.Last - (In_Tree.Variable_Elements); + (Shared.Variable_Elements); end; end if; @@ -342,7 +331,7 @@ package body Prj.Proc is To : in out Declarations; New_Loc : Source_Ptr; Restricted : Boolean; - In_Tree : Project_Tree_Ref) + Shared : Shared_Project_Tree_Data_Access) is V1 : Variable_Id; V2 : Variable_Id := No_Variable; @@ -367,7 +356,7 @@ package body Prj.Proc is -- Copy the attribute - Var := In_Tree.Variable_Elements.Table (V1); + Var := Shared.Variable_Elements.Table (V1); V1 := Var.Next; -- Do not copy the value of attribute Linker_Options if Restricted @@ -383,27 +372,27 @@ package body Prj.Proc is -- Change the location to New_Loc Var.Value.Location := New_Loc; - Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements); + Variable_Element_Table.Increment_Last (Shared.Variable_Elements); -- Put in new declaration if To.Attributes = No_Variable then To.Attributes := - Variable_Element_Table.Last (In_Tree.Variable_Elements); + Variable_Element_Table.Last (Shared.Variable_Elements); else - In_Tree.Variable_Elements.Table (V2).Next := - Variable_Element_Table.Last (In_Tree.Variable_Elements); + Shared.Variable_Elements.Table (V2).Next := + Variable_Element_Table.Last (Shared.Variable_Elements); end if; - V2 := Variable_Element_Table.Last (In_Tree.Variable_Elements); - In_Tree.Variable_Elements.Table (V2) := Var; + V2 := Variable_Element_Table.Last (Shared.Variable_Elements); + Shared.Variable_Elements.Table (V2) := Var; end loop; -- Then the associated array attributes A1 := From.Arrays; while A1 /= No_Array loop - Arr := In_Tree.Arrays.Table (A1); + Arr := Shared.Arrays.Table (A1); A1 := Arr.Next; if not Restricted @@ -416,18 +405,18 @@ package body Prj.Proc is -- Remove the Next component Arr.Next := No_Array; - Array_Table.Increment_Last (In_Tree.Arrays); + Array_Table.Increment_Last (Shared.Arrays); -- Create new Array declaration if To.Arrays = No_Array then - To.Arrays := Array_Table.Last (In_Tree.Arrays); + To.Arrays := Array_Table.Last (Shared.Arrays); else - In_Tree.Arrays.Table (A2).Next := - Array_Table.Last (In_Tree.Arrays); + Shared.Arrays.Table (A2).Next := + Array_Table.Last (Shared.Arrays); end if; - A2 := Array_Table.Last (In_Tree.Arrays); + A2 := Array_Table.Last (Shared.Arrays); -- Don't store the array as its first element has not been set yet @@ -439,7 +428,7 @@ package body Prj.Proc is -- Copy the array element - Elm := In_Tree.Array_Elements.Table (E1); + Elm := Shared.Array_Elements.Table (E1); E1 := Elm.Next; -- Remove the Next component @@ -449,25 +438,25 @@ package body Prj.Proc is -- Change the location Elm.Value.Location := New_Loc; - Array_Element_Table.Increment_Last (In_Tree.Array_Elements); + Array_Element_Table.Increment_Last (Shared.Array_Elements); -- Create new array element if Arr.Value = No_Array_Element then Arr.Value := - Array_Element_Table.Last (In_Tree.Array_Elements); + Array_Element_Table.Last (Shared.Array_Elements); else - In_Tree.Array_Elements.Table (E2).Next := - Array_Element_Table.Last (In_Tree.Array_Elements); + Shared.Array_Elements.Table (E2).Next := + Array_Element_Table.Last (Shared.Array_Elements); end if; - E2 := Array_Element_Table.Last (In_Tree.Array_Elements); - In_Tree.Array_Elements.Table (E2) := Elm; + E2 := Array_Element_Table.Last (Shared.Array_Elements); + Shared.Array_Elements.Table (E2) := Elm; end loop; -- Finally, store the new array - In_Tree.Arrays.Table (A2) := Arr; + Shared.Arrays.Table (A2) := Arr; end if; end loop; end Copy_Package_Declarations; @@ -499,7 +488,7 @@ package body Prj.Proc is function Expression (Project : Project_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; From_Project_Node : Project_Node_Id; From_Project_Node_Tree : Project_Node_Tree_Ref; Env : Prj.Tree.Environment; @@ -553,25 +542,25 @@ package body Prj.Proc is when List => String_Element_Table.Increment_Last - (In_Tree.String_Elements); + (Shared.String_Elements); if Last = Nil_String then -- This can happen in an expression like () & "toto" Result.Values := String_Element_Table.Last - (In_Tree.String_Elements); + (Shared.String_Elements); else - In_Tree.String_Elements.Table + Shared.String_Elements.Table (Last).Next := String_Element_Table.Last - (In_Tree.String_Elements); + (Shared.String_Elements); end if; Last := String_Element_Table.Last - (In_Tree.String_Elements); + (Shared.String_Elements); - In_Tree.String_Elements.Table (Last) := + Shared.String_Elements.Table (Last) := (Value => String_Value_Of (The_Current_Term, From_Project_Node_Tree), @@ -604,7 +593,7 @@ package body Prj.Proc is Value := Expression (Project => Project, - In_Tree => In_Tree, + Shared => Shared, From_Project_Node => From_Project_Node, From_Project_Node_Tree => From_Project_Node_Tree, Env => Env, @@ -614,26 +603,25 @@ package body Prj.Proc is (String_Node, From_Project_Node_Tree), Kind => Single); String_Element_Table.Increment_Last - (In_Tree.String_Elements); + (Shared.String_Elements); if Result.Values = Nil_String then -- This literal string list is the first term in a -- string list expression - Result.Values := - String_Element_Table.Last (In_Tree.String_Elements); + Result.Values := String_Element_Table.Last + (Shared.String_Elements); else - In_Tree.String_Elements.Table - (Last).Next := - String_Element_Table.Last (In_Tree.String_Elements); + Shared.String_Elements.Table (Last).Next := + String_Element_Table.Last (Shared.String_Elements); end if; - Last := - String_Element_Table.Last (In_Tree.String_Elements); + Last := String_Element_Table.Last + (Shared.String_Elements); - In_Tree.String_Elements.Table (Last) := + Shared.String_Elements.Table (Last) := (Value => Value.Value, Display_Value => No_Name, Location => Value.Location, @@ -654,7 +642,7 @@ package body Prj.Proc is Value := Expression (Project => Project, - In_Tree => In_Tree, + Shared => Shared, From_Project_Node => From_Project_Node, From_Project_Node_Tree => From_Project_Node_Tree, Env => Env, @@ -665,12 +653,12 @@ package body Prj.Proc is Kind => Single); String_Element_Table.Increment_Last - (In_Tree.String_Elements); - In_Tree.String_Elements.Table (Last).Next := - String_Element_Table.Last (In_Tree.String_Elements); - Last := - String_Element_Table.Last (In_Tree.String_Elements); - In_Tree.String_Elements.Table (Last) := + (Shared.String_Elements); + Shared.String_Elements.Table (Last).Next := + String_Element_Table.Last (Shared.String_Elements); + Last := String_Element_Table.Last + (Shared.String_Elements); + Shared.String_Elements.Table (Last) := (Value => Value.Value, Display_Value => No_Name, Location => Value.Location, @@ -721,11 +709,11 @@ package body Prj.Proc is The_Package := The_Project.Decl.Packages; while The_Package /= No_Package - and then In_Tree.Packages.Table - (The_Package).Name /= The_Name + and then Shared.Packages.Table (The_Package).Name /= + The_Name loop The_Package := - In_Tree.Packages.Table (The_Package).Next; + Shared.Packages.Table (The_Package).Next; end loop; pragma Assert @@ -762,22 +750,20 @@ package body Prj.Proc is N_Variable_Reference then The_Variable_Id := - In_Tree.Packages.Table + Shared.Packages.Table (The_Package).Decl.Variables; else The_Variable_Id := - In_Tree.Packages.Table + Shared.Packages.Table (The_Package).Decl.Attributes; end if; while The_Variable_Id /= No_Variable - and then - In_Tree.Variable_Elements.Table - (The_Variable_Id).Name /= The_Name + and then Shared.Variable_Elements.Table + (The_Variable_Id).Name /= The_Name loop - The_Variable_Id := - In_Tree.Variable_Elements.Table - (The_Variable_Id).Next; + The_Variable_Id := Shared.Variable_Elements.Table + (The_Variable_Id).Next; end loop; end if; @@ -795,12 +781,11 @@ package body Prj.Proc is end if; while The_Variable_Id /= No_Variable - and then - In_Tree.Variable_Elements.Table + and then Shared.Variable_Elements.Table (The_Variable_Id).Name /= The_Name loop The_Variable_Id := - In_Tree.Variable_Elements.Table + Shared.Variable_Elements.Table (The_Variable_Id).Next; end loop; @@ -810,8 +795,7 @@ package body Prj.Proc is "variable or attribute not found"); The_Variable := - In_Tree.Variable_Elements.Table - (The_Variable_Id).Value; + Shared.Variable_Elements.Table (The_Variable_Id).Value; else @@ -824,22 +808,22 @@ package body Prj.Proc is begin if The_Package /= No_Package then - The_Array := - In_Tree.Packages.Table (The_Package).Decl.Arrays; + The_Array := Shared.Packages.Table + (The_Package).Decl.Arrays; else The_Array := The_Project.Decl.Arrays; end if; while The_Array /= No_Array - and then In_Tree.Arrays.Table - (The_Array).Name /= The_Name + and then Shared.Arrays.Table (The_Array).Name /= + The_Name loop - The_Array := In_Tree.Arrays.Table (The_Array).Next; + The_Array := Shared.Arrays.Table (The_Array).Next; end loop; if The_Array /= No_Array then The_Element := - In_Tree.Arrays.Table (The_Array).Value; + Shared.Arrays.Table (The_Array).Value; Array_Index := Get_Attribute_Index (From_Project_Node_Tree, @@ -847,19 +831,19 @@ package body Prj.Proc is Index); while The_Element /= No_Array_Element - and then In_Tree.Array_Elements.Table + and then Shared.Array_Elements.Table (The_Element).Index /= Array_Index loop The_Element := - In_Tree.Array_Elements.Table + Shared.Array_Elements.Table (The_Element).Next; end loop; end if; if The_Element /= No_Array_Element then - The_Variable := - In_Tree.Array_Elements.Table (The_Element).Value; + The_Variable := Shared.Array_Elements.Table + (The_Element).Value; else if Expression_Kind_Of @@ -923,7 +907,7 @@ package body Prj.Proc is when Single => String_Element_Table.Increment_Last - (In_Tree.String_Elements); + (Shared.String_Elements); if Last = Nil_String then @@ -932,20 +916,19 @@ package body Prj.Proc is Result.Values := String_Element_Table.Last - (In_Tree.String_Elements); + (Shared.String_Elements); else - In_Tree.String_Elements.Table - (Last).Next := + Shared.String_Elements.Table (Last).Next := String_Element_Table.Last - (In_Tree.String_Elements); + (Shared.String_Elements); end if; Last := String_Element_Table.Last - (In_Tree.String_Elements); + (Shared.String_Elements); - In_Tree.String_Elements.Table (Last) := + Shared.String_Elements.Table (Last) := (Value => The_Variable.Value, Display_Value => No_Name, Location => Location_Of @@ -964,30 +947,29 @@ package body Prj.Proc is begin while The_List /= Nil_String loop String_Element_Table.Increment_Last - (In_Tree.String_Elements); + (Shared.String_Elements); if Last = Nil_String then Result.Values := String_Element_Table.Last - (In_Tree. - String_Elements); + (Shared.String_Elements); else - In_Tree. + Shared. String_Elements.Table (Last).Next := String_Element_Table.Last - (In_Tree. - String_Elements); + (Shared.String_Elements); end if; Last := String_Element_Table.Last - (In_Tree.String_Elements); + (Shared.String_Elements); - In_Tree.String_Elements.Table (Last) := + Shared.String_Elements.Table + (Last) := (Value => - In_Tree.String_Elements.Table + Shared.String_Elements.Table (The_List).Value, Display_Value => No_Name, Location => @@ -998,8 +980,7 @@ package body Prj.Proc is Next => Nil_String, Index => 0); - The_List := - In_Tree. String_Elements.Table + The_List := Shared.String_Elements.Table (The_List).Next; end loop; end; @@ -1034,7 +1015,7 @@ package body Prj.Proc is if Present (Default_Node) then Def_Var := Expression (Project => Project, - In_Tree => In_Tree, + Shared => Shared, From_Project_Node => From_Project_Node, From_Project_Node_Tree => From_Project_Node_Tree, Env => Env, @@ -1189,29 +1170,28 @@ package body Prj.Proc is when List => if not Ext_List or else Str_List /= null then String_Element_Table.Increment_Last - (In_Tree.String_Elements); + (Shared.String_Elements); if Last = Nil_String then Result.Values := String_Element_Table.Last - (In_Tree.String_Elements); + (Shared.String_Elements); else - In_Tree.String_Elements.Table (Last).Next := - String_Element_Table.Last - (In_Tree.String_Elements); + Shared.String_Elements.Table (Last).Next + := String_Element_Table.Last + (Shared.String_Elements); end if; - Last := - String_Element_Table.Last - (In_Tree.String_Elements); + Last := String_Element_Table.Last + (Shared.String_Elements); if Ext_List then for Ind in Str_List'Range loop Name_Len := 0; Add_Str_To_Name_Buffer (Str_List (Ind).all); Value := Name_Find; - In_Tree.String_Elements.Table (Last) := + Shared.String_Elements.Table (Last) := (Value => Value, Display_Value => No_Name, Location => @@ -1224,19 +1204,17 @@ package body Prj.Proc is if Ind /= Str_List'Last then String_Element_Table.Increment_Last - (In_Tree.String_Elements); - In_Tree.String_Elements.Table - (Last).Next := + (Shared.String_Elements); + Shared.String_Elements.Table (Last).Next := String_Element_Table.Last - (In_Tree.String_Elements); - Last := - String_Element_Table.Last - (In_Tree.String_Elements); + (Shared.String_Elements); + Last := String_Element_Table.Last + (Shared.String_Elements); end if; end loop; else - In_Tree.String_Elements.Table (Last) := + Shared.String_Elements.Table (Last) := (Value => Value, Display_Value => No_Name, Location => @@ -1337,7 +1315,7 @@ package body Prj.Proc is function Package_From (Project : Project_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; With_Name : Name_Id) return Package_Id is Result : Package_Id := Project.Decl.Packages; @@ -1346,9 +1324,9 @@ package body Prj.Proc is -- Check the name of each existing package of Project while Result /= No_Package - and then In_Tree.Packages.Table (Result).Name /= With_Name + and then Shared.Packages.Table (Result).Name /= With_Name loop - Result := In_Tree.Packages.Table (Result).Next; + Result := Shared.Packages.Table (Result).Next; end loop; if Result = No_Package then @@ -1412,9 +1390,11 @@ package body Prj.Proc is Env : Prj.Tree.Environment; Pkg : Package_Id; Item : Project_Node_Id; - Child_Env : in out Prj.Tree.Environment; - Can_Modify_Child_Env : Boolean) + Child_Env : in out Prj.Tree.Environment) is + Shared : constant Shared_Project_Tree_Data_Access := + In_Tree.Shared; + procedure Check_Or_Set_Typed_Variable (Value : in out Variable_Value; Declaration : Project_Node_Id); @@ -1532,11 +1512,11 @@ package body Prj.Proc is -- Create the new package - Package_Table.Increment_Last (In_Tree.Packages); + Package_Table.Increment_Last (Shared.Packages); declare New_Pkg : constant Package_Id := - Package_Table.Last (In_Tree.Packages); + Package_Table.Last (Shared.Packages); The_New_Package : Package_Element; Project_Of_Renamed_Package : constant Project_Node_Id := @@ -1552,15 +1532,15 @@ package body Prj.Proc is if Pkg /= No_Package then The_New_Package.Next := - In_Tree.Packages.Table (Pkg).Decl.Packages; - In_Tree.Packages.Table (Pkg).Decl.Packages := New_Pkg; + Shared.Packages.Table (Pkg).Decl.Packages; + Shared.Packages.Table (Pkg).Decl.Packages := New_Pkg; else The_New_Package.Next := Project.Decl.Packages; Project.Decl.Packages := New_Pkg; end if; - In_Tree.Packages.Table (New_Pkg) := The_New_Package; + Shared.Packages.Table (New_Pkg) := The_New_Package; if Present (Project_Of_Renamed_Package) then @@ -1576,7 +1556,7 @@ package body Prj.Proc is Renamed_Package : constant Package_Id := Package_From - (Renamed_Project, In_Tree, + (Renamed_Project, Shared, Name_Of (Current_Item, Node_Tree)); begin @@ -1586,11 +1566,11 @@ package body Prj.Proc is -- declaration. Copy_Package_Declarations - (From => In_Tree.Packages.Table (Renamed_Package).Decl, - To => In_Tree.Packages.Table (New_Pkg).Decl, + (From => Shared.Packages.Table (Renamed_Package).Decl, + To => Shared.Packages.Table (New_Pkg).Decl, New_Loc => Location_Of (Current_Item, Node_Tree), Restricted => False, - In_Tree => In_Tree); + Shared => Shared); end; else @@ -1600,8 +1580,8 @@ package body Prj.Proc is (Project, Project.Name, Name_Id (Project.Directory.Name), - In_Tree, - In_Tree.Packages.Table (New_Pkg).Decl, + Shared, + Shared.Packages.Table (New_Pkg).Decl, First_Attribute_Of (Package_Id_Of (Current_Item, Node_Tree)), Project_Level => False); @@ -1619,8 +1599,7 @@ package body Prj.Proc is Pkg => New_Pkg, Item => First_Declarative_Item_Of (Current_Item, Node_Tree), - Child_Env => Child_Env, - Can_Modify_Child_Env => Can_Modify_Child_Env); + Child_Env => Child_Env); end; end if; end Process_Package_Declaration; @@ -1683,35 +1662,35 @@ package body Prj.Proc is -- declared. if Pkg /= No_Package then - New_Array := In_Tree.Packages.Table (Pkg).Decl.Arrays; + New_Array := Shared.Packages.Table (Pkg).Decl.Arrays; else New_Array := Project.Decl.Arrays; end if; while New_Array /= No_Array - and then In_Tree.Arrays.Table (New_Array).Name /= Current_Item_Name + and then Shared.Arrays.Table (New_Array).Name /= Current_Item_Name loop - New_Array := In_Tree.Arrays.Table (New_Array).Next; + New_Array := Shared.Arrays.Table (New_Array).Next; end loop; -- If the attribute has never been declared add new entry in the -- arrays of the project/package and link it. if New_Array = No_Array then - Array_Table.Increment_Last (In_Tree.Arrays); - New_Array := Array_Table.Last (In_Tree.Arrays); + Array_Table.Increment_Last (Shared.Arrays); + New_Array := Array_Table.Last (Shared.Arrays); if Pkg /= No_Package then - In_Tree.Arrays.Table (New_Array) := + Shared.Arrays.Table (New_Array) := (Name => Current_Item_Name, Location => Current_Location, Value => No_Array_Element, - Next => In_Tree.Packages.Table (Pkg).Decl.Arrays); + Next => Shared.Packages.Table (Pkg).Decl.Arrays); - In_Tree.Packages.Table (Pkg).Decl.Arrays := New_Array; + Shared.Packages.Table (Pkg).Decl.Arrays := New_Array; else - In_Tree.Arrays.Table (New_Array) := + Shared.Arrays.Table (New_Array) := (Name => Current_Item_Name, Location => Current_Location, Value => No_Array_Element, @@ -1753,23 +1732,23 @@ package body Prj.Proc is pragma Assert (Orig_Package /= No_Package, "original package not found"); - while In_Tree.Packages.Table - (Orig_Package).Name /= Orig_Package_Name + while Shared.Packages.Table + (Orig_Package).Name /= Orig_Package_Name loop - Orig_Package := In_Tree.Packages.Table (Orig_Package).Next; + Orig_Package := Shared.Packages.Table (Orig_Package).Next; pragma Assert (Orig_Package /= No_Package, "original package not found"); end loop; - Orig_Array := In_Tree.Packages.Table (Orig_Package).Decl.Arrays; + Orig_Array := Shared.Packages.Table (Orig_Package).Decl.Arrays; end if; -- Now look for the array while Orig_Array /= No_Array - and then In_Tree.Arrays.Table (Orig_Array).Name /= Current_Item_Name + and then Shared.Arrays.Table (Orig_Array).Name /= Current_Item_Name loop - Orig_Array := In_Tree.Arrays.Table (Orig_Array).Next; + Orig_Array := Shared.Arrays.Table (Orig_Array).Next; end loop; if Orig_Array = No_Array then @@ -1780,7 +1759,7 @@ package body Prj.Proc is Project); else - Orig_Element := In_Tree.Arrays.Table (Orig_Array).Value; + Orig_Element := Shared.Arrays.Table (Orig_Array).Value; -- Copy each array element @@ -1793,22 +1772,22 @@ package body Prj.Proc is -- And there is no array element declared yet, create a new -- first array element. - if In_Tree.Arrays.Table (New_Array).Value = + if Shared.Arrays.Table (New_Array).Value = No_Array_Element then Array_Element_Table.Increment_Last - (In_Tree.Array_Elements); + (Shared.Array_Elements); New_Element := Array_Element_Table.Last - (In_Tree.Array_Elements); - In_Tree.Arrays.Table (New_Array).Value := New_Element; + (Shared.Array_Elements); + Shared.Arrays.Table (New_Array).Value := New_Element; Next_Element := No_Array_Element; -- Otherwise, the new element is the first else - New_Element := In_Tree.Arrays. Table (New_Array).Value; + New_Element := Shared.Arrays.Table (New_Array).Value; Next_Element := - In_Tree.Array_Elements.Table (New_Element).Next; + Shared.Array_Elements.Table (New_Element).Next; end if; -- Otherwise, reuse an existing element, or create @@ -1816,33 +1795,33 @@ package body Prj.Proc is else Next_Element := - In_Tree.Array_Elements.Table (Prev_Element).Next; + Shared.Array_Elements.Table (Prev_Element).Next; if Next_Element = No_Array_Element then Array_Element_Table.Increment_Last - (In_Tree.Array_Elements); - New_Element := - Array_Element_Table.Last (In_Tree.Array_Elements); - In_Tree.Array_Elements.Table (Prev_Element).Next := + (Shared.Array_Elements); + New_Element := Array_Element_Table.Last + (Shared.Array_Elements); + Shared.Array_Elements.Table (Prev_Element).Next := New_Element; else New_Element := Next_Element; Next_Element := - In_Tree.Array_Elements.Table (New_Element).Next; + Shared.Array_Elements.Table (New_Element).Next; end if; end if; -- Copy the value of the element - In_Tree.Array_Elements.Table (New_Element) := - In_Tree.Array_Elements.Table (Orig_Element); - In_Tree.Array_Elements.Table (New_Element).Value.Project := - Project; + Shared.Array_Elements.Table (New_Element) := + Shared.Array_Elements.Table (Orig_Element); + Shared.Array_Elements.Table (New_Element).Value.Project + := Project; -- Adjust the Next link - In_Tree.Array_Elements.Table (New_Element).Next := Next_Element; + Shared.Array_Elements.Table (New_Element).Next := Next_Element; -- Adjust the previous id for the next element @@ -1850,15 +1829,13 @@ package body Prj.Proc is -- Go to the next element in the original array - Orig_Element := - In_Tree.Array_Elements.Table (Orig_Element).Next; + Orig_Element := Shared.Array_Elements.Table (Orig_Element).Next; end loop; -- Make sure that the array ends here, in case there previously a -- greater number of elements. - In_Tree.Array_Elements.Table (New_Element).Next := - No_Array_Element; + Shared.Array_Elements.Table (New_Element).Next := No_Array_Element; end if; end Process_Associative_Array; @@ -1891,15 +1868,15 @@ package body Prj.Proc is -- Look for the array in the appropriate list if Pkg /= No_Package then - The_Array := In_Tree.Packages.Table (Pkg).Decl.Arrays; + The_Array := Shared.Packages.Table (Pkg).Decl.Arrays; else The_Array := Project.Decl.Arrays; end if; while The_Array /= No_Array - and then In_Tree.Arrays.Table (The_Array).Name /= Name + and then Shared.Arrays.Table (The_Array).Name /= Name loop - The_Array := In_Tree.Arrays.Table (The_Array).Next; + The_Array := Shared.Arrays.Table (The_Array).Next; end loop; -- If the array cannot be found, create a new entry in the list. @@ -1907,20 +1884,20 @@ package body Prj.Proc is -- element will be created automatically later if The_Array = No_Array then - Array_Table.Increment_Last (In_Tree.Arrays); - The_Array := Array_Table.Last (In_Tree.Arrays); + Array_Table.Increment_Last (Shared.Arrays); + The_Array := Array_Table.Last (Shared.Arrays); if Pkg /= No_Package then - In_Tree.Arrays.Table (The_Array) := + Shared.Arrays.Table (The_Array) := (Name => Name, Location => Current_Location, Value => No_Array_Element, - Next => In_Tree.Packages.Table (Pkg).Decl.Arrays); + Next => Shared.Packages.Table (Pkg).Decl.Arrays); - In_Tree.Packages.Table (Pkg).Decl.Arrays := The_Array; + Shared.Packages.Table (Pkg).Decl.Arrays := The_Array; else - In_Tree.Arrays.Table (The_Array) := + Shared.Arrays.Table (The_Array) := (Name => Name, Location => Current_Location, Value => No_Array_Element, @@ -1930,7 +1907,7 @@ package body Prj.Proc is end if; else - Elem := In_Tree.Arrays.Table (The_Array).Value; + Elem := Shared.Arrays.Table (The_Array).Value; end if; -- Look in the list, if any, to find an element with the same index @@ -1938,11 +1915,11 @@ package body Prj.Proc is while Elem /= No_Array_Element and then - (In_Tree.Array_Elements.Table (Elem).Index /= Index_Name + (Shared.Array_Elements.Table (Elem).Index /= Index_Name or else - In_Tree.Array_Elements.Table (Elem).Src_Index /= Source_Index) + Shared.Array_Elements.Table (Elem).Src_Index /= Source_Index) loop - Elem := In_Tree.Array_Elements.Table (Elem).Next; + Elem := Shared.Array_Elements.Table (Elem).Next; end loop; -- If no such element were found, create a new one @@ -1950,29 +1927,29 @@ package body Prj.Proc is -- proper value. if Elem = No_Array_Element then - Array_Element_Table.Increment_Last (In_Tree.Array_Elements); - Elem := Array_Element_Table.Last (In_Tree.Array_Elements); + Array_Element_Table.Increment_Last (Shared.Array_Elements); + Elem := Array_Element_Table.Last (Shared.Array_Elements); - In_Tree.Array_Elements.Table + Shared.Array_Elements.Table (Elem) := (Index => Index_Name, Src_Index => Source_Index, Index_Case_Sensitive => not Case_Insensitive (Current, Node_Tree), Value => New_Value, - Next => In_Tree.Arrays.Table (The_Array).Value); + Next => Shared.Arrays.Table (The_Array).Value); - In_Tree.Arrays.Table (The_Array).Value := Elem; + Shared.Arrays.Table (The_Array).Value := Elem; else -- An element with the same index already exists, just replace its -- value with the new one. - In_Tree.Array_Elements.Table (Elem).Value := New_Value; + Shared.Array_Elements.Table (Elem).Value := New_Value; end if; if Name = Snames.Name_External then - if Can_Modify_Child_Env then + if In_Tree.Is_Root_Tree then Add (Child_Env.External, External_Name => Get_Name_String (Index_Name), Value => Get_Name_String (New_Value.Value), @@ -2015,14 +1992,14 @@ package body Prj.Proc is if Is_Attribute then if Pkg /= No_Package then - Var := In_Tree.Packages.Table (Pkg).Decl.Attributes; + Var := Shared.Packages.Table (Pkg).Decl.Attributes; else Var := Project.Decl.Attributes; end if; else if Pkg /= No_Package then - Var := In_Tree.Packages.Table (Pkg).Decl.Variables; + Var := Shared.Packages.Table (Pkg).Decl.Variables; else Var := Project.Decl.Variables; end if; @@ -2031,9 +2008,9 @@ package body Prj.Proc is -- Loop through the list, to find if it has already been declared. while Var /= No_Variable - and then In_Tree.Variable_Elements.Table (Var).Name /= Name + and then Shared.Variable_Elements.Table (Var).Name /= Name loop - Var := In_Tree.Variable_Elements.Table (Var).Next; + Var := Shared.Variable_Elements.Table (Var).Next; end loop; -- If it has not been declared, create a new entry in the list @@ -2047,20 +2024,20 @@ package body Prj.Proc is (not Is_Attribute, "illegal attribute declaration for " & Get_Name_String (Name)); - Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements); - Var := Variable_Element_Table.Last (In_Tree.Variable_Elements); + Variable_Element_Table.Increment_Last (Shared.Variable_Elements); + Var := Variable_Element_Table.Last (Shared.Variable_Elements); -- Put the new variable in the appropriate list if Pkg /= No_Package then - In_Tree.Variable_Elements.Table (Var) := - (Next => In_Tree.Packages.Table (Pkg).Decl.Variables, + Shared.Variable_Elements.Table (Var) := + (Next => Shared.Packages.Table (Pkg).Decl.Variables, Name => Name, Value => New_Value); - In_Tree.Packages.Table (Pkg).Decl.Variables := Var; + Shared.Packages.Table (Pkg).Decl.Variables := Var; else - In_Tree.Variable_Elements.Table (Var) := + Shared.Variable_Elements.Table (Var) := (Next => Project.Decl.Variables, Name => Name, Value => New_Value); @@ -2071,7 +2048,7 @@ package body Prj.Proc is -- change the value. else - In_Tree.Variable_Elements.Table (Var).Value := New_Value; + Shared.Variable_Elements.Table (Var).Value := New_Value; end if; end Process_Expression_Variable_Decl; @@ -2083,7 +2060,7 @@ package body Prj.Proc is New_Value : Variable_Value := Expression (Project => Project, - In_Tree => In_Tree, + Shared => Shared, From_Project_Node => From_Project_Node, From_Project_Node_Tree => Node_Tree, Env => Env, @@ -2173,7 +2150,7 @@ package body Prj.Proc is Name := Name_Of (Package_Node_Of (Variable_Node, Node_Tree), Node_Tree); - The_Package := Package_From (The_Project, In_Tree, Name); + The_Package := Package_From (The_Project, Shared, Name); end if; Name := Name_Of (Variable_Node, Node_Tree); @@ -2183,11 +2160,11 @@ package body Prj.Proc is if The_Package /= No_Package then Name := Name_Of (Variable_Node, Node_Tree); - Var_Id := In_Tree.Packages.Table (The_Package).Decl.Variables; + Var_Id := Shared.Packages.Table (The_Package).Decl.Variables; while Var_Id /= No_Variable - and then In_Tree.Variable_Elements.Table (Var_Id).Name /= Name + and then Shared.Variable_Elements.Table (Var_Id).Name /= Name loop - Var_Id := In_Tree.Variable_Elements.Table (Var_Id).Next; + Var_Id := Shared.Variable_Elements.Table (Var_Id).Next; end loop; end if; @@ -2199,9 +2176,9 @@ package body Prj.Proc is then Var_Id := The_Project.Decl.Variables; while Var_Id /= No_Variable - and then In_Tree.Variable_Elements.Table (Var_Id).Name /= Name + and then Shared.Variable_Elements.Table (Var_Id).Name /= Name loop - Var_Id := In_Tree.Variable_Elements.Table (Var_Id).Next; + Var_Id := Shared.Variable_Elements.Table (Var_Id).Next; end loop; end if; @@ -2217,7 +2194,7 @@ package body Prj.Proc is -- Get the case variable - The_Variable := In_Tree.Variable_Elements. Table (Var_Id).Value; + The_Variable := Shared.Variable_Elements. Table (Var_Id).Value; if The_Variable.Kind /= Single then @@ -2270,15 +2247,14 @@ package body Prj.Proc is if Present (Decl_Item) then Process_Declarative_Items - (Project => Project, - In_Tree => In_Tree, - From_Project_Node => From_Project_Node, - Node_Tree => Node_Tree, - Env => Env, - Pkg => Pkg, - Item => Decl_Item, - Child_Env => Child_Env, - Can_Modify_Child_Env => Can_Modify_Child_Env); + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + Node_Tree => Node_Tree, + Env => Env, + Pkg => Pkg, + Item => Decl_Item, + Child_Env => Child_Env); end if; end Process_Case_Construction; @@ -2333,8 +2309,6 @@ package body Prj.Proc is Env : in out Prj.Tree.Environment; Reset_Tree : Boolean := True) is - Child_Env : Prj.Tree.Environment; - begin if Reset_Tree then @@ -2350,19 +2324,13 @@ package body Prj.Proc is Debug_Increase_Indent ("Process tree, phase 1"); - Initialize_And_Copy (Child_Env, Copy_From => Env); - Recursive_Process (Project => Project, In_Tree => In_Tree, From_Project_Node => From_Project_Node, From_Project_Node_Tree => From_Project_Node_Tree, Env => Env, - Extended_By => No_Project, - Child_Env => Child_Env, - Is_Root_Project => True); - - Free (Child_Env); + Extended_By => No_Project); Success := Total_Errors_Detected = 0 @@ -2397,7 +2365,7 @@ package body Prj.Proc is begin Success := True; - Debug_Increase_Indent ("Process tree, phase 2"); + Debug_Increase_Indent ("Process tree, phase 2", Project.Name); if Project /= No_Project then Check (In_Tree, Project, From_Project_Node_Tree, Env.Flags); @@ -2498,10 +2466,15 @@ package body Prj.Proc is From_Project_Node : Project_Node_Id; From_Project_Node_Tree : Project_Node_Tree_Ref; Env : in out Prj.Tree.Environment; - Extended_By : Project_Id; - Child_Env : in out Prj.Tree.Environment; - Is_Root_Project : Boolean) + Extended_By : Project_Id) is + Shared : constant Shared_Project_Tree_Data_Access := + In_Tree.Shared; + + Child_Env : Prj.Tree.Environment; + -- Only used for the root aggregate project (if any). This is left + -- uninitialized otherwise. + procedure Process_Imported_Projects (Imported : in out Project_List; Limited_With : Boolean); @@ -2553,9 +2526,7 @@ package body Prj.Proc is (With_Clause, From_Project_Node_Tree), From_Project_Node_Tree => From_Project_Node_Tree, Env => Env, - Extended_By => No_Project, - Child_Env => Child_Env, - Is_Root_Project => False); + Extended_By => No_Project); -- Imported is the id of the last imported project. If -- it is nil, then this imported project is our first. @@ -2585,7 +2556,7 @@ package body Prj.Proc is procedure Process_Aggregated_Projects is List : Aggregated_Project_List; - Loaded_Tree : Prj.Tree.Project_Node_Id; + Loaded_Project : Prj.Tree.Project_Node_Id; Success : Boolean := True; begin if Project.Qualifier /= Aggregate then @@ -2604,25 +2575,46 @@ package body Prj.Proc is while Success and then List /= null loop Prj.Part.Parse (In_Tree => From_Project_Node_Tree, - Project => Loaded_Tree, + Project => Loaded_Project, Project_File_Name => Get_Name_String (List.Path), Errout_Handling => Prj.Part.Never_Finalize, Current_Directory => Get_Name_String (Project.Directory.Name), Is_Config_File => False, Env => Child_Env); - Success := not Prj.Tree.No (Loaded_Tree); + Success := not Prj.Tree.No (Loaded_Project); if Success then - Recursive_Process - (In_Tree => In_Tree, - Project => List.Project, - From_Project_Node => Loaded_Tree, - From_Project_Node_Tree => From_Project_Node_Tree, - Env => Child_Env, - Extended_By => No_Project, - Child_Env => Child_Env, - Is_Root_Project => False); + List.Tree := new Project_Tree_Data (Is_Root_Tree => False); + Prj.Initialize (List.Tree); + List.Tree.Shared := In_Tree.Shared; + + -- We can only do the phase 1 of the processing, since we do + -- not have access to the configuration file yet (this is + -- called when doing phase 1 of the processing for the root + -- aggregate project). + + if In_Tree.Is_Root_Tree then + Process_Project_Tree_Phase_1 + (In_Tree => List.Tree, + Project => List.Project, + Success => Success, + From_Project_Node => Loaded_Project, + From_Project_Node_Tree => From_Project_Node_Tree, + Env => Child_Env, + Reset_Tree => False); + else + -- use the same environment as the rest of the aggregated + -- projects, ie the one that was setup by the root aggregate + Process_Project_Tree_Phase_1 + (In_Tree => List.Tree, + Project => List.Project, + Success => Success, + From_Project_Node => Loaded_Project, + From_Project_Node_Tree => From_Project_Node_Tree, + Env => Env, + Reset_Tree => False); + end if; else Debug_Output ("Failed to parse", Name_Id (List.Path)); end if; @@ -2650,21 +2642,20 @@ package body Prj.Proc is begin Extended_Pkg := Project.Extends.Decl.Packages; while Extended_Pkg /= No_Package loop - Element := In_Tree.Packages.Table (Extended_Pkg); + Element := Shared.Packages.Table (Extended_Pkg); Current_Pkg := First; while Current_Pkg /= No_Package - and then In_Tree.Packages.Table (Current_Pkg).Name /= + and then Shared.Packages.Table (Current_Pkg).Name /= Element.Name loop - Current_Pkg := - In_Tree.Packages.Table (Current_Pkg).Next; + Current_Pkg := Shared.Packages.Table (Current_Pkg).Next; end loop; if Current_Pkg = No_Package then - Package_Table.Increment_Last (In_Tree.Packages); - Current_Pkg := Package_Table.Last (In_Tree.Packages); - In_Tree.Packages.Table (Current_Pkg) := + Package_Table.Increment_Last (Shared.Packages); + Current_Pkg := Package_Table.Last (Shared.Packages); + Shared.Packages.Table (Current_Pkg) := (Name => Element.Name, Decl => No_Declarations, Parent => No_Package, @@ -2672,10 +2663,10 @@ package body Prj.Proc is Project.Decl.Packages := Current_Pkg; Copy_Package_Declarations (From => Element.Decl, - To => In_Tree.Packages.Table (Current_Pkg).Decl, + To => Shared.Packages.Table (Current_Pkg).Decl, New_Loc => No_Location, Restricted => True, - In_Tree => In_Tree); + Shared => Shared); end if; Extended_Pkg := Element.Next; @@ -2685,7 +2676,7 @@ package body Prj.Proc is Attribute1 := Project.Decl.Attributes; while Attribute1 /= No_Variable loop - Attr_Value1 := In_Tree.Variable_Elements. Table (Attribute1); + Attr_Value1 := Shared.Variable_Elements. Table (Attribute1); exit when Attr_Value1.Name = Snames.Name_Languages; Attribute1 := Attr_Value1.Next; end loop; @@ -2698,7 +2689,7 @@ package body Prj.Proc is Attribute2 := Project.Extends.Decl.Attributes; while Attribute2 /= No_Variable loop - Attr_Value2 := In_Tree.Variable_Elements.Table (Attribute2); + Attr_Value2 := Shared.Variable_Elements.Table (Attribute2); exit when Attr_Value2.Name = Snames.Name_Languages; Attribute2 := Attr_Value2.Next; end loop; @@ -2711,17 +2702,16 @@ package body Prj.Proc is if Attribute1 = No_Variable then Variable_Element_Table.Increment_Last - (In_Tree.Variable_Elements); + (Shared.Variable_Elements); Attribute1 := Variable_Element_Table.Last - (In_Tree.Variable_Elements); + (Shared.Variable_Elements); Attr_Value1.Next := Project.Decl.Attributes; Project.Decl.Attributes := Attribute1; end if; Attr_Value1.Name := Snames.Name_Languages; Attr_Value1.Value := Attr_Value2.Value; - In_Tree.Variable_Elements.Table - (Attribute1) := Attr_Value1; + Shared.Variable_Elements.Table (Attribute1) := Attr_Value1; end if; end if; end Process_Extended_Project; @@ -2806,13 +2796,24 @@ package body Prj.Proc is (Project, Name, Name_Id (Project.Directory.Name), - In_Tree, + In_Tree.Shared, Project.Decl, Prj.Attr.Attribute_First, Project_Level => True); Process_Imported_Projects (Imported, Limited_With => False); + if Project.Qualifier = Aggregate + and then In_Tree.Is_Root_Tree + then + Initialize_And_Copy (Child_Env, Copy_From => Env); + else + -- No need to initialize Child_Env, since it will not be + -- used anyway by Process_Declarative_Items (only the root + -- aggregate can modify it, and it is never read anyway). + null; + end if; + Declaration_Node := Project_Declaration_Of (From_Project_Node, From_Project_Node_Tree); @@ -2824,9 +2825,7 @@ package body Prj.Proc is (Declaration_Node, From_Project_Node_Tree), From_Project_Node_Tree => From_Project_Node_Tree, Env => Env, - Extended_By => Project, - Child_Env => Child_Env, - Is_Root_Project => False); + Extended_By => Project); Process_Declarative_Items (Project => Project, @@ -2837,8 +2836,7 @@ package body Prj.Proc is Pkg => No_Package, Item => First_Declarative_Item_Of (Declaration_Node, From_Project_Node_Tree), - Child_Env => Child_Env, - Can_Modify_Child_Env => Is_Root_Project); + Child_Env => Child_Env); if Project.Extends /= No_Project then Process_Extended_Project; @@ -2849,6 +2847,12 @@ package body Prj.Proc is if Err_Vars.Total_Errors_Detected = 0 then Process_Aggregated_Projects; end if; + + if Project.Qualifier = Aggregate + and then In_Tree.Is_Root_Tree + then + Free (Child_Env); + end if; end; end if; end Recursive_Process; diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads index 4610fdfc99b..f7fb7ad1411 100644 --- a/gcc/ada/prj-proc.ads +++ b/gcc/ada/prj-proc.ads @@ -72,7 +72,7 @@ package Prj.Proc is From_Project_Node : Project_Node_Id; From_Project_Node_Tree : Project_Node_Tree_Ref; Env : in out Prj.Tree.Environment; - Reset_Tree : Boolean := True); + Reset_Tree : Boolean := True); -- Performs the two phases of the processing end Prj.Proc; diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb index 494b04c482e..42f08ab3a64 100644 --- a/gcc/ada/prj-util.adb +++ b/gcc/ada/prj-util.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- -- @@ -129,7 +129,7 @@ package body Prj.Util is procedure Duplicate (This : in out Name_List_Index; - In_Tree : Project_Tree_Ref) + Shared : Shared_Project_Tree_Data_Access) is Old_Current : Name_List_Index; New_Current : Name_List_Index; @@ -137,20 +137,20 @@ package body Prj.Util is begin if This /= No_Name_List then Old_Current := This; - Name_List_Table.Increment_Last (In_Tree.Name_Lists); - New_Current := Name_List_Table.Last (In_Tree.Name_Lists); + Name_List_Table.Increment_Last (Shared.Name_Lists); + New_Current := Name_List_Table.Last (Shared.Name_Lists); This := New_Current; - In_Tree.Name_Lists.Table (New_Current) := - (In_Tree.Name_Lists.Table (Old_Current).Name, No_Name_List); + Shared.Name_Lists.Table (New_Current) := + (Shared.Name_Lists.Table (Old_Current).Name, No_Name_List); loop - Old_Current := In_Tree.Name_Lists.Table (Old_Current).Next; + Old_Current := Shared.Name_Lists.Table (Old_Current).Next; exit when Old_Current = No_Name_List; - In_Tree.Name_Lists.Table (New_Current).Next := New_Current + 1; - Name_List_Table.Increment_Last (In_Tree.Name_Lists); + Shared.Name_Lists.Table (New_Current).Next := New_Current + 1; + Name_List_Table.Increment_Last (Shared.Name_Lists); New_Current := New_Current + 1; - In_Tree.Name_Lists.Table (New_Current) := - (In_Tree.Name_Lists.Table (Old_Current).Name, No_Name_List); + Shared.Name_Lists.Table (New_Current) := + (Shared.Name_Lists.Table (Old_Current).Name, No_Name_List); end loop; end if; end Duplicate; @@ -174,7 +174,7 @@ package body Prj.Util is function Executable_Of (Project : Project_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; Main : File_Name_Type; Index : Int; Ada_Main : Boolean := True; @@ -189,7 +189,7 @@ package body Prj.Util is Prj.Util.Value_Of (Name => Name_Builder, In_Packages => The_Packages, - In_Tree => In_Tree); + Shared => Shared); Executable : Variable_Value := Prj.Util.Value_Of @@ -197,7 +197,7 @@ package body Prj.Util is Index => Index, Attribute_Or_Array_Name => Name_Executable, In_Package => Builder_Package, - In_Tree => In_Tree); + Shared => Shared); Lang : Language_Ptr; @@ -266,8 +266,8 @@ package body Prj.Util is Prj.Util.Value_Of (Variable_Name => Name_Executable_Suffix, In_Variables => - In_Tree.Packages.Table (Builder_Package).Decl.Attributes, - In_Tree => In_Tree); + Shared.Packages.Table (Builder_Package).Decl.Attributes, + Shared => Shared); if Suffix_From_Project /= Nil_Variable_Value and then Suffix_From_Project.Value /= No_Name @@ -340,7 +340,7 @@ package body Prj.Util is Index => 0, Attribute_Or_Array_Name => Name_Executable, In_Package => Builder_Package, - In_Tree => In_Tree); + Shared => Shared); end if; end; end if; @@ -554,24 +554,26 @@ package body Prj.Util is In_Tree : Project_Tree_Ref; Lower_Case : Boolean := False) is + Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared; + Current_Name : Name_List_Index; List : String_List_Id; Element : String_Element; Last : Name_List_Index := - Name_List_Table.Last (In_Tree.Name_Lists); + Name_List_Table.Last (Shared.Name_Lists); Value : Name_Id; begin Current_Name := Into_List; while Current_Name /= No_Name_List - and then In_Tree.Name_Lists.Table (Current_Name).Next /= No_Name_List + and then Shared.Name_Lists.Table (Current_Name).Next /= No_Name_List loop - Current_Name := In_Tree.Name_Lists.Table (Current_Name).Next; + Current_Name := Shared.Name_Lists.Table (Current_Name).Next; end loop; List := From_List; while List /= Nil_String loop - Element := In_Tree.String_Elements.Table (List); + Element := Shared.String_Elements.Table (List); Value := Element.Value; if Lower_Case then @@ -581,15 +583,14 @@ package body Prj.Util is end if; Name_List_Table.Append - (In_Tree.Name_Lists, (Name => Value, Next => No_Name_List)); + (Shared.Name_Lists, (Name => Value, Next => No_Name_List)); Last := Last + 1; if Current_Name = No_Name_List then Into_List := Last; - else - In_Tree.Name_Lists.Table (Current_Name).Next := Last; + Shared.Name_Lists.Table (Current_Name).Next := Last; end if; Current_Name := Last; @@ -808,8 +809,9 @@ package body Prj.Util is function Value_Of (Index : Name_Id; In_Array : Array_Element_Id; - In_Tree : Project_Tree_Ref) return Name_Id + Shared : Shared_Project_Tree_Data_Access) return Name_Id is + Current : Array_Element_Id; Element : Array_Element; Real_Index : Name_Id := Index; @@ -821,7 +823,7 @@ package body Prj.Util is return No_Name; end if; - Element := In_Tree.Array_Elements.Table (Current); + Element := Shared.Array_Elements.Table (Current); if not Element.Index_Case_Sensitive then Get_Name_String (Index); @@ -830,7 +832,7 @@ package body Prj.Util is end if; while Current /= No_Array_Element loop - Element := In_Tree.Array_Elements.Table (Current); + Element := Shared.Array_Elements.Table (Current); if Real_Index = Element.Index then exit when Element.Value.Kind /= Single; @@ -848,7 +850,7 @@ package body Prj.Util is (Index : Name_Id; Src_Index : Int := 0; In_Array : Array_Element_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; Force_Lower_Case_Index : Boolean := False; Allow_Wildcards : Boolean := False) return Variable_Value is @@ -864,7 +866,7 @@ package body Prj.Util is return Nil_Variable_Value; end if; - Element := In_Tree.Array_Elements.Table (Current); + Element := Shared.Array_Elements.Table (Current); Real_Index_1 := Index; @@ -877,7 +879,7 @@ package body Prj.Util is end if; while Current /= No_Array_Element loop - Element := In_Tree.Array_Elements.Table (Current); + Element := Shared.Array_Elements.Table (Current); Real_Index_2 := Element.Index; if not Element.Index_Case_Sensitive @@ -912,7 +914,7 @@ package body Prj.Util is Index : Int := 0; Attribute_Or_Array_Name : Name_Id; In_Package : Package_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; Force_Lower_Case_Index : Boolean := False; Allow_Wildcards : Boolean := False) return Variable_Value is @@ -927,14 +929,14 @@ package body Prj.Util is The_Array := Value_Of (Name => Attribute_Or_Array_Name, - In_Arrays => In_Tree.Packages.Table (In_Package).Decl.Arrays, - In_Tree => In_Tree); + In_Arrays => Shared.Packages.Table (In_Package).Decl.Arrays, + Shared => Shared); The_Attribute := Value_Of (Index => Name, Src_Index => Index, In_Array => The_Array, - In_Tree => In_Tree, + Shared => Shared, Force_Lower_Case_Index => Force_Lower_Case_Index, Allow_Wildcards => Allow_Wildcards); @@ -944,9 +946,9 @@ package body Prj.Util is The_Attribute := Value_Of (Variable_Name => Attribute_Or_Array_Name, - In_Variables => In_Tree.Packages.Table - (In_Package).Decl.Attributes, - In_Tree => In_Tree); + In_Variables => Shared.Packages.Table + (In_Package).Decl.Attributes, + Shared => Shared); end if; end if; @@ -957,7 +959,7 @@ package body Prj.Util is (Index : Name_Id; In_Array : Name_Id; In_Arrays : Array_Id; - In_Tree : Project_Tree_Ref) return Name_Id + Shared : Shared_Project_Tree_Data_Access) return Name_Id is Current : Array_Id; The_Array : Array_Data; @@ -965,10 +967,10 @@ package body Prj.Util is begin Current := In_Arrays; while Current /= No_Array loop - The_Array := In_Tree.Arrays.Table (Current); + The_Array := Shared.Arrays.Table (Current); if The_Array.Name = In_Array then return Value_Of - (Index, In_Array => The_Array.Value, In_Tree => In_Tree); + (Index, In_Array => The_Array.Value, Shared => Shared); else Current := The_Array.Next; end if; @@ -980,7 +982,7 @@ package body Prj.Util is function Value_Of (Name : Name_Id; In_Arrays : Array_Id; - In_Tree : Project_Tree_Ref) return Array_Element_Id + Shared : Shared_Project_Tree_Data_Access) return Array_Element_Id is Current : Array_Id; The_Array : Array_Data; @@ -988,7 +990,7 @@ package body Prj.Util is begin Current := In_Arrays; while Current /= No_Array loop - The_Array := In_Tree.Arrays.Table (Current); + The_Array := Shared.Arrays.Table (Current); if The_Array.Name = Name then return The_Array.Value; @@ -1003,7 +1005,7 @@ package body Prj.Util is function Value_Of (Name : Name_Id; In_Packages : Package_Id; - In_Tree : Project_Tree_Ref) return Package_Id + Shared : Shared_Project_Tree_Data_Access) return Package_Id is Current : Package_Id; The_Package : Package_Element; @@ -1011,7 +1013,7 @@ package body Prj.Util is begin Current := In_Packages; while Current /= No_Package loop - The_Package := In_Tree.Packages.Table (Current); + The_Package := Shared.Packages.Table (Current); exit when The_Package.Name /= No_Name and then The_Package.Name = Name; Current := The_Package.Next; @@ -1023,7 +1025,7 @@ package body Prj.Util is function Value_Of (Variable_Name : Name_Id; In_Variables : Variable_Id; - In_Tree : Project_Tree_Ref) return Variable_Value + Shared : Shared_Project_Tree_Data_Access) return Variable_Value is Current : Variable_Id; The_Variable : Variable; @@ -1031,8 +1033,7 @@ package body Prj.Util is begin Current := In_Variables; while Current /= No_Variable loop - The_Variable := - In_Tree.Variable_Elements.Table (Current); + The_Variable := Shared.Variable_Elements.Table (Current); if Variable_Name = The_Variable.Name then return The_Variable.Value; diff --git a/gcc/ada/prj-util.ads b/gcc/ada/prj-util.ads index 741dc7f048d..7c94a3c8572 100644 --- a/gcc/ada/prj-util.ads +++ b/gcc/ada/prj-util.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- -- @@ -29,7 +29,7 @@ package Prj.Util is function Executable_Of (Project : Project_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; Main : File_Name_Type; Index : Int; Ada_Main : Boolean := True; @@ -61,7 +61,7 @@ package Prj.Util is procedure Duplicate (This : in out Name_List_Index; - In_Tree : Project_Tree_Ref); + Shared : Shared_Project_Tree_Data_Access); -- Duplicate a name list function Value_Of @@ -73,7 +73,7 @@ package Prj.Util is function Value_Of (Index : Name_Id; In_Array : Array_Element_Id; - In_Tree : Project_Tree_Ref) return Name_Id; + Shared : Shared_Project_Tree_Data_Access) return Name_Id; -- Get a single string array component. Returns No_Name if there is no -- component Index, if In_Array is null, or if the component is a String -- list. Depending on the attribute (only attributes may be associative @@ -85,7 +85,7 @@ package Prj.Util is (Index : Name_Id; Src_Index : Int := 0; In_Array : Array_Element_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; Force_Lower_Case_Index : Boolean := False; Allow_Wildcards : Boolean := False) return Variable_Value; -- Get a string array component (single String or String list). Returns @@ -101,7 +101,7 @@ package Prj.Util is Index : Int := 0; Attribute_Or_Array_Name : Name_Id; In_Package : Package_Id; - In_Tree : Project_Tree_Ref; + Shared : Shared_Project_Tree_Data_Access; Force_Lower_Case_Index : Boolean := False; Allow_Wildcards : Boolean := False) return Variable_Value; -- In a specific package: @@ -117,7 +117,7 @@ package Prj.Util is (Index : Name_Id; In_Array : Name_Id; In_Arrays : Array_Id; - In_Tree : Project_Tree_Ref) return Name_Id; + Shared : Shared_Project_Tree_Data_Access) return Name_Id; -- Get a string array component in an array of an array list. Returns -- No_Name if there is no component Index, if In_Arrays is null, if -- In_Array is not found in In_Arrays or if the component is a String list. @@ -125,7 +125,7 @@ package Prj.Util is function Value_Of (Name : Name_Id; In_Arrays : Array_Id; - In_Tree : Project_Tree_Ref) return Array_Element_Id; + Shared : Shared_Project_Tree_Data_Access) return Array_Element_Id; -- Returns a specified array in an array list. Returns No_Array_Element -- if In_Arrays is null or if Name is not the name of an array in -- In_Arrays. The caller must ensure that Name is in lower case. @@ -133,7 +133,7 @@ package Prj.Util is function Value_Of (Name : Name_Id; In_Packages : Package_Id; - In_Tree : Project_Tree_Ref) return Package_Id; + Shared : Shared_Project_Tree_Data_Access) return Package_Id; -- Returns a specified package in a package list. Returns No_Package -- if In_Packages is null or if Name is not the name of a package in -- Package_List. The caller must ensure that Name is in lower case. @@ -141,7 +141,7 @@ package Prj.Util is function Value_Of (Variable_Name : Name_Id; In_Variables : Variable_Id; - In_Tree : Project_Tree_Ref) return Variable_Value; + Shared : Shared_Project_Tree_Data_Access) return Variable_Value; -- Returns a specified variable in a variable list. Returns null if -- In_Variables is null or if Variable_Name is not the name of a -- variable in In_Variables. Caller must ensure that Name is lower case. diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index cc5733555a6..58160e61d48 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -404,6 +404,7 @@ package body Prj is procedure For_Every_Project_Imported (By : Project_Id; + Tree : Project_Tree_Ref; With_State : in out State; Include_Aggregated : Boolean := True; Imported_First : Boolean := False) @@ -411,7 +412,8 @@ package body Prj is use Project_Boolean_Htable; Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil; - procedure Recursive_Check (Project : Project_Id); + procedure Recursive_Check + (Project : Project_Id; Tree : Project_Tree_Ref); -- Check if a project has already been seen. If not seen, mark it as -- Seen, Call Action, and check all its imported projects. @@ -419,29 +421,34 @@ package body Prj is -- Recursive_Check -- --------------------- - procedure Recursive_Check (Project : Project_Id) is + procedure Recursive_Check + (Project : Project_Id; Tree : Project_Tree_Ref) + is List : Project_List; Agg : Aggregated_Project_List; begin if not Get (Seen, Project) then + -- Even if a project is aggregated multiple times, we will only + -- return it once. + Set (Seen, Project, True); if not Imported_First then - Action (Project, With_State); + Action (Project, Tree, With_State); end if; -- Visit all extended projects if Project.Extends /= No_Project then - Recursive_Check (Project.Extends); + Recursive_Check (Project.Extends, Tree); end if; -- Visit all imported projects List := Project.Imported_Projects; while List /= null loop - Recursive_Check (List.Project); + Recursive_Check (List.Project, Tree); List := List.Next; end loop; @@ -453,13 +460,13 @@ package body Prj is Agg := Project.Aggregated_Projects; while Agg /= null loop pragma Assert (Agg.Project /= No_Project); - Recursive_Check (Agg.Project); + Recursive_Check (Agg.Project, Agg.Tree); Agg := Agg.Next; end loop; end if; if Imported_First then - Action (Project, With_State); + Action (Project, Tree, With_State); end if; end if; end Recursive_Check; @@ -467,7 +474,7 @@ package body Prj is -- Start of processing for For_Every_Project_Imported begin - Recursive_Check (Project => By); + Recursive_Check (Project => By, Tree => Tree); Reset (Seen); end For_Every_Project_Imported; @@ -484,18 +491,25 @@ package body Prj is is Result : Source_Id := No_Source; - procedure Look_For_Sources (Proj : Project_Id; Src : in out Source_Id); + procedure Look_For_Sources + (Proj : Project_Id; + Tree : Project_Tree_Ref; + Src : in out Source_Id); -- Look for Base_Name in the sources of Proj ---------------------- -- Look_For_Sources -- ---------------------- - procedure Look_For_Sources (Proj : Project_Id; Src : in out Source_Id) is + procedure Look_For_Sources + (Proj : Project_Id; + Tree : Project_Tree_Ref; + Src : in out Source_Id) + is Iterator : Source_Iterator; begin - Iterator := For_Each_Source (In_Tree => In_Tree, Project => Proj); + Iterator := For_Each_Source (In_Tree => Tree, Project => Proj); while Element (Iterator) /= No_Source loop if Element (Iterator).File = Base_Name then Src := Element (Iterator); @@ -517,22 +531,23 @@ package body Prj is if In_Extended_Only then Proj := Project; while Proj /= No_Project loop - Look_For_Sources (Proj, Result); + Look_For_Sources (Proj, In_Tree, Result); exit when Result /= No_Source; Proj := Proj.Extends; end loop; elsif In_Imported_Only then - Look_For_Sources (Project, Result); + Look_For_Sources (Project, In_Tree, Result); if Result = No_Source then For_Imported_Projects (By => Project, + Tree => In_Tree, With_State => Result); end if; else - Look_For_Sources (No_Project, Result); + Look_For_Sources (No_Project, In_Tree, Result); end if; return Result; @@ -604,12 +619,9 @@ package body Prj is Prj.Attr.Initialize; - Set_Name_Table_Byte - (Name_Project, Token_Type'Pos (Tok_Project)); - Set_Name_Table_Byte - (Name_Extends, Token_Type'Pos (Tok_Extends)); - Set_Name_Table_Byte - (Name_External, Token_Type'Pos (Tok_External)); + Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project)); + Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends)); + Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External)); Set_Name_Table_Byte (Name_External_As_List, Token_Type'Pos (Tok_External_As_List)); end if; @@ -716,6 +728,9 @@ package body Prj is begin while List /= null loop Tmp := List.Next; + + Free (List.Tree); + Unchecked_Free (List); List := Tmp; end loop; @@ -731,6 +746,7 @@ package body Prj is Project.Aggregated_Projects := new Aggregated_Project' (Path => Path, Project => No_Project, + Tree => null, Next => Project.Aggregated_Projects); end Add_Aggregated_Project; @@ -888,13 +904,16 @@ package body Prj is begin if Tree /= null then - Name_List_Table.Free (Tree.Name_Lists); - Number_List_Table.Free (Tree.Number_Lists); - String_Element_Table.Free (Tree.String_Elements); - Variable_Element_Table.Free (Tree.Variable_Elements); - Array_Element_Table.Free (Tree.Array_Elements); - Array_Table.Free (Tree.Arrays); - Package_Table.Free (Tree.Packages); + if Tree.Is_Root_Tree then + Name_List_Table.Free (Tree.Shared.Name_Lists); + Number_List_Table.Free (Tree.Shared.Number_Lists); + String_Element_Table.Free (Tree.Shared.String_Elements); + Variable_Element_Table.Free (Tree.Shared.Variable_Elements); + Array_Element_Table.Free (Tree.Shared.Array_Elements); + Array_Table.Free (Tree.Shared.Arrays); + Package_Table.Free (Tree.Shared.Packages); + end if; + Source_Paths_Htable.Reset (Tree.Source_Paths_HT); Source_Files_Htable.Reset (Tree.Source_Files_HT); @@ -917,13 +936,21 @@ package body Prj is begin -- Visible tables - Name_List_Table.Init (Tree.Name_Lists); - Number_List_Table.Init (Tree.Number_Lists); - String_Element_Table.Init (Tree.String_Elements); - Variable_Element_Table.Init (Tree.Variable_Elements); - Array_Element_Table.Init (Tree.Array_Elements); - Array_Table.Init (Tree.Arrays); - Package_Table.Init (Tree.Packages); + if Tree.Is_Root_Tree then + -- We cannot use 'Access here: + -- "illegal attribute for discriminant-dependent component" + -- However, we know this is valid since Shared and Shared_Data have + -- the same lifetime and will always exist concurrently. + Tree.Shared := Tree.Shared_Data'Unrestricted_Access; + Name_List_Table.Init (Tree.Shared.Name_Lists); + Number_List_Table.Init (Tree.Shared.Number_Lists); + String_Element_Table.Init (Tree.Shared.String_Elements); + Variable_Element_Table.Init (Tree.Shared.Variable_Elements); + Array_Element_Table.Init (Tree.Shared.Array_Elements); + Array_Table.Init (Tree.Shared.Arrays); + Package_Table.Init (Tree.Shared.Packages); + end if; + Source_Paths_Htable.Reset (Tree.Source_Paths_HT); Source_Files_Htable.Reset (Tree.Source_Files_HT); Replaced_Source_HTable.Reset (Tree.Replaced_Sources); @@ -1110,7 +1137,10 @@ package body Prj is procedure Compute_All_Imported_Projects (Tree : Project_Tree_Ref) is Project : Project_Id; - procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean); + procedure Recursive_Add + (Prj : Project_Id; + Tree : Project_Tree_Ref; + Dummy : in out Boolean); -- Recursively add the projects imported by project Project, but not -- those that are extended. @@ -1118,8 +1148,12 @@ package body Prj is -- Recursive_Add -- ------------------- - procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean) is - pragma Unreferenced (Dummy); + procedure Recursive_Add + (Prj : Project_Id; + Tree : Project_Tree_Ref; + Dummy : in out Boolean) + is + pragma Unreferenced (Dummy, Tree); List : Project_List; Prj2 : Project_Id; @@ -1163,7 +1197,7 @@ package body Prj is while List /= null loop Project := List.Project; Free_List (Project.All_Imported_Projects, Free_Project => False); - For_All_Projects (Project, Dummy); + For_All_Projects (Project, Tree, Dummy, Include_Aggregated => False); List := List.Next; end loop; end Compute_All_Imported_Projects; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 1e60bdc6f8b..9928bd3b205 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -1094,6 +1094,7 @@ package Prj is type Aggregated_Project_List is access all Aggregated_Project; type Aggregated_Project is record Path : Path_Name_Type; + Tree : Project_Tree_Ref; Project : Project_Id; Next : Aggregated_Project_List; end record; @@ -1400,41 +1401,68 @@ package Prj is type Private_Project_Tree_Data is private; -- Data for a project tree that is used only by the Project Manager - type Project_Tree_Data is - record - Name_Lists : Name_List_Table.Instance; - Number_Lists : Number_List_Table.Instance; - String_Elements : String_Element_Table.Instance; - Variable_Elements : Variable_Element_Table.Instance; - Array_Elements : Array_Element_Table.Instance; - Arrays : Array_Table.Instance; - Packages : Package_Table.Instance; - Projects : Project_List; + type Shared_Project_Tree_Data is record + Name_Lists : Name_List_Table.Instance; + Number_Lists : Number_List_Table.Instance; + String_Elements : String_Element_Table.Instance; + Variable_Elements : Variable_Element_Table.Instance; + Array_Elements : Array_Element_Table.Instance; + Arrays : Array_Table.Instance; + Packages : Package_Table.Instance; + end record; + type Shared_Project_Tree_Data_Access is access all Shared_Project_Tree_Data; + -- The data that is shared among multiple trees, when these trees are + -- loaded through the same aggregate project. + -- To avoid ambiguities, limit the number of parameters to the + -- subprograms (we would have to parse the "root project tree" since this + -- is where the configuration file was loaded, in addition to the project's + -- own tree) and make the comparison of projects easier, all trees store + -- the lists in the same tables. + + type Project_Tree_Data (Is_Root_Tree : Boolean := True) is record + -- The root tree is the one loaded by the user from the command line. + -- Is_Root_Tree is only false for projects aggregated within a root + -- aggregate project. + + Projects : Project_List; + -- List of projects in this tree + + Replaced_Sources : Replaced_Source_HTable.Instance; + -- The list of sources that have been replaced by sources with + -- different file names. + + Replaced_Source_Number : Natural := 0; + -- The number of entries in Replaced_Sources - Replaced_Sources : Replaced_Source_HTable.Instance; - -- The list of sources that have been replaced by sources with - -- different file names. + Units_HT : Units_Htable.Instance; + -- Unit name to Unit_Index (and from there to Source_Id) - Replaced_Source_Number : Natural := 0; - -- The number of entries in Replaced_Sources + Source_Files_HT : Source_Files_Htable.Instance; + -- Base source file names to Source_Id list. - Units_HT : Units_Htable.Instance; - -- Unit name to Unit_Index (and from there to Source_Id) + Source_Paths_HT : Source_Paths_Htable.Instance; + -- Full path to Source_Id - Source_Files_HT : Source_Files_Htable.Instance; - -- Base source file names to Source_Id list. + Source_Info_File_Name : String_Access := null; + -- The name of the source info file, if specified by the builder - Source_Paths_HT : Source_Paths_Htable.Instance; - -- Full path to Source_Id + Source_Info_File_Exists : Boolean := False; + -- True when a source info file has been successfully read - Source_Info_File_Name : String_Access := null; - -- The name of the source info file, if specified by the builder + Private_Part : Private_Project_Tree_Data; - Source_Info_File_Exists : Boolean := False; - -- True when a source info file has been successfully read + Shared : Shared_Project_Tree_Data_Access; + -- The shared data for this tree and all aggregated trees. - Private_Part : Private_Project_Tree_Data; - end record; + case Is_Root_Tree is + when True => + Shared_Data : aliased Shared_Project_Tree_Data; + -- Do not access directly, only through Shared. + + when False => + null; + end case; + end record; -- Data for a project tree procedure Expect (The_Token : Token_Type; Token_Image : String); @@ -1463,9 +1491,11 @@ package Prj is type State is limited private; with procedure Action (Project : Project_Id; + Tree : Project_Tree_Ref; With_State : in out State); procedure For_Every_Project_Imported (By : Project_Id; + Tree : Project_Tree_Ref; With_State : in out State; Include_Aggregated : Boolean := True; Imported_First : Boolean := False); @@ -1488,6 +1518,9 @@ package Prj is -- If Include_Aggregated is True, then an aggregate project will recurse -- into the projects it aggregates. Otherwise, the latter are never -- returned + -- + -- The Tree argument passed to the callback is required in the case of + -- aggregated projects, since they might not be using the same tree as 'By' function Extend_Name (File : File_Name_Type;