From c1db334ed53827be855c6e573bde2af301bcf596 Mon Sep 17 00:00:00 2001 From: Jerome Lambourg Date: Tue, 5 Aug 2008 10:16:44 +0200 Subject: [PATCH] g-comlin.adb (Sort_Sections, [...]): New/Modified internal methods needed to handle switch sections when... 2008-08-05 Jerome Lambourg * g-comlin.adb (Sort_Sections, Group_Switches): New/Modified internal methods needed to handle switch sections when building a command line. (Define_Section, Add_Switch, Remove_Switch, Is_New_Section, Current_Section): New public methods or methods modified to handle building command lines with sections. (Set_Command_Line): Take into account sections when analysing a switch string. (Start): Sort the switches by sections before iterating the command line elements. * g-comlin.ads (Define_Section, Add_Switch, Remove_Switch, Is_New_Section, Current_Section): New methods or methods modified to handle building command lines with sections. From-SVN: r138670 --- gcc/ada/g-comlin.adb | 333 +++++++++++++++++++++++++++++++++++++++++++++------ gcc/ada/g-comlin.ads | 44 ++++++- 2 files changed, 333 insertions(+), 44 deletions(-) diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb index 32460c0..a3faf53 100644 --- a/gcc/ada/g-comlin.adb +++ b/gcc/ada/g-comlin.adb @@ -120,10 +120,18 @@ package body GNAT.Command_Line is -- ungrouping common prefixes when possible), and call Callback for each of -- these. + procedure Sort_Sections + (Line : GNAT.OS_Lib.Argument_List_Access; + Sections : GNAT.OS_Lib.Argument_List_Access; + Params : GNAT.OS_Lib.Argument_List_Access); + -- Reorder the command line switches so that the switches belonging to a + -- section are grouped together. + procedure Group_Switches - (Cmd : Command_Line; - Result : Argument_List_Access; - Params : Argument_List_Access); + (Cmd : Command_Line; + Result : Argument_List_Access; + Sections : Argument_List_Access; + Params : Argument_List_Access); -- Group switches with common prefixes whenever possible. -- Once they have been grouped, we also check items for possible aliasing @@ -1081,6 +1089,22 @@ package body GNAT.Command_Line is Append (Config.Prefixes, new String'(Prefix)); end Define_Prefix; + -------------------- + -- Define_Section -- + -------------------- + + procedure Define_Section + (Config : in out Command_Line_Configuration; + Section : String) + is + begin + if Config = null then + Config := new Command_Line_Configuration_Record; + end if; + + Append (Config.Sections, new String'(Section)); + end Define_Section; + ----------------------- -- Set_Configuration -- ----------------------- @@ -1113,9 +1137,34 @@ package body GNAT.Command_Line is Getopt_Description : String := ""; Switch_Char : Character := '-') is - Tmp : Argument_List_Access; - Parser : Opt_Parser; - S : Character; + Tmp : Argument_List_Access; + Parser : Opt_Parser; + S : Character; + Section : String_Access := null; + + function Real_Full_Switch + (S : Character; + Parser : Opt_Parser) return String; + -- Ensure that the returned switch value contains the + -- Switch_Char prefix if needed. + + ---------------------- + -- Real_Full_Switch -- + ---------------------- + + function Real_Full_Switch + (S : Character; + Parser : Opt_Parser) return String + is + begin + if S = '*' then + return Full_Switch (Parser); + else + return Switch_Char & Full_Switch (Parser); + end if; + end Real_Full_Switch; + + -- Start of processing for Set_Command_Line begin Free (Cmd.Expanded); @@ -1132,20 +1181,55 @@ package body GNAT.Command_Line is Parser => Parser); exit when S = ASCII.NUL; - if S = '*' then - Add_Switch (Cmd, Full_Switch (Parser), Parameter (Parser), - Separator (Parser)); - else - Add_Switch - (Cmd, Switch_Char & Full_Switch (Parser), - Parameter (Parser), Separator (Parser)); - end if; + declare + Sw : constant String := + Real_Full_Switch (S, Parser); + Is_Section : Boolean := False; + + begin + if Cmd.Config /= null + and then Cmd.Config.Sections /= null + then + Section_Search : + for S in Cmd.Config.Sections'Range loop + if Sw = Cmd.Config.Sections (S).all then + Section := Cmd.Config.Sections (S); + Is_Section := True; + + exit Section_Search; + end if; + end loop Section_Search; + end if; + + if not Is_Section then + if Section = null then + Add_Switch + (Cmd, Sw, + Parameter (Parser), + Separator (Parser)); + else + Add_Switch + (Cmd, Sw, + Parameter (Parser), + Separator (Parser), + Section.all); + end if; + end if; + end; exception when Invalid_Parameter => + -- Add it with no parameter, if that's the way the user - -- wants it - Add_Switch (Cmd, Switch_Char & Full_Switch (Parser)); + -- wants it. + + if Section = null then + Add_Switch + (Cmd, Switch_Char & Full_Switch (Parser)); + else + Add_Switch + (Cmd, Switch_Char & Full_Switch (Parser), Section.all); + end if; end; end loop; @@ -1230,7 +1314,8 @@ package body GNAT.Command_Line is (Cmd : in out Command_Line; Switch : String; Parameter : String := ""; - Separator : Character := ' ') + Separator : Character := ' '; + Section : String := "") is procedure Add_Simple_Switch (Simple : String); -- Add a new switch that has had all its aliases expanded, and switches @@ -1250,7 +1335,12 @@ package body GNAT.Command_Line is Cmd.Params := new Argument_List' (1 .. 1 => new String'(Separator & Parameter)); end if; - + if Section = "" then + Cmd.Sections := new Argument_List'(1 .. 1 => null); + else + Cmd.Sections := new Argument_List' + (1 .. 1 => new String'(Section)); + end if; else -- Do we already have this switch ? @@ -1261,6 +1351,11 @@ package body GNAT.Command_Line is or else (Cmd.Params (C) /= null and then Cmd.Params (C).all = Separator & Parameter)) + and then + ((Cmd.Sections (C) = null and then Section = "") + or else + (Cmd.Sections (C) /= null + and then Cmd.Sections (C).all = Section)) then return; end if; @@ -1273,6 +1368,12 @@ package body GNAT.Command_Line is else Append (Cmd.Params, new String'(Separator & Parameter)); end if; + + if Section = "" then + Append (Cmd.Sections, null); + else + Append (Cmd.Sections, new String'(Section)); + end if; end if; end Add_Simple_Switch; @@ -1337,7 +1438,8 @@ package body GNAT.Command_Line is procedure Remove_Switch (Cmd : in out Command_Line; Switch : String; - Remove_All : Boolean := False) + Remove_All : Boolean := False; + Section : String := "") is procedure Remove_Simple_Switch (Simple : String); -- Removes a simple switch, with no aliasing or grouping @@ -1353,9 +1455,17 @@ package body GNAT.Command_Line is if Cmd.Expanded /= null then C := Cmd.Expanded'First; while C <= Cmd.Expanded'Last loop - if Cmd.Expanded (C).all = Simple then + if Cmd.Expanded (C).all = Simple + and then + (Remove_All + or else (Cmd.Sections (C) = null + and then Section = "") + or else (Cmd.Sections (C) /= null + and then Section = Cmd.Sections (C).all)) + then Remove (Cmd.Expanded, C); Remove (Cmd.Params, C); + Remove (Cmd.Sections, C); if not Remove_All then return; @@ -1385,7 +1495,8 @@ package body GNAT.Command_Line is procedure Remove_Switch (Cmd : in out Command_Line; Switch : String; - Parameter : String) + Parameter : String; + Section : String := "") is procedure Remove_Simple_Switch (Simple : String); -- Removes a simple switch, with no aliasing or grouping @@ -1403,6 +1514,12 @@ package body GNAT.Command_Line is while C <= Cmd.Expanded'Last loop if Cmd.Expanded (C).all = Simple and then + ((Cmd.Sections (C) = null + and then Section = "") + or else + (Cmd.Sections (C) /= null + and then Section = Cmd.Sections (C).all)) + and then ((Cmd.Params (C) = null and then Parameter = "") or else (Cmd.Params (C) /= null @@ -1416,6 +1533,7 @@ package body GNAT.Command_Line is then Remove (Cmd.Expanded, C); Remove (Cmd.Params, C); + Remove (Cmd.Sections, C); -- The switch is necessarily unique by construction of -- Add_Switch @@ -1444,12 +1562,13 @@ package body GNAT.Command_Line is -------------------- procedure Group_Switches - (Cmd : Command_Line; - Result : Argument_List_Access; - Params : Argument_List_Access) + (Cmd : Command_Line; + Result : Argument_List_Access; + Sections : Argument_List_Access; + Params : Argument_List_Access) is - Group : Ada.Strings.Unbounded.Unbounded_String; - First : Natural; + Group : Ada.Strings.Unbounded.Unbounded_String; + First : Natural; use type Ada.Strings.Unbounded.Unbounded_String; begin @@ -1469,17 +1588,40 @@ package body GNAT.Command_Line is and then Looking_At (Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all) then - Group := - Group & - Result (C) - (Result (C)'First + Cmd.Config.Prefixes (P)'Length .. - Result (C)'Last); + -- If we are still in the same section, group the switches + if First = 0 + or else + (Sections (C) = null + and then Sections (First) = null) + or else + (Sections (C) /= null + and then Sections (First) /= null + and then Sections (C).all = Sections (First).all) + then + Group := + Group & + Result (C) + (Result (C)'First + Cmd.Config.Prefixes (P)'Length .. + Result (C)'Last); + if First = 0 then + First := C; + end if; - if First = 0 then + Free (Result (C)); + else + -- We changed section: we put the grouped switches to the + -- first place, on continue with the new section. + Result (First) := + new String' + (Cmd.Config.Prefixes (P).all & + Ada.Strings.Unbounded.To_String (Group)); + Group := + Ada.Strings.Unbounded.To_Unbounded_String + (Result (C) + (Result (C)'First + Cmd.Config.Prefixes (P)'Length .. + Result (C)'Last)); First := C; end if; - - Free (Result (C)); end if; end loop; @@ -1576,6 +1718,70 @@ package body GNAT.Command_Line is end loop; end Alias_Switches; + ------------------- + -- Sort_Sections -- + ------------------- + + procedure Sort_Sections + (Line : GNAT.OS_Lib.Argument_List_Access; + Sections : GNAT.OS_Lib.Argument_List_Access; + Params : GNAT.OS_Lib.Argument_List_Access) + is + Sections_List : Argument_List_Access := + new Argument_List'(1 .. 1 => null); + Found : Boolean; + Old_Line : constant Argument_List := Line.all; + Old_Sections : constant Argument_List := Sections.all; + Old_Params : constant Argument_List := Params.all; + Index : Natural; + + begin + if Line = null then + return; + end if; + + -- First construct a list of all sections + + for E in Line'Range loop + if Sections (E) /= null then + Found := False; + for S in Sections_List'Range loop + if (Sections_List (S) = null and then Sections (E) = null) + or else + (Sections_List (S) /= null + and then Sections (E) /= null + and then Sections_List (S).all = Sections (E).all) + then + Found := True; + exit; + end if; + end loop; + + if not Found then + Append (Sections_List, Sections (E)); + end if; + end if; + end loop; + + Index := Line'First; + + for S in Sections_List'Range loop + for E in Old_Line'Range loop + if (Sections_List (S) = null and then Old_Sections (E) = null) + or else + (Sections_List (S) /= null + and then Old_Sections (E) /= null + and then Sections_List (S).all = Old_Sections (E).all) + then + Line (Index) := Old_Line (E); + Sections (Index) := Old_Sections (E); + Params (Index) := Old_Params (E); + Index := Index + 1; + end if; + end loop; + end loop; + end Sort_Sections; + ----------- -- Start -- ----------- @@ -1591,6 +1797,10 @@ package body GNAT.Command_Line is return; end if; + -- Reorder the expanded line so that sections are grouped + + Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params); + -- Coalesce the switches as much as possible if not Expanded @@ -1601,19 +1811,30 @@ package body GNAT.Command_Line is Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all); end loop; + Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range); + for E in Cmd.Sections'Range loop + if Cmd.Sections (E) = null then + Cmd.Coalesce_Sections (E) := null; + else + Cmd.Coalesce_Sections (E) := new String'(Cmd.Sections (E).all); + end if; + end loop; + -- Not a clone, since we will not modify the parameters anyway Cmd.Coalesce_Params := Cmd.Params; Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Params); - Group_Switches (Cmd, Cmd.Coalesce, Cmd.Params); + Group_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Params); end if; if Expanded then - Iter.List := Cmd.Expanded; - Iter.Params := Cmd.Params; + Iter.List := Cmd.Expanded; + Iter.Params := Cmd.Params; + Iter.Sections := Cmd.Sections; else - Iter.List := Cmd.Coalesce; - Iter.Params := Cmd.Coalesce_Params; + Iter.List := Cmd.Coalesce; + Iter.Params := Cmd.Coalesce_Params; + Iter.Sections := Cmd.Coalesce_Sections; end if; if Iter.List = null then @@ -1637,6 +1858,40 @@ package body GNAT.Command_Line is return Iter.List (Iter.Current).all; end Current_Switch; + -------------------- + -- Is_New_Section -- + -------------------- + + function Is_New_Section (Iter : Command_Line_Iterator) return Boolean is + Section : constant String := Current_Section (Iter); + begin + if Iter.Sections = null then + return False; + elsif Iter.Current = Iter.Sections'First + or else Iter.Sections (Iter.Current - 1) = null + then + return Section /= ""; + end if; + + return Section /= Iter.Sections (Iter.Current - 1).all; + end Is_New_Section; + + --------------------- + -- Current_Section -- + --------------------- + + function Current_Section (Iter : Command_Line_Iterator) return String is + begin + if Iter.Sections = null + or else Iter.Current > Iter.Sections'Last + or else Iter.Sections (Iter.Current) = null + then + return ""; + end if; + + return Iter.Sections (Iter.Current).all; + end Current_Section; + ----------------------- -- Current_Separator -- ----------------------- diff --git a/gcc/ada/g-comlin.ads b/gcc/ada/g-comlin.ads index 6c63b2d..d92c157 100644 --- a/gcc/ada/g-comlin.ads +++ b/gcc/ada/g-comlin.ads @@ -513,6 +513,13 @@ package GNAT.Command_Line is -- characters whose order is irrelevant. In fact, this package will sort -- them alphabetically. + procedure Define_Section + (Config : in out Command_Line_Configuration; + Section : String); + -- Indicates a new switch section. Every switch belonging to the same + -- section are ordered together, preceded by the section. They are placed + -- at the end of the command line (as in 'gnatmake somefile.adb -cargs -g') + procedure Free (Config : in out Command_Line_Configuration); -- Free the memory used by Config @@ -549,13 +556,17 @@ package GNAT.Command_Line is -- Command_Line_Iterator (which might be fine depending on your -- application). -- + -- If the command line has sections (such as -bargs -largs -cargs), then + -- they should be listed in the Sections parameter (as "-bargs -cargs") + -- -- This function can be used to reset Cmd by passing an empty string. procedure Add_Switch (Cmd : in out Command_Line; Switch : String; Parameter : String := ""; - Separator : Character := ' '); + Separator : Character := ' '; + Section : String := ""); -- Add a new switch to the command line, and combine/group it with existing -- switches if possible. Nothing is done if the switch already exists with -- the same parameter. @@ -578,11 +589,17 @@ package GNAT.Command_Line is -- Separator is the character that goes between the switches and its -- parameter on the command line. If it is set to ASCII.NUL, then no -- separator is applied, and they are concatenated + -- + -- If the switch is part of a section, then it should be specified so that + -- the switch is correctly placed in the command line, and the section + -- added if not already present. For example, to add the -g switch into the + -- -cargs section, you need to call (Cmd, "-g", Section => "-cargs") procedure Remove_Switch (Cmd : in out Command_Line; Switch : String; - Remove_All : Boolean := False); + Remove_All : Boolean := False; + Section : String := ""); -- Remove Switch from the command line, and ungroup existing switches if -- necessary. -- @@ -592,11 +609,18 @@ package GNAT.Command_Line is -- -- If Remove_All is True, then all matching switches are removed, otherwise -- only the first matching one is removed. + -- + -- If the switch belongs to a section, then this section should be + -- specified: Remove_Switch (Cmd_Line, "-g", Section => "-cargs") called + -- on the command line "-g -cargs -g" will result in "-g", while if + -- called with (Cmd_Line, "-g") this will result in "-cargs -g". + -- If Remove_All is set, then both "-g" will be removed. procedure Remove_Switch (Cmd : in out Command_Line; Switch : String; - Parameter : String); + Parameter : String; + Section : String := ""); -- Remove a switch with a specific parameter. If Parameter is the empty -- string, then only a switch with no parameter will be removed. @@ -618,6 +642,8 @@ package GNAT.Command_Line is -- call to Add_Switch, Remove_Switch or Set_Command_Line. function Current_Switch (Iter : Command_Line_Iterator) return String; + function Is_New_Section (Iter : Command_Line_Iterator) return Boolean; + function Current_Section (Iter : Command_Line_Iterator) return String; function Current_Separator (Iter : Command_Line_Iterator) return String; function Current_Parameter (Iter : Command_Line_Iterator) return String; -- Return the current switch and its parameter (or the empty string if @@ -742,6 +768,9 @@ private Prefixes : GNAT.OS_Lib.Argument_List_Access; -- The list of prefixes + Sections : GNAT.OS_Lib.Argument_List_Access; + -- The list of sections + Aliases : GNAT.OS_Lib.Argument_List_Access; Expansions : GNAT.OS_Lib.Argument_List_Access; -- The aliases. Both arrays have the same indices @@ -756,8 +785,12 @@ private -- Parameter for the corresponding switch in Expanded. The first -- character is the separator (or ASCII.NUL if there is no separator) - Coalesce : GNAT.OS_Lib.Argument_List_Access; - Coalesce_Params : GNAT.OS_Lib.Argument_List_Access; + Sections : GNAT.OS_Lib.Argument_List_Access; + -- The list of sections + + Coalesce : GNAT.OS_Lib.Argument_List_Access; + Coalesce_Params : GNAT.OS_Lib.Argument_List_Access; + Coalesce_Sections : GNAT.OS_Lib.Argument_List_Access; -- Cached version of the command line. This is recomputed every time the -- command line changes. Switches are grouped as much as possible, and -- aliases are used to reduce the length of the command line. @@ -767,6 +800,7 @@ private type Command_Line_Iterator is record List : GNAT.OS_Lib.Argument_List_Access; + Sections : GNAT.OS_Lib.Argument_List_Access; Params : GNAT.OS_Lib.Argument_List_Access; Current : Natural; end record; -- 2.7.4