From e2fee30d5490aac27479b1908f8cd8efe13b6189 Mon Sep 17 00:00:00 2001 From: Emmanuel Briot Date: Thu, 4 Aug 2011 12:28:58 +0000 Subject: [PATCH] make.adb, [...] (Compute_Builder_Switches): now shared with gprbuild. 2011-08-04 Emmanuel Briot * make.adb, makeutl.adb, makeutl.ads (Compute_Builder_Switches): now shared with gprbuild. From-SVN: r177372 --- gcc/ada/ChangeLog | 5 + gcc/ada/make.adb | 259 +++++----------------------------- gcc/ada/makeutl.adb | 330 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/makeutl.ads | 27 ++++ 4 files changed, 399 insertions(+), 222 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 98548d94828..655feddda7d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2011-08-04 Emmanuel Briot + + * make.adb, makeutl.adb, makeutl.ads (Compute_Builder_Switches): now + shared with gprbuild. + 2011-08-04 Yannick Moy * par-ch4.adb (P_Primary): preferentially issue an error message about diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 93f607125ce..d450648e8a6 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -596,15 +596,6 @@ package body Make is procedure Process_Multilib (Env : in out Prj.Tree.Environment); -- Add appropriate --RTS argument to handle multilib - procedure Compute_Builder_Switches - (Project_Node_Tree : Project_Node_Tree_Ref; - Root_Environment : in out Prj.Tree.Environment; - Main_Unit_File_Name : String; - Main_Index : Int := 0); - -- Analyze the root project to find the builder switches and the global - -- compilation switches (the latter are ignored if there were multiple main - -- on the command line. - procedure Resolve_Relative_Names_In_Switches (Current_Work_Dir : String); -- Resolve all relative paths found in the linker and binder switches, -- when using project files. @@ -4991,214 +4982,6 @@ package body Make is end if; end Compilation_Phase; - ------------------------------ - -- Compute_Builder_Switches -- - ------------------------------ - - procedure Compute_Builder_Switches - (Project_Node_Tree : Project_Node_Tree_Ref; - Root_Environment : in out Prj.Tree.Environment; - Main_Unit_File_Name : String; - Main_Index : Int := 0) - is - Builder_Package : constant Prj.Package_Id := - Prj.Util.Value_Of - (Name => Name_Builder, - In_Packages => Main_Project.Decl.Packages, - Shared => Project_Tree.Shared); - - Global_Compilation_Array : Array_Element_Id; - Global_Compilation_Elem : Array_Element; - Global_Compilation_Switches : Variable_Value; - - Default_Switches_Array : Array_Id; - - begin - -- If there is a package Builder in the main project file, add - -- the switches from it. - - if Builder_Package /= No_Package then - Global_Compilation_Array := Prj.Util.Value_Of - (Name => Name_Global_Compilation_Switches, - In_Arrays => Project_Tree.Shared.Packages.Table - (Builder_Package).Decl.Arrays, - Shared => Project_Tree.Shared); - - Default_Switches_Array := - Project_Tree.Shared.Packages.Table (Builder_Package).Decl.Arrays; - - while Default_Switches_Array /= No_Array - and then - Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Name /= - Name_Default_Switches - loop - Default_Switches_Array := - Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Next; - end loop; - - if Global_Compilation_Array /= No_Array_Element and then - Default_Switches_Array /= No_Array - then - Errutil.Error_Msg - ("Default_Switches forbidden in presence of " & - "Global_Compilation_Switches. Use Switches instead.", - Project_Tree.Shared.Arrays.Table - (Default_Switches_Array).Location); - Make_Failed ("*** illegal combination of Builder attributes"); - end if; - - -- If there is only one main, we attempt to get the gnatmake switches - -- for this main (if any). If there are no specific switch for this - -- particular main, get the general gnatmake switches (if any). - - if Osint.Number_Of_Files = 1 then - if Verbose_Mode then - Write_Str ("Adding gnatmake switches for """); - Write_Str (Main_Unit_File_Name); - Write_Line ("""."); - end if; - - Add_Switches - (Project_Node_Tree => Project_Node_Tree, - Env => Root_Environment, - File_Name => Main_Unit_File_Name, - Index => Main_Index, - The_Package => Builder_Package, - Program => None, - Unknown_Switches_To_The_Compiler => - Global_Compilation_Array = No_Array_Element); - - else - -- If there are several mains, we always get the general gnatmake - -- switches (if any). - - -- Warn the user, if necessary, so that he is not surprised that - -- specific switches are not taken into account. - - declare - Defaults : constant Variable_Value := - Prj.Util.Value_Of - (Name => Name_Ada, - Index => 0, - Attribute_Or_Array_Name => Name_Default_Switches, - In_Package => Builder_Package, - Shared => Project_Tree.Shared); - - Switches : constant Array_Element_Id := - Prj.Util.Value_Of - (Name => Name_Switches, - In_Arrays => Project_Tree.Shared.Packages.Table - (Builder_Package).Decl.Arrays, - Shared => Project_Tree.Shared); - - Other_Switches : constant Variable_Value := - Prj.Util.Value_Of - (Name => All_Other_Names, - Index => 0, - Attribute_Or_Array_Name => Name_Switches, - In_Package => Builder_Package, - 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.Shared.Array_Elements.Table - (Switches).Next /= No_Array_Element - then - Write_Line - ("Warning: using Builder'Switches(others), " - & "as there are several mains"); - end if; - - Add_Switches - (Project_Node_Tree => Project_Node_Tree, - Env => Root_Environment, - File_Name => " ", - Index => 0, - The_Package => Builder_Package, - Program => None, - Unknown_Switches_To_The_Compiler => False); - - elsif Defaults /= Nil_Variable_Value then - if not Quiet_Output - and then Switches /= No_Array_Element - then - Write_Line - ("Warning: using Builder'Default_Switches" - & "(""Ada""), as there are several mains"); - end if; - - Add_Switches - (Project_Node_Tree => Project_Node_Tree, - Env => Root_Environment, - File_Name => " ", - Index => 0, - The_Package => Builder_Package, - Program => None); - - elsif not Quiet_Output - and then Switches /= No_Array_Element - then - Write_Line - ("Warning: using no switches from package " - & "Builder, as there are several mains"); - end if; - end; - end if; - - -- Take into account attribute Global_Compilation_Switches - -- ("Ada"). - - declare - Index : Name_Id; - List : String_List_Id; - Elem : String_Element; - - begin - while Global_Compilation_Array /= No_Array_Element loop - Global_Compilation_Elem := - Project_Tree.Shared.Array_Elements.Table - (Global_Compilation_Array); - - Get_Name_String (Global_Compilation_Elem.Index); - To_Lower (Name_Buffer (1 .. Name_Len)); - Index := Name_Find; - - if Index = Name_Ada then - Global_Compilation_Switches := Global_Compilation_Elem.Value; - - if Global_Compilation_Switches /= Nil_Variable_Value - and then not Global_Compilation_Switches.Default - then - -- We have found attribute Global_Compilation_Switches - -- ("Ada"): put the switches in the appropriate table. - - List := Global_Compilation_Switches.Values; - while List /= Nil_String loop - Elem := - Project_Tree.Shared.String_Elements.Table (List); - - if Elem.Value /= No_Name then - Add_Switch - (Get_Name_String (Elem.Value), - Compiler, - And_Save => False); - end if; - - List := Elem.Next; - end loop; - - exit; - end if; - end if; - - Global_Compilation_Array := Global_Compilation_Elem.Next; - end loop; - end; - end if; - end Compute_Builder_Switches; - ---------------------------------------- -- Resolve_Relative_Names_In_Switches -- ---------------------------------------- @@ -5429,6 +5212,38 @@ package body Make is Compute_Builder : Boolean; Current_Work_Dir : String) is + function Add_Global_Switches + (Switch : String; + For_Lang : Name_Id; + For_Builder : Boolean; + Has_Global_Compilation_Switches : Boolean) return Boolean; + -- Handles builder and global compilation switches, as read from the + -- project file. + + function Add_Global_Switches + (Switch : String; + For_Lang : Name_Id; + For_Builder : Boolean; + Has_Global_Compilation_Switches : Boolean) return Boolean + is + pragma Unreferenced (For_Lang); + begin + if For_Builder then + Program_Args := None; + Switch_May_Be_Passed_To_The_Compiler := + not Has_Global_Compilation_Switches; + Scan_Make_Arg (Root_Environment, Switch, And_Save => False); + + return Gnatmake_Switch_Found + or else Switch_May_Be_Passed_To_The_Compiler; + else + Add_Switch (Switch, Compiler, And_Save => False); + return True; + end if; + end Add_Global_Switches; + + procedure Do_Compute_Builder_Switches + is new Makeutl.Compute_Builder_Switches (Add_Global_Switches); begin if Main_Project /= No_Project then declare @@ -5496,11 +5311,11 @@ package body Make is end; if Compute_Builder then - Compute_Builder_Switches - (Project_Node_Tree => Project_Node_Tree, - Root_Environment => Root_Environment, - Main_Unit_File_Name => Main_Unit_File_Name, - Main_Index => Main_Index); + Do_Compute_Builder_Switches + (Project_Tree => Project_Tree, + Root_Environment => Root_Environment, + Main_Project => Main_Project, + Only_For_Lang => Name_Ada); Resolve_Relative_Names_In_Switches (Current_Work_Dir => Current_Work_Dir); diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index ee8f0043e7d..95fab066435 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -2894,4 +2894,334 @@ package body Makeutl is Compute_All (Root_Project, Tree); end Compute_Compilation_Phases; + ------------------------------ + -- Compute_Builder_Switches -- + ------------------------------ + + procedure Compute_Builder_Switches + (Project_Tree : Project_Tree_Ref; + Root_Environment : in out Prj.Tree.Environment; + Main_Project : Project_Id; + Only_For_Lang : Name_Id := No_Name) + is + Builder_Package : constant Package_Id := + Value_Of (Name_Builder, Main_Project.Decl.Packages, + Project_Tree.Shared); + + Global_Compilation_Array : Array_Element_Id; + Global_Compilation_Elem : Array_Element; + Global_Compilation_Switches : Variable_Value; + + Default_Switches_Array : Array_Id; + + Builder_Switches_Lang : Name_Id := No_Name; + + List : String_List_Id; + Element : String_Element; + + Index : Name_Id; + Source : Prj.Source_Id; + + Lang : Name_Id := No_Name; -- language index for Switches + Switches_For_Lang : Variable_Value := Nil_Variable_Value; + -- Value of Builder'Default_Switches(lang) + + Name : Name_Id := No_Name; -- main file index for Switches + Switches_For_Main : Variable_Value := Nil_Variable_Value; + -- Switches for a specific main. When there are several mains, Name is + -- set to No_Name, and Switches_For_Main might be left with an actual + -- value (so that we can display a warning that it was ignored). + + Other_Switches : Variable_Value := Nil_Variable_Value; + -- Value of Builder'Switches(others) + + Defaults : Variable_Value := Nil_Variable_Value; + + Switches : Variable_Value := Nil_Variable_Value; + -- The computed builder switches + + Success : Boolean := False; + begin + if Builder_Package /= No_Package then + Mains.Reset; + + -- If there is no main, and there is only one compilable language, + -- use this language as the switches index. + + if Mains.Number_Of_Mains (Project_Tree) = 0 then + + if Only_For_Lang = No_Name then + declare + Language : Language_Ptr := Main_Project.Languages; + + begin + while Language /= No_Language_Index loop + if Language.Config.Compiler_Driver /= No_File + and then Language.Config.Compiler_Driver /= Empty_File + then + if Lang /= No_Name then + Lang := No_Name; + exit; + else + Lang := Language.Name; + end if; + end if; + Language := Language.Next; + end loop; + end; + else + Lang := Only_For_Lang; + end if; + + else + for Index in 1 .. Mains.Number_Of_Mains (Project_Tree) loop + Source := Mains.Next_Main.Source; + if Source /= No_Source then + + if Switches_For_Main = Nil_Variable_Value then + Switches_For_Main := Value_Of + (Name => Name_Id (Source.File), + Attribute_Or_Array_Name => Name_Switches, + In_Package => Builder_Package, + Shared => Project_Tree.Shared, + Force_Lower_Case_Index => False, + Allow_Wildcards => True); + + -- If not found, try without extension ??? + -- That's because gnatmake accepts unit names in Switches + + if Switches_For_Main = Nil_Variable_Value + and then Source.Unit /= null + then + Switches_For_Main := Value_Of + (Name => Source.Unit.Name, + Attribute_Or_Array_Name => Name_Switches, + In_Package => Builder_Package, + Shared => Project_Tree.Shared, + Force_Lower_Case_Index => False, + Allow_Wildcards => True); + end if; + end if; + + if Index = 1 then + Lang := Source.Language.Name; + Name := Name_Id (Source.File); + else + Name := No_Name; -- Can't use main specific switches + + if Lang /= Source.Language.Name then + Lang := No_Name; + end if; + end if; + end if; + end loop; + end if; + + Global_Compilation_Array := Value_Of + (Name => Name_Global_Compilation_Switches, + In_Arrays => Project_Tree.Shared.Packages.Table + (Builder_Package).Decl.Arrays, + Shared => Project_Tree.Shared); + + Default_Switches_Array := + Project_Tree.Shared.Packages.Table (Builder_Package).Decl.Arrays; + + while Default_Switches_Array /= No_Array and then + Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Name /= + Name_Default_Switches + loop + Default_Switches_Array := + Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Next; + end loop; + + if Global_Compilation_Array /= No_Array_Element + and then Default_Switches_Array /= No_Array + then + Prj.Err.Error_Msg + (Root_Environment.Flags, + "Default_Switches forbidden in presence of " & + "Global_Compilation_Switches. Use Switches instead.", + Project_Tree.Shared.Arrays.Table + (Default_Switches_Array).Location); + Fail_Program + (Project_Tree, + "*** illegal combination of Builder attributes"); + end if; + + if Lang /= No_Name then + Switches_For_Lang := Prj.Util.Value_Of + (Name => Lang, + Index => 0, + Attribute_Or_Array_Name => Name_Switches, + In_Package => Builder_Package, + Shared => Project_Tree.Shared, + Force_Lower_Case_Index => True); + + Defaults := Prj.Util.Value_Of + (Name => Lang, + Index => 0, + Attribute_Or_Array_Name => Name_Default_Switches, + In_Package => Builder_Package, + Shared => Project_Tree.Shared, + Force_Lower_Case_Index => True); + end if; + + Other_Switches := Prj.Util.Value_Of + (Name => All_Other_Names, + Index => 0, + Attribute_Or_Array_Name => Name_Switches, + In_Package => Builder_Package, + Shared => Project_Tree.Shared); + + if not Quiet_Output + and then Mains.Number_Of_Mains (Project_Tree) > 1 + and then Switches_For_Main /= Nil_Variable_Value + then + -- More than one main, but we had main-specific switches that + -- are ignored. + + if Switches_For_Lang /= Nil_Variable_Value then + Write_Line + ("Warning: using Builder'Default_Switches" + & "(""" & Get_Name_String (Lang) + & """), as there are several mains"); + + elsif Other_Switches /= Nil_Variable_Value then + Write_Line + ("Warning: using Builder'Switches(others), " + & "as there are several mains"); + + elsif Defaults /= Nil_Variable_Value then + Write_Line + ("Warning: using Builder'Default_Switches(""" + & Get_Name_String (Lang) + & """), as there are several mains"); + else + Write_Line + ("Warning: using no switches from package " + & "Builder, as there are several mains"); + end if; + end if; + + Builder_Switches_Lang := Lang; + + if Name /= No_Name then + -- Get the switches for the single main + Switches := Switches_For_Main; + end if; + + if Switches = Nil_Variable_Value or else Switches.Default then + -- Get the switches for the common language of the mains + Switches := Switches_For_Lang; + end if; + + if Switches = Nil_Variable_Value or else Switches.Default then + Switches := Other_Switches; + end if; + + -- For backward compatibility with gnatmake, if no Switches + -- are declared, check for Default_Switches (). + + if Switches = Nil_Variable_Value or else Switches.Default then + Switches := Defaults; + end if; + + -- If switches have been found, scan them + + if Switches /= Nil_Variable_Value and then not Switches.Default then + List := Switches.Values; + + while List /= Nil_String loop + Element := Project_Tree.Shared.String_Elements.Table (List); + Get_Name_String (Element.Value); + + if Name_Len /= 0 then + declare + -- Add_Switch might itself be using the name_buffer, so + -- we make a temporary here. + Switch : constant String := + Name_Buffer (1 .. Name_Len); + begin + Success := Add_Switch + (Switch => Switch, + For_Lang => Builder_Switches_Lang, + For_Builder => True, + Has_Global_Compilation_Switches => + Global_Compilation_Array /= No_Array_Element); + end; + + if not Success then + for J in reverse 1 .. Name_Len loop + Name_Buffer (J + J) := Name_Buffer (J); + Name_Buffer (J + J - 1) := '''; + end loop; + + Name_Len := Name_Len + Name_Len; + + Prj.Err.Error_Msg + (Root_Environment.Flags, + '"' & Name_Buffer (1 .. Name_Len) & + """ is not a builder switch. Consider moving " & + "it to Global_Compilation_Switches.", + Element.Location); + Fail_Program + (Project_Tree, + "*** illegal switch """ & + Get_Name_String (Element.Value) & '"'); + end if; + end if; + + List := Element.Next; + end loop; + end if; + + -- Reset the Builder Switches language + + Builder_Switches_Lang := No_Name; + + -- Take into account attributes Global_Compilation_Switches + + while Global_Compilation_Array /= No_Array_Element loop + Global_Compilation_Elem := + Project_Tree.Shared.Array_Elements.Table + (Global_Compilation_Array); + + Get_Name_String (Global_Compilation_Elem.Index); + To_Lower (Name_Buffer (1 .. Name_Len)); + Index := Name_Find; + + if Only_For_Lang = No_Name or else Index = Only_For_Lang then + Global_Compilation_Switches := Global_Compilation_Elem.Value; + + if Global_Compilation_Switches /= Nil_Variable_Value + and then not Global_Compilation_Switches.Default + then + -- We have found an attribute + -- Global_Compilation_Switches for a language: put the + -- switches in the appropriate table. + + List := Global_Compilation_Switches.Values; + while List /= Nil_String loop + Element := + Project_Tree.Shared.String_Elements.Table (List); + + if Element.Value /= No_Name then + Success := Add_Switch + (Switch => Get_Name_String (Element.Value), + For_Lang => Index, + For_Builder => False, + Has_Global_Compilation_Switches => + Global_Compilation_Array /= No_Array_Element); + end if; + + List := Element.Next; + end loop; + end if; + end if; + + Global_Compilation_Array := Global_Compilation_Elem.Next; + end loop; + end if; + end Compute_Builder_Switches; + end Makeutl; diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 91e0769d4fc..f3ac998b6ae 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -233,6 +233,33 @@ package Makeutl is -- Terminate program, with or without a message, setting the status code -- according to Fatal. This properly removes all temporary files. + -------------- + -- Switches -- + -------------- + + generic + with function Add_Switch + (Switch : String; + For_Lang : Name_Id; + For_Builder : Boolean; + Has_Global_Compilation_Switches : Boolean) return Boolean; + -- For_Builder is true if we have a builder switch + -- This function should return True in case of success (the switch is + -- valid), False otherwise. The error message will be displayed by + -- Compute_Builder_Switches itself. + -- Has_Global_Compilation_Switches is True if the attribute + -- Global_Compilation_Switches is defined in the project. + + procedure Compute_Builder_Switches + (Project_Tree : Project_Tree_Ref; + Root_Environment : in out Prj.Tree.Environment; + Main_Project : Project_Id; + Only_For_Lang : Name_Id := No_Name); + -- Compute the builder switches and global compilation switches. + -- Every time a switch is found in the project, it is passed to Add_Switch. + -- You can provide a value for Only_For_Lang so that we only look for + -- this language when parsing the global compilation switches. + ----------------------- -- Project_Tree data -- ----------------------- -- 2.30.2