2008-08-05 Jerome Lambourg <lambourg@adacore.com>

	* 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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@138670 138bc75d-0d04-0410-961f-82ee72b054a4

2 files changed, 333 insertions, 44 deletions

diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb
index 32460c0599b..a3faf53040b 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 6c63b2d6222..d92c157e3f1 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;