gcc/ada/g-comlin.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                    G N A T . C O M M A N D _ L I N E                     --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1999-2009, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Ada.Unchecked_Deallocation;
  33 with Ada.Strings.Unbounded;
  34
  35 with GNAT.OS_Lib; use GNAT.OS_Lib;
  36
  37 package body GNAT.Command_Line is
  38
  39    package CL renames Ada.Command_Line;
  40
  41    type Switch_Parameter_Type is
  42      (Parameter_None,
  43       Parameter_With_Optional_Space,  --  ':' in getopt
  44       Parameter_With_Space_Or_Equal,  --  '=' in getopt
  45       Parameter_No_Space,             --  '!' in getopt
  46       Parameter_Optional);            --  '?' in getopt
  47
  48    procedure Set_Parameter
  49      (Variable : out Parameter_Type;
  50       Arg_Num  : Positive;
  51       First    : Positive;
  52       Last     : Positive;
  53       Extra    : Character := ASCII.NUL);
  54    pragma Inline (Set_Parameter);
  55    --  Set the parameter that will be returned by Parameter below
  56    --  Parameters need to be defined ???
  57
  58    function Goto_Next_Argument_In_Section (Parser : Opt_Parser) return Boolean;
  59    --  Go to the next argument on the command line. If we are at the end of
  60    --  the current section, we want to make sure there is no other identical
  61    --  section on the command line (there might be multiple instances of
  62    --  -largs). Returns True iff there is another argument.
  63
  64    function Get_File_Names_Case_Sensitive return Integer;
  65    pragma Import (C, Get_File_Names_Case_Sensitive,
  66                   "__gnat_get_file_names_case_sensitive");
  67
  68    File_Names_Case_Sensitive : constant Boolean :=
  69                                  Get_File_Names_Case_Sensitive /= 0;
  70
  71    procedure Canonical_Case_File_Name (S : in out String);
  72    --  Given a file name, converts it to canonical case form. For systems where
  73    --  file names are case sensitive, this procedure has no effect. If file
  74    --  names are not case sensitive (i.e. for example if you have the file
  75    --  "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then this call
  76    --  converts the given string to canonical all lower case form, so that two
  77    --  file names compare equal if they refer to the same file.
  78
  79    procedure Internal_Initialize_Option_Scan
  80      (Parser                   : Opt_Parser;
  81       Switch_Char              : Character;
  82       Stop_At_First_Non_Switch : Boolean;
  83       Section_Delimiters       : String);
  84    --  Initialize Parser, which must have been allocated already
  85
  86    function Argument (Parser : Opt_Parser; Index : Integer) return String;
  87    --  Return the index-th command line argument
  88
  89    procedure Find_Longest_Matching_Switch
  90      (Switches          : String;
  91       Arg               : String;
  92       Index_In_Switches : out Integer;
  93       Switch_Length     : out Integer;
  94       Param             : out Switch_Parameter_Type);
  95    --  Return the Longest switch from Switches that at least partially
  96    --  partially Arg. Index_In_Switches is set to 0 if none matches.
  97    --  What are other parameters??? in particular Param is not always set???
  98
  99    procedure Unchecked_Free is new Ada.Unchecked_Deallocation
 100      (Argument_List, Argument_List_Access);
 101
 102    procedure Unchecked_Free is new Ada.Unchecked_Deallocation
 103      (Command_Line_Configuration_Record, Command_Line_Configuration);
 104
 105    procedure Remove (Line : in out Argument_List_Access; Index : Integer);
 106    --  Remove a specific element from Line
 107
 108    procedure Add
 109      (Line   : in out Argument_List_Access;
 110       Str    : String_Access;
 111       Before : Boolean := False);
 112    --  Add a new element to Line. If Before is True, the item is inserted at
 113    --  the beginning, else it is appended.
 114
 115    function Can_Have_Parameter (S : String) return Boolean;
 116    --  True if S can have a parameter
 117
 118    function Require_Parameter (S : String) return Boolean;
 119    --  True if S requires a parameter
 120
 121    function Actual_Switch (S : String) return String;
 122    --  Remove any possible trailing '!', ':', '?' and '='
 123
 124    generic
 125       with procedure Callback (Simple_Switch : String; Parameter : String);
 126    procedure For_Each_Simple_Switch
 127      (Cmd       : Command_Line;
 128       Switch    : String;
 129       Parameter : String  := "";
 130       Unalias   : Boolean := True);
 131    --  Breaks Switch into as simple switches as possible (expanding aliases and
 132    --  ungrouping common prefixes when possible), and call Callback for each of
 133    --  these.
 134
 135    procedure Sort_Sections
 136      (Line     : GNAT.OS_Lib.Argument_List_Access;
 137       Sections : GNAT.OS_Lib.Argument_List_Access;
 138       Params   : GNAT.OS_Lib.Argument_List_Access);
 139    --  Reorder the command line switches so that the switches belonging to a
 140    --  section are grouped together.
 141
 142    procedure Group_Switches
 143      (Cmd      : Command_Line;
 144       Result   : Argument_List_Access;
 145       Sections : Argument_List_Access;
 146       Params   : Argument_List_Access);
 147    --  Group switches with common prefixes whenever possible. Once they have
 148    --  been grouped, we also check items for possible aliasing.
 149
 150    procedure Alias_Switches
 151      (Cmd    : Command_Line;
 152       Result : Argument_List_Access;
 153       Params : Argument_List_Access);
 154    --  When possible, replace one or more switches by an alias, i.e. a shorter
 155    --  version.
 156
 157    function Looking_At
 158      (Type_Str  : String;
 159       Index     : Natural;
 160       Substring : String) return Boolean;
 161    --  Return True if the characters starting at Index in Type_Str are
 162    --  equivalent to Substring.
 163
 164    --------------
 165    -- Argument --
 166    --------------
 167
 168    function Argument (Parser : Opt_Parser; Index : Integer) return String is
 169    begin
 170       if Parser.Arguments /= null then
 171          return Parser.Arguments (Index + Parser.Arguments'First - 1).all;
 172       else
 173          return CL.Argument (Index);
 174       end if;
 175    end Argument;
 176
 177    ------------------------------
 178    -- Canonical_Case_File_Name --
 179    ------------------------------
 180
 181    procedure Canonical_Case_File_Name (S : in out String) is
 182    begin
 183       if not File_Names_Case_Sensitive then
 184          for J in S'Range loop
 185             if S (J) in 'A' .. 'Z' then
 186                S (J) := Character'Val
 187                          (Character'Pos (S (J)) +
 188                           Character'Pos ('a')   -
 189                           Character'Pos ('A'));
 190             end if;
 191          end loop;
 192       end if;
 193    end Canonical_Case_File_Name;
 194
 195    ---------------
 196    -- Expansion --
 197    ---------------
 198
 199    function Expansion (Iterator : Expansion_Iterator) return String is
 200       use GNAT.Directory_Operations;
 201       type Pointer is access all Expansion_Iterator;
 202
 203       It   : constant Pointer := Iterator'Unrestricted_Access;
 204       S    : String (1 .. 1024);
 205       Last : Natural;
 206
 207       Current : Depth := It.Current_Depth;
 208       NL      : Positive;
 209
 210    begin
 211       --  It is assumed that a directory is opened at the current level.
 212       --  Otherwise GNAT.Directory_Operations.Directory_Error will be raised
 213       --  at the first call to Read.
 214
 215       loop
 216          Read (It.Levels (Current).Dir, S, Last);
 217
 218          --  If we have exhausted the directory, close it and go back one level
 219
 220          if Last = 0 then
 221             Close (It.Levels (Current).Dir);
 222
 223             --  If we are at level 1, we are finished; return an empty string
 224
 225             if Current = 1 then
 226                return String'(1 .. 0 => ' ');
 227             else
 228                --  Otherwise continue with the directory at the previous level
 229
 230                Current := Current - 1;
 231                It.Current_Depth := Current;
 232             end if;
 233
 234          --  If this is a directory, that is neither "." or "..", attempt to
 235          --  go to the next level.
 236
 237          elsif Is_Directory
 238            (It.Dir_Name (1 .. It.Levels (Current).Name_Last) & S (1 .. Last))
 239            and then S (1 .. Last) /= "."
 240            and then S (1 .. Last) /= ".."
 241          then
 242             --  We can go to the next level only if we have not reached the
 243             --  maximum depth,
 244
 245             if Current < It.Maximum_Depth then
 246                NL := It.Levels (Current).Name_Last;
 247
 248                --  And if relative path of this new directory is not too long
 249
 250                if NL + Last + 1 < Max_Path_Length then
 251                   Current := Current + 1;
 252                   It.Current_Depth := Current;
 253                   It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last);
 254                   NL := NL + Last + 1;
 255                   It.Dir_Name (NL) := Directory_Separator;
 256                   It.Levels (Current).Name_Last := NL;
 257                   Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
 258
 259                   --  Open the new directory, and read from it
 260
 261                   GNAT.Directory_Operations.Open
 262                     (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
 263                end if;
 264             end if;
 265          end if;
 266
 267          --  Check the relative path against the pattern
 268
 269          --  Note that we try to match also against directory names, since
 270          --  clients of this function may expect to retrieve directories.
 271
 272          declare
 273             Name : String :=
 274                      It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
 275                        & S (1 .. Last);
 276
 277          begin
 278             Canonical_Case_File_Name (Name);
 279
 280             --  If it matches return the relative path
 281
 282             if GNAT.Regexp.Match (Name, Iterator.Regexp) then
 283                return Name;
 284             end if;
 285          end;
 286       end loop;
 287    end Expansion;
 288
 289    -----------------
 290    -- Full_Switch --
 291    -----------------
 292
 293    function Full_Switch
 294      (Parser : Opt_Parser := Command_Line_Parser) return String
 295    is
 296    begin
 297       if Parser.The_Switch.Extra = ASCII.NUL then
 298          return Argument (Parser, Parser.The_Switch.Arg_Num)
 299            (Parser.The_Switch.First .. Parser.The_Switch.Last);
 300       else
 301          return Parser.The_Switch.Extra
 302            & Argument (Parser, Parser.The_Switch.Arg_Num)
 303            (Parser.The_Switch.First .. Parser.The_Switch.Last);
 304       end if;
 305    end Full_Switch;
 306
 307    ------------------
 308    -- Get_Argument --
 309    ------------------
 310
 311    function Get_Argument
 312      (Do_Expansion : Boolean    := False;
 313       Parser       : Opt_Parser := Command_Line_Parser) return String
 314    is
 315    begin
 316       if Parser.In_Expansion then
 317          declare
 318             S : constant String := Expansion (Parser.Expansion_It);
 319          begin
 320             if S'Length /= 0 then
 321                return S;
 322             else
 323                Parser.In_Expansion := False;
 324             end if;
 325          end;
 326       end if;
 327
 328       if Parser.Current_Argument > Parser.Arg_Count then
 329
 330          --  If this is the first time this function is called
 331
 332          if Parser.Current_Index = 1 then
 333             Parser.Current_Argument := 1;
 334             while Parser.Current_Argument <= Parser.Arg_Count
 335               and then Parser.Section (Parser.Current_Argument) /=
 336                 Parser.Current_Section
 337             loop
 338                Parser.Current_Argument := Parser.Current_Argument + 1;
 339             end loop;
 340          else
 341             return String'(1 .. 0 => ' ');
 342          end if;
 343
 344       elsif Parser.Section (Parser.Current_Argument) = 0 then
 345          while Parser.Current_Argument <= Parser.Arg_Count
 346            and then Parser.Section (Parser.Current_Argument) /=
 347              Parser.Current_Section
 348          loop
 349             Parser.Current_Argument := Parser.Current_Argument + 1;
 350          end loop;
 351       end if;
 352
 353       Parser.Current_Index := Integer'Last;
 354
 355       while Parser.Current_Argument <= Parser.Arg_Count
 356         and then Parser.Is_Switch (Parser.Current_Argument)
 357       loop
 358          Parser.Current_Argument := Parser.Current_Argument + 1;
 359       end loop;
 360
 361       if Parser.Current_Argument > Parser.Arg_Count then
 362          return String'(1 .. 0 => ' ');
 363       elsif Parser.Section (Parser.Current_Argument) = 0 then
 364          return Get_Argument (Do_Expansion);
 365       end if;
 366
 367       Parser.Current_Argument := Parser.Current_Argument + 1;
 368
 369       --  Could it be a file name with wild cards to expand?
 370
 371       if Do_Expansion then
 372          declare
 373             Arg   : constant String :=
 374                       Argument (Parser, Parser.Current_Argument - 1);
 375             Index : Positive;
 376
 377          begin
 378             Index := Arg'First;
 379             while Index <= Arg'Last loop
 380                if Arg (Index) = '*'
 381                  or else Arg (Index) = '?'
 382                  or else Arg (Index) = '['
 383                then
 384                   Parser.In_Expansion := True;
 385                   Start_Expansion (Parser.Expansion_It, Arg);
 386                   return Get_Argument (Do_Expansion);
 387                end if;
 388
 389                Index := Index + 1;
 390             end loop;
 391          end;
 392       end if;
 393
 394       return Argument (Parser, Parser.Current_Argument - 1);
 395    end Get_Argument;
 396
 397    ----------------------------------
 398    -- Find_Longest_Matching_Switch --
 399    ----------------------------------
 400
 401    procedure Find_Longest_Matching_Switch
 402      (Switches          : String;
 403       Arg               : String;
 404       Index_In_Switches : out Integer;
 405       Switch_Length     : out Integer;
 406       Param             : out Switch_Parameter_Type)
 407    is
 408       Index  : Natural;
 409       Length : Natural := 1;
 410       P      : Switch_Parameter_Type;
 411
 412    begin
 413       Index_In_Switches := 0;
 414       Switch_Length     := 0;
 415
 416       --  Remove all leading spaces first to make sure that Index points
 417       --  at the start of the first switch.
 418
 419       Index := Switches'First;
 420       while Index <= Switches'Last and then Switches (Index) = ' ' loop
 421          Index := Index + 1;
 422       end loop;
 423
 424       while Index <= Switches'Last loop
 425
 426          --  Search the length of the parameter at this position in Switches
 427
 428          Length := Index;
 429          while Length <= Switches'Last
 430            and then Switches (Length) /= ' '
 431          loop
 432             Length := Length + 1;
 433          end loop;
 434
 435          if Length = Index + 1 then
 436             P := Parameter_None;
 437          else
 438             case Switches (Length - 1) is
 439                when ':'    =>
 440                   P      := Parameter_With_Optional_Space;
 441                   Length := Length - 1;
 442                when '='    =>
 443                   P      := Parameter_With_Space_Or_Equal;
 444                   Length := Length - 1;
 445                when '!'    =>
 446                   P      := Parameter_No_Space;
 447                   Length := Length - 1;
 448                when '?'    =>
 449                   P      := Parameter_Optional;
 450                   Length := Length - 1;
 451                when others =>
 452                   P      := Parameter_None;
 453             end case;
 454          end if;
 455
 456          --  If it is the one we searched, it may be a candidate
 457
 458          if Arg'First + Length - 1 - Index <= Arg'Last
 459            and then Switches (Index .. Length - 1) =
 460                       Arg (Arg'First .. Arg'First + Length - 1 - Index)
 461            and then Length - Index > Switch_Length
 462          then
 463             Param             := P;
 464             Index_In_Switches := Index;
 465             Switch_Length     := Length - Index;
 466          end if;
 467
 468          --  Look for the next switch in Switches
 469
 470          while Index <= Switches'Last
 471            and then Switches (Index) /= ' '
 472          loop
 473             Index := Index + 1;
 474          end loop;
 475
 476          Index := Index + 1;
 477       end loop;
 478    end Find_Longest_Matching_Switch;
 479
 480    ------------
 481    -- Getopt --
 482    ------------
 483
 484    function Getopt
 485      (Switches    : String;
 486       Concatenate : Boolean := True;
 487       Parser      : Opt_Parser := Command_Line_Parser) return Character
 488    is
 489       Dummy : Boolean;
 490       pragma Unreferenced (Dummy);
 491
 492    begin
 493       <<Restart>>
 494
 495       --  If we have finished parsing the current command line item (there
 496       --  might be multiple switches in a single item), then go to the next
 497       --  element
 498
 499       if Parser.Current_Argument > Parser.Arg_Count
 500         or else (Parser.Current_Index >
 501                    Argument (Parser, Parser.Current_Argument)'Last
 502                  and then not Goto_Next_Argument_In_Section (Parser))
 503       then
 504          return ASCII.NUL;
 505       end if;
 506
 507       --  By default, the switch will not have a parameter
 508
 509       Parser.The_Parameter :=
 510         (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
 511       Parser.The_Separator := ASCII.NUL;
 512
 513       declare
 514          Arg            : constant String :=
 515                             Argument (Parser, Parser.Current_Argument);
 516          Index_Switches : Natural := 0;
 517          Max_Length     : Natural := 0;
 518          End_Index      : Natural;
 519          Param          : Switch_Parameter_Type;
 520       begin
 521          --  If we are on a new item, test if this might be a switch
 522
 523          if Parser.Current_Index = Arg'First then
 524             if Arg (Arg'First) /= Parser.Switch_Character then
 525
 526                --  If it isn't a switch, return it immediately. We also know it
 527                --  isn't the parameter to a previous switch, since that has
 528                --  already been handled
 529
 530                if Switches (Switches'First) = '*' then
 531                   Set_Parameter
 532                     (Parser.The_Switch,
 533                      Arg_Num => Parser.Current_Argument,
 534                      First   => Arg'First,
 535                      Last    => Arg'Last);
 536                   Parser.Is_Switch (Parser.Current_Argument) := True;
 537                   Dummy := Goto_Next_Argument_In_Section (Parser);
 538                   return '*';
 539                end if;
 540
 541                if Parser.Stop_At_First then
 542                   Parser.Current_Argument := Positive'Last;
 543                   return ASCII.NUL;
 544
 545                elsif not Goto_Next_Argument_In_Section (Parser) then
 546                   return ASCII.NUL;
 547
 548                else
 549                   --  Recurse to get the next switch on the command line
 550
 551                   goto Restart;
 552                end if;
 553             end if;
 554
 555             --  We are on the first character of a new command line argument,
 556             --  which starts with Switch_Character. Further analysis is needed.
 557
 558             Parser.Current_Index := Parser.Current_Index + 1;
 559             Parser.Is_Switch (Parser.Current_Argument) := True;
 560          end if;
 561
 562          Find_Longest_Matching_Switch
 563            (Switches          => Switches,
 564             Arg               => Arg (Parser.Current_Index .. Arg'Last),
 565             Index_In_Switches => Index_Switches,
 566             Switch_Length     => Max_Length,
 567             Param             => Param);
 568
 569          --  If switch is not accepted, it is either invalid or is returned
 570          --  in the context of '*'.
 571
 572          if Index_Switches = 0 then
 573
 574             --  Depending on the value of Concatenate, the full switch is
 575             --  a single character or the rest of the argument.
 576
 577             End_Index :=
 578               (if Concatenate then Parser.Current_Index else Arg'Last);
 579
 580             if Switches (Switches'First) = '*' then
 581
 582                --  Always prepend the switch character, so that users know that
 583                --  this comes from a switch on the command line. This is
 584                --  especially important when Concatenate is False, since
 585                --  otherwise the current argument first character is lost.
 586
 587                Set_Parameter
 588                  (Parser.The_Switch,
 589                   Arg_Num => Parser.Current_Argument,
 590                   First   => Parser.Current_Index,
 591                   Last    => Arg'Last,
 592                   Extra   => Parser.Switch_Character);
 593                Parser.Is_Switch (Parser.Current_Argument) := True;
 594                Dummy := Goto_Next_Argument_In_Section (Parser);
 595                return '*';
 596             end if;
 597
 598             Set_Parameter
 599               (Parser.The_Switch,
 600                Arg_Num => Parser.Current_Argument,
 601                First   => Parser.Current_Index,
 602                Last    => End_Index);
 603             Parser.Current_Index := End_Index + 1;
 604             raise Invalid_Switch;
 605          end if;
 606
 607          End_Index := Parser.Current_Index + Max_Length - 1;
 608          Set_Parameter
 609            (Parser.The_Switch,
 610             Arg_Num => Parser.Current_Argument,
 611             First   => Parser.Current_Index,
 612             Last    => End_Index);
 613
 614          case Param is
 615             when Parameter_With_Optional_Space =>
 616                if End_Index < Arg'Last then
 617                   Set_Parameter
 618                     (Parser.The_Parameter,
 619                      Arg_Num => Parser.Current_Argument,
 620                      First   => End_Index + 1,
 621                      Last    => Arg'Last);
 622                   Dummy := Goto_Next_Argument_In_Section (Parser);
 623
 624                elsif Parser.Current_Argument < Parser.Arg_Count
 625                  and then Parser.Section (Parser.Current_Argument + 1) /= 0
 626                then
 627                   Parser.Current_Argument := Parser.Current_Argument + 1;
 628                   Parser.The_Separator := ' ';
 629                   Set_Parameter
 630                     (Parser.The_Parameter,
 631                      Arg_Num => Parser.Current_Argument,
 632                      First => Argument (Parser, Parser.Current_Argument)'First,
 633                      Last  => Argument (Parser, Parser.Current_Argument)'Last);
 634                   Parser.Is_Switch (Parser.Current_Argument) := True;
 635                   Dummy := Goto_Next_Argument_In_Section (Parser);
 636
 637                else
 638                   Parser.Current_Index := End_Index + 1;
 639                   raise Invalid_Parameter;
 640                end if;
 641
 642             when Parameter_With_Space_Or_Equal =>
 643
 644                --  If the switch is of the form <switch>=xxx
 645
 646                if End_Index < Arg'Last then
 647
 648                   if Arg (End_Index + 1) = '='
 649                     and then End_Index + 1 < Arg'Last
 650                   then
 651                      Parser.The_Separator := '=';
 652                      Set_Parameter
 653                        (Parser.The_Parameter,
 654                         Arg_Num => Parser.Current_Argument,
 655                         First   => End_Index + 2,
 656                         Last    => Arg'Last);
 657                      Dummy := Goto_Next_Argument_In_Section (Parser);
 658                   else
 659                      Parser.Current_Index := End_Index + 1;
 660                      raise Invalid_Parameter;
 661                   end if;
 662
 663                --  If the switch is of the form <switch> xxx
 664
 665                elsif Parser.Current_Argument < Parser.Arg_Count
 666                  and then Parser.Section (Parser.Current_Argument + 1) /= 0
 667                then
 668                   Parser.Current_Argument := Parser.Current_Argument + 1;
 669                   Parser.The_Separator := ' ';
 670                   Set_Parameter
 671                     (Parser.The_Parameter,
 672                      Arg_Num => Parser.Current_Argument,
 673                      First => Argument (Parser, Parser.Current_Argument)'First,
 674                      Last  => Argument (Parser, Parser.Current_Argument)'Last);
 675                   Parser.Is_Switch (Parser.Current_Argument) := True;
 676                   Dummy := Goto_Next_Argument_In_Section (Parser);
 677
 678                else
 679                   Parser.Current_Index := End_Index + 1;
 680                   raise Invalid_Parameter;
 681                end if;
 682
 683             when Parameter_No_Space =>
 684
 685                if End_Index < Arg'Last then
 686                   Set_Parameter
 687                     (Parser.The_Parameter,
 688                      Arg_Num => Parser.Current_Argument,
 689                      First   => End_Index + 1,
 690                      Last    => Arg'Last);
 691                   Dummy := Goto_Next_Argument_In_Section (Parser);
 692
 693                else
 694                   Parser.Current_Index := End_Index + 1;
 695                   raise Invalid_Parameter;
 696                end if;
 697
 698             when Parameter_Optional =>
 699
 700                if End_Index < Arg'Last then
 701                   Set_Parameter
 702                     (Parser.The_Parameter,
 703                      Arg_Num => Parser.Current_Argument,
 704                      First   => End_Index + 1,
 705                      Last    => Arg'Last);
 706                end if;
 707
 708                Dummy := Goto_Next_Argument_In_Section (Parser);
 709
 710             when Parameter_None =>
 711
 712                if Concatenate or else End_Index = Arg'Last then
 713                   Parser.Current_Index := End_Index + 1;
 714
 715                else
 716                   --  If Concatenate is False and the full argument is not
 717                   --  recognized as a switch, this is an invalid switch.
 718
 719                   if Switches (Switches'First) = '*' then
 720                      Set_Parameter
 721                        (Parser.The_Switch,
 722                         Arg_Num => Parser.Current_Argument,
 723                         First   => Arg'First,
 724                         Last    => Arg'Last);
 725                      Parser.Is_Switch (Parser.Current_Argument) := True;
 726                      Dummy := Goto_Next_Argument_In_Section (Parser);
 727                      return '*';
 728                   end if;
 729
 730                   Set_Parameter
 731                     (Parser.The_Switch,
 732                      Arg_Num => Parser.Current_Argument,
 733                      First   => Parser.Current_Index,
 734                      Last    => Arg'Last);
 735                   Parser.Current_Index := Arg'Last + 1;
 736                   raise Invalid_Switch;
 737                end if;
 738          end case;
 739
 740          return Switches (Index_Switches);
 741       end;
 742    end Getopt;
 743
 744    -----------------------------------
 745    -- Goto_Next_Argument_In_Section --
 746    -----------------------------------
 747
 748    function Goto_Next_Argument_In_Section
 749      (Parser : Opt_Parser) return Boolean
 750    is
 751    begin
 752       Parser.Current_Argument := Parser.Current_Argument + 1;
 753
 754       if Parser.Current_Argument > Parser.Arg_Count
 755         or else Parser.Section (Parser.Current_Argument) = 0
 756       then
 757          loop
 758             Parser.Current_Argument := Parser.Current_Argument + 1;
 759
 760             if Parser.Current_Argument > Parser.Arg_Count then
 761                Parser.Current_Index := 1;
 762                return False;
 763             end if;
 764
 765             exit when Parser.Section (Parser.Current_Argument) =
 766                                                   Parser.Current_Section;
 767          end loop;
 768       end if;
 769
 770       Parser.Current_Index :=
 771         Argument (Parser, Parser.Current_Argument)'First;
 772
 773       return True;
 774    end Goto_Next_Argument_In_Section;
 775
 776    ------------------
 777    -- Goto_Section --
 778    ------------------
 779
 780    procedure Goto_Section
 781      (Name   : String := "";
 782       Parser : Opt_Parser := Command_Line_Parser)
 783    is
 784       Index : Integer;
 785
 786    begin
 787       Parser.In_Expansion := False;
 788
 789       if Name = "" then
 790          Parser.Current_Argument := 1;
 791          Parser.Current_Index    := 1;
 792          Parser.Current_Section  := 1;
 793          return;
 794       end if;
 795
 796       Index := 1;
 797       while Index <= Parser.Arg_Count loop
 798          if Parser.Section (Index) = 0
 799            and then Argument (Parser, Index) = Parser.Switch_Character & Name
 800          then
 801             Parser.Current_Argument := Index + 1;
 802             Parser.Current_Index    := 1;
 803
 804             if Parser.Current_Argument <= Parser.Arg_Count then
 805                Parser.Current_Section :=
 806                  Parser.Section (Parser.Current_Argument);
 807             end if;
 808             return;
 809          end if;
 810
 811          Index := Index + 1;
 812       end loop;
 813
 814       Parser.Current_Argument := Positive'Last;
 815       Parser.Current_Index := 2;   --  so that Get_Argument returns nothing
 816    end Goto_Section;
 817
 818    ----------------------------
 819    -- Initialize_Option_Scan --
 820    ----------------------------
 821
 822    procedure Initialize_Option_Scan
 823      (Switch_Char              : Character := '-';
 824       Stop_At_First_Non_Switch : Boolean   := False;
 825       Section_Delimiters       : String    := "")
 826    is
 827    begin
 828       Internal_Initialize_Option_Scan
 829         (Parser                   => Command_Line_Parser,
 830          Switch_Char              => Switch_Char,
 831          Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 832          Section_Delimiters       => Section_Delimiters);
 833    end Initialize_Option_Scan;
 834
 835    ----------------------------
 836    -- Initialize_Option_Scan --
 837    ----------------------------
 838
 839    procedure Initialize_Option_Scan
 840      (Parser                   : out Opt_Parser;
 841       Command_Line             : GNAT.OS_Lib.Argument_List_Access;
 842       Switch_Char              : Character := '-';
 843       Stop_At_First_Non_Switch : Boolean := False;
 844       Section_Delimiters       : String := "")
 845    is
 846    begin
 847       Free (Parser);
 848
 849       if Command_Line = null then
 850          Parser := new Opt_Parser_Data (CL.Argument_Count);
 851          Internal_Initialize_Option_Scan
 852            (Parser                   => Parser,
 853             Switch_Char              => Switch_Char,
 854             Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 855             Section_Delimiters       => Section_Delimiters);
 856       else
 857          Parser := new Opt_Parser_Data (Command_Line'Length);
 858          Parser.Arguments := Command_Line;
 859          Internal_Initialize_Option_Scan
 860            (Parser                   => Parser,
 861             Switch_Char              => Switch_Char,
 862             Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 863             Section_Delimiters       => Section_Delimiters);
 864       end if;
 865    end Initialize_Option_Scan;
 866
 867    -------------------------------------
 868    -- Internal_Initialize_Option_Scan --
 869    -------------------------------------
 870
 871    procedure Internal_Initialize_Option_Scan
 872      (Parser                   : Opt_Parser;
 873       Switch_Char              : Character;
 874       Stop_At_First_Non_Switch : Boolean;
 875       Section_Delimiters       : String)
 876    is
 877       Section_Num     : Section_Number;
 878       Section_Index   : Integer;
 879       Last            : Integer;
 880       Delimiter_Found : Boolean;
 881
 882       Discard : Boolean;
 883       pragma Warnings (Off, Discard);
 884
 885    begin
 886       Parser.Current_Argument := 0;
 887       Parser.Current_Index    := 0;
 888       Parser.In_Expansion     := False;
 889       Parser.Switch_Character := Switch_Char;
 890       Parser.Stop_At_First    := Stop_At_First_Non_Switch;
 891       Parser.Section          := (others => 1);
 892
 893       --  If we are using sections, we have to preprocess the command line
 894       --  to delimit them. A section can be repeated, so we just give each
 895       --  item on the command line a section number
 896
 897       Section_Num   := 1;
 898       Section_Index := Section_Delimiters'First;
 899       while Section_Index <= Section_Delimiters'Last loop
 900          Last := Section_Index;
 901          while Last <= Section_Delimiters'Last
 902            and then Section_Delimiters (Last) /= ' '
 903          loop
 904             Last := Last + 1;
 905          end loop;
 906
 907          Delimiter_Found := False;
 908          Section_Num := Section_Num + 1;
 909
 910          for Index in 1 .. Parser.Arg_Count loop
 911             if Argument (Parser, Index)(1) = Parser.Switch_Character
 912               and then
 913                 Argument (Parser, Index) = Parser.Switch_Character &
 914                                         Section_Delimiters
 915                                           (Section_Index .. Last - 1)
 916             then
 917                Parser.Section (Index) := 0;
 918                Delimiter_Found := True;
 919
 920             elsif Parser.Section (Index) = 0 then
 921                Delimiter_Found := False;
 922
 923             elsif Delimiter_Found then
 924                Parser.Section (Index) := Section_Num;
 925             end if;
 926          end loop;
 927
 928          Section_Index := Last + 1;
 929          while Section_Index <= Section_Delimiters'Last
 930            and then Section_Delimiters (Section_Index) = ' '
 931          loop
 932             Section_Index := Section_Index + 1;
 933          end loop;
 934       end loop;
 935
 936       Discard := Goto_Next_Argument_In_Section (Parser);
 937    end Internal_Initialize_Option_Scan;
 938
 939    ---------------
 940    -- Parameter --
 941    ---------------
 942
 943    function Parameter
 944      (Parser : Opt_Parser := Command_Line_Parser) return String
 945    is
 946    begin
 947       if Parser.The_Parameter.First > Parser.The_Parameter.Last then
 948          return String'(1 .. 0 => ' ');
 949       else
 950          return Argument (Parser, Parser.The_Parameter.Arg_Num)
 951            (Parser.The_Parameter.First .. Parser.The_Parameter.Last);
 952       end if;
 953    end Parameter;
 954
 955    ---------------
 956    -- Separator --
 957    ---------------
 958
 959    function Separator
 960      (Parser : Opt_Parser := Command_Line_Parser) return Character
 961    is
 962    begin
 963       return Parser.The_Separator;
 964    end Separator;
 965
 966    -------------------
 967    -- Set_Parameter --
 968    -------------------
 969
 970    procedure Set_Parameter
 971      (Variable : out Parameter_Type;
 972       Arg_Num  : Positive;
 973       First    : Positive;
 974       Last     : Positive;
 975       Extra    : Character := ASCII.NUL)
 976    is
 977    begin
 978       Variable.Arg_Num := Arg_Num;
 979       Variable.First   := First;
 980       Variable.Last    := Last;
 981       Variable.Extra   := Extra;
 982    end Set_Parameter;
 983
 984    ---------------------
 985    -- Start_Expansion --
 986    ---------------------
 987
 988    procedure Start_Expansion
 989      (Iterator     : out Expansion_Iterator;
 990       Pattern      : String;
 991       Directory    : String := "";
 992       Basic_Regexp : Boolean := True)
 993    is
 994       Directory_Separator : Character;
 995       pragma Import (C, Directory_Separator, "__gnat_dir_separator");
 996
 997       First : Positive := Pattern'First;
 998       Pat   : String := Pattern;
 999
1000    begin
1001       Canonical_Case_File_Name (Pat);
1002       Iterator.Current_Depth := 1;
1003
1004       --  If Directory is unspecified, use the current directory ("./" or ".\")
1005
1006       if Directory = "" then
1007          Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
1008          Iterator.Start := 3;
1009
1010       else
1011          Iterator.Dir_Name (1 .. Directory'Length) := Directory;
1012          Iterator.Start := Directory'Length + 1;
1013          Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length));
1014
1015          --  Make sure that the last character is a directory separator
1016
1017          if Directory (Directory'Last) /= Directory_Separator then
1018             Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
1019             Iterator.Start := Iterator.Start + 1;
1020          end if;
1021       end if;
1022
1023       Iterator.Levels (1).Name_Last := Iterator.Start - 1;
1024
1025       --  Open the initial Directory, at depth 1
1026
1027       GNAT.Directory_Operations.Open
1028         (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
1029
1030       --  If in the current directory and the pattern starts with "./" or ".\",
1031       --  drop the "./" or ".\" from the pattern.
1032
1033       if Directory = "" and then Pat'Length > 2
1034         and then Pat (Pat'First) = '.'
1035         and then Pat (Pat'First + 1) = Directory_Separator
1036       then
1037          First := Pat'First + 2;
1038       end if;
1039
1040       Iterator.Regexp :=
1041         GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True);
1042
1043       Iterator.Maximum_Depth := 1;
1044
1045       --  Maximum_Depth is equal to 1 plus the number of directory separators
1046       --  in the pattern.
1047
1048       for Index in First .. Pat'Last loop
1049          if Pat (Index) = Directory_Separator then
1050             Iterator.Maximum_Depth := Iterator.Maximum_Depth + 1;
1051             exit when Iterator.Maximum_Depth = Max_Depth;
1052          end if;
1053       end loop;
1054    end Start_Expansion;
1055
1056    ----------
1057    -- Free --
1058    ----------
1059
1060    procedure Free (Parser : in out Opt_Parser) is
1061       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1062         (Opt_Parser_Data, Opt_Parser);
1063    begin
1064       if Parser /= null
1065         and then Parser /= Command_Line_Parser
1066       then
1067          Free (Parser.Arguments);
1068          Unchecked_Free (Parser);
1069       end if;
1070    end Free;
1071
1072    ------------------
1073    -- Define_Alias --
1074    ------------------
1075
1076    procedure Define_Alias
1077      (Config   : in out Command_Line_Configuration;
1078       Switch   : String;
1079       Expanded : String)
1080    is
1081    begin
1082       if Config = null then
1083          Config := new Command_Line_Configuration_Record;
1084       end if;
1085
1086       Add (Config.Aliases,    new String'(Switch));
1087       Add (Config.Expansions, new String'(Expanded));
1088    end Define_Alias;
1089
1090    -------------------
1091    -- Define_Prefix --
1092    -------------------
1093
1094    procedure Define_Prefix
1095      (Config : in out Command_Line_Configuration;
1096       Prefix : String)
1097    is
1098    begin
1099       if Config = null then
1100          Config := new Command_Line_Configuration_Record;
1101       end if;
1102
1103       Add (Config.Prefixes, new String'(Prefix));
1104    end Define_Prefix;
1105
1106    -------------------
1107    -- Define_Switch --
1108    -------------------
1109
1110    procedure Define_Switch
1111      (Config : in out Command_Line_Configuration;
1112       Switch : String)
1113    is
1114    begin
1115       if Config = null then
1116          Config := new Command_Line_Configuration_Record;
1117       end if;
1118
1119       Add (Config.Switches, new String'(Switch));
1120    end Define_Switch;
1121
1122    --------------------
1123    -- Define_Section --
1124    --------------------
1125
1126    procedure Define_Section
1127      (Config : in out Command_Line_Configuration;
1128       Section : String)
1129    is
1130    begin
1131       if Config = null then
1132          Config := new Command_Line_Configuration_Record;
1133       end if;
1134
1135       Add (Config.Sections, new String'(Section));
1136    end Define_Section;
1137
1138    ------------------
1139    -- Get_Switches --
1140    ------------------
1141
1142    function Get_Switches
1143      (Config      : Command_Line_Configuration;
1144       Switch_Char : Character)
1145       return String
1146    is
1147       Ret : Ada.Strings.Unbounded.Unbounded_String;
1148       use type Ada.Strings.Unbounded.Unbounded_String;
1149
1150    begin
1151       if Config = null or else Config.Switches = null then
1152          return "";
1153       end if;
1154
1155       for J in Config.Switches'Range loop
1156          if Config.Switches (J) (Config.Switches (J)'First) = Switch_Char then
1157             Ret :=
1158               Ret & " " &
1159                 Config.Switches (J)
1160                   (Config.Switches (J)'First + 1 .. Config.Switches (J)'Last);
1161          else
1162             Ret := Ret & " " & Config.Switches (J).all;
1163          end if;
1164       end loop;
1165
1166       return Ada.Strings.Unbounded.To_String (Ret);
1167    end Get_Switches;
1168
1169    -----------------------
1170    -- Set_Configuration --
1171    -----------------------
1172
1173    procedure Set_Configuration
1174      (Cmd    : in out Command_Line;
1175       Config : Command_Line_Configuration)
1176    is
1177    begin
1178       Cmd.Config := Config;
1179    end Set_Configuration;
1180
1181    -----------------------
1182    -- Get_Configuration --
1183    -----------------------
1184
1185    function Get_Configuration
1186      (Cmd : Command_Line) return Command_Line_Configuration is
1187    begin
1188       return Cmd.Config;
1189    end Get_Configuration;
1190
1191    ----------------------
1192    -- Set_Command_Line --
1193    ----------------------
1194
1195    procedure Set_Command_Line
1196      (Cmd                : in out Command_Line;
1197       Switches           : String;
1198       Getopt_Description : String := "";
1199       Switch_Char        : Character := '-')
1200    is
1201       Tmp     : Argument_List_Access;
1202       Parser  : Opt_Parser;
1203       S       : Character;
1204       Section : String_Access := null;
1205
1206       function Real_Full_Switch
1207         (S      : Character;
1208          Parser : Opt_Parser) return String;
1209       --  Ensure that the returned switch value contains the
1210       --  Switch_Char prefix if needed.
1211
1212       ----------------------
1213       -- Real_Full_Switch --
1214       ----------------------
1215
1216       function Real_Full_Switch
1217         (S      : Character;
1218          Parser : Opt_Parser) return String
1219       is
1220       begin
1221          if S = '*' then
1222             return Full_Switch (Parser);
1223          else
1224             return Switch_Char & Full_Switch (Parser);
1225          end if;
1226       end Real_Full_Switch;
1227
1228    --  Start of processing for Set_Command_Line
1229
1230    begin
1231       Free (Cmd.Expanded);
1232       Free (Cmd.Params);
1233
1234       if Switches /= "" then
1235          Tmp := Argument_String_To_List (Switches);
1236          Initialize_Option_Scan (Parser, Tmp, Switch_Char);
1237
1238          loop
1239             begin
1240                S := Getopt (Switches    => "* " & Getopt_Description,
1241                             Concatenate => False,
1242                             Parser      => Parser);
1243                exit when S = ASCII.NUL;
1244
1245                declare
1246                   Sw         : constant String :=
1247                                  Real_Full_Switch (S, Parser);
1248                   Is_Section : Boolean := False;
1249
1250                begin
1251                   if Cmd.Config /= null
1252                     and then Cmd.Config.Sections /= null
1253                   then
1254                      Section_Search :
1255                      for S in Cmd.Config.Sections'Range loop
1256                         if Sw = Cmd.Config.Sections (S).all then
1257                            Section := Cmd.Config.Sections (S);
1258                            Is_Section := True;
1259
1260                            exit Section_Search;
1261                         end if;
1262                      end loop Section_Search;
1263                   end if;
1264
1265                   if not Is_Section then
1266                      if Section = null then
1267
1268                         --  Work around some weird cases: some switches may
1269                         --  expect parameters, but have the same value as
1270                         --  longer switches: -gnaty3 (-gnaty, parameter=3) and
1271                         --  -gnatya (-gnatya, no parameter).
1272
1273                         --  So we are calling add_switch here with parameter
1274                         --  attached. This will be anyway correctly handled by
1275                         --  Add_Switch if -gnaty3 is actually provided.
1276
1277                         if Separator (Parser) = ASCII.NUL then
1278                            Add_Switch
1279                              (Cmd, Sw & Parameter (Parser), "", ASCII.NUL);
1280                         else
1281                            Add_Switch
1282                              (Cmd, Sw, Parameter (Parser), Separator (Parser));
1283                         end if;
1284                      else
1285                         if Separator (Parser) = ASCII.NUL then
1286                            Add_Switch
1287                              (Cmd, Sw & Parameter (Parser), "",
1288                               Separator (Parser),
1289                               Section.all);
1290                         else
1291                            Add_Switch
1292                              (Cmd, Sw,
1293                               Parameter (Parser),
1294                               Separator (Parser),
1295                               Section.all);
1296                         end if;
1297                      end if;
1298                   end if;
1299                end;
1300
1301             exception
1302                when Invalid_Parameter =>
1303
1304                   --  Add it with no parameter, if that's the way the user
1305                   --  wants it.
1306
1307                   --  Specify the separator in all cases, as the switch might
1308                   --  need to be unaliased, and the alias might contain
1309                   --  switches with parameters.
1310
1311                   if Section = null then
1312                      Add_Switch
1313                        (Cmd, Switch_Char & Full_Switch (Parser),
1314                         Separator => Separator (Parser));
1315                   else
1316                      Add_Switch
1317                        (Cmd, Switch_Char & Full_Switch (Parser),
1318                         Separator => Separator (Parser),
1319                         Section   => Section.all);
1320                   end if;
1321             end;
1322          end loop;
1323
1324          Free (Parser);
1325       end if;
1326    end Set_Command_Line;
1327
1328    ----------------
1329    -- Looking_At --
1330    ----------------
1331
1332    function Looking_At
1333      (Type_Str  : String;
1334       Index     : Natural;
1335       Substring : String) return Boolean is
1336    begin
1337       return Index + Substring'Length - 1 <= Type_Str'Last
1338         and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
1339    end Looking_At;
1340
1341    ------------------------
1342    -- Can_Have_Parameter --
1343    ------------------------
1344
1345    function Can_Have_Parameter (S : String) return Boolean is
1346    begin
1347       if S'Length <= 1 then
1348          return False;
1349       end if;
1350
1351       case S (S'Last) is
1352          when '!' | ':' | '?' | '=' =>
1353             return True;
1354          when others =>
1355             return False;
1356       end case;
1357    end Can_Have_Parameter;
1358
1359    -----------------------
1360    -- Require_Parameter --
1361    -----------------------
1362
1363    function Require_Parameter (S : String) return Boolean is
1364    begin
1365       if S'Length <= 1 then
1366          return False;
1367       end if;
1368
1369       case S (S'Last) is
1370          when '!' | ':' | '=' =>
1371             return True;
1372          when others =>
1373             return False;
1374       end case;
1375    end Require_Parameter;
1376
1377    -------------------
1378    -- Actual_Switch --
1379    -------------------
1380
1381    function Actual_Switch (S : String) return String is
1382    begin
1383       if S'Length <= 1 then
1384          return S;
1385       end if;
1386
1387       case S (S'Last) is
1388          when '!' | ':' | '?' | '=' =>
1389             return S (S'First .. S'Last - 1);
1390          when others =>
1391             return S;
1392       end case;
1393    end Actual_Switch;
1394
1395    ----------------------------
1396    -- For_Each_Simple_Switch --
1397    ----------------------------
1398
1399    procedure For_Each_Simple_Switch
1400      (Cmd       : Command_Line;
1401       Switch    : String;
1402       Parameter : String := "";
1403       Unalias   : Boolean := True)
1404    is
1405       function Group_Analysis
1406         (Prefix : String;
1407          Group  : String) return Boolean;
1408       --  Perform the analysis of a group of switches
1409
1410       --------------------
1411       -- Group_Analysis --
1412       --------------------
1413
1414       function Group_Analysis
1415         (Prefix : String;
1416          Group  : String) return Boolean
1417       is
1418          Idx   : Natural;
1419          Found : Boolean;
1420
1421       begin
1422          Idx := Group'First;
1423          while Idx <= Group'Last loop
1424             Found := False;
1425
1426             for S in Cmd.Config.Switches'Range loop
1427                declare
1428                   Sw              : constant String :=
1429                                       Actual_Switch
1430                                         (Cmd.Config.Switches (S).all);
1431                   Full            : constant String :=
1432                                       Prefix & Group (Idx .. Group'Last);
1433                   Last            : Natural;
1434                   Param           : Natural;
1435
1436                begin
1437                   if Sw'Length >= Prefix'Length
1438
1439                      --  Verify that sw starts with Prefix
1440
1441                      and then Looking_At (Sw, Sw'First, Prefix)
1442
1443                      --  Verify that the group starts with sw
1444
1445                      and then Looking_At (Full, Full'First, Sw)
1446                   then
1447                      Last := Idx + Sw'Length - Prefix'Length - 1;
1448                      Param := Last + 1;
1449
1450                      if Can_Have_Parameter (Cmd.Config.Switches (S).all) then
1451
1452                         --  Include potential parameter to the recursive call.
1453                         --  Only numbers are allowed.
1454
1455                         while Last < Group'Last
1456                           and then Group (Last + 1) in '0' .. '9'
1457                         loop
1458                            Last := Last + 1;
1459                         end loop;
1460                      end if;
1461
1462                      if not Require_Parameter (Cmd.Config.Switches (S).all)
1463                        or else Last >= Param
1464                      then
1465                         if Idx = Group'First
1466                           and then Last = Group'Last
1467                           and then Last < Param
1468                         then
1469                            --  The group only concerns a single switch. Do not
1470                            --  perform recursive call.
1471
1472                            --  Note that we still perform a recursive call if
1473                            --  a parameter is detected in the switch, as this
1474                            --  is a way to correctly identify such a parameter
1475                            --  in aliases.
1476
1477                            return False;
1478                         end if;
1479
1480                         Found := True;
1481
1482                         --  Recursive call, using the detected parameter if any
1483
1484                         if Last >= Param then
1485                            For_Each_Simple_Switch
1486                              (Cmd,
1487                               Prefix & Group (Idx .. Param - 1),
1488                               Group (Param .. Last));
1489                         else
1490                            For_Each_Simple_Switch
1491                              (Cmd, Prefix & Group (Idx .. Last), "");
1492                         end if;
1493
1494                         Idx := Last + 1;
1495                         exit;
1496                      end if;
1497                   end if;
1498                end;
1499             end loop;
1500
1501             if not Found then
1502                For_Each_Simple_Switch (Cmd, Prefix & Group (Idx), "");
1503                Idx := Idx + 1;
1504             end if;
1505          end loop;
1506
1507          return True;
1508       end Group_Analysis;
1509
1510    begin
1511       --  First determine if the switch corresponds to one belonging to the
1512       --  configuration. If so, run callback and exit.
1513
1514       if Cmd.Config /= null and then Cmd.Config.Switches /= null then
1515          for S in Cmd.Config.Switches'Range loop
1516             declare
1517                Config_Switch : String renames Cmd.Config.Switches (S).all;
1518             begin
1519                if Actual_Switch (Config_Switch) = Switch
1520                     and then
1521                   ((Can_Have_Parameter (Config_Switch)
1522                       and then Parameter /= "")
1523                    or else
1524                    (not Require_Parameter (Config_Switch)
1525                        and then Parameter = ""))
1526                then
1527                   Callback (Switch, Parameter);
1528                   return;
1529                end if;
1530             end;
1531          end loop;
1532       end if;
1533
1534       --  If adding a switch that can in fact be expanded through aliases,
1535       --  add separately each of its expansions.
1536
1537       --  This takes care of expansions like "-T" -> "-gnatwrs", where the
1538       --  alias and its expansion do not have the same prefix. Given the order
1539       --  in which we do things here, the expansion of the alias will itself
1540       --  be checked for a common prefix and split into simple switches.
1541
1542       if Unalias
1543         and then Cmd.Config /= null
1544         and then Cmd.Config.Aliases /= null
1545       then
1546          for A in Cmd.Config.Aliases'Range loop
1547             if Cmd.Config.Aliases (A).all = Switch and then Parameter = "" then
1548                For_Each_Simple_Switch
1549                  (Cmd, Cmd.Config.Expansions (A).all, "");
1550                return;
1551             end if;
1552          end loop;
1553       end if;
1554
1555       --  If adding a switch grouping several switches, add each of the simple
1556       --  switches instead.
1557
1558       if Cmd.Config /= null and then Cmd.Config.Prefixes /= null then
1559          for P in Cmd.Config.Prefixes'Range loop
1560             if Switch'Length > Cmd.Config.Prefixes (P)'Length + 1
1561               and then Looking_At
1562                 (Switch, Switch'First, Cmd.Config.Prefixes (P).all)
1563             then
1564                --  Alias expansion will be done recursively
1565
1566                if Cmd.Config.Switches = null then
1567                   for S in Switch'First + Cmd.Config.Prefixes (P)'Length
1568                             .. Switch'Last
1569                   loop
1570                      For_Each_Simple_Switch
1571                        (Cmd, Cmd.Config.Prefixes (P).all & Switch (S), "");
1572                   end loop;
1573
1574                   return;
1575
1576                elsif Group_Analysis
1577                  (Cmd.Config.Prefixes (P).all,
1578                   Switch
1579                     (Switch'First + Cmd.Config.Prefixes (P)'Length
1580                       .. Switch'Last))
1581                then
1582                   --  Recursive calls already done on each switch of the group:
1583                   --  Return without executing Callback.
1584
1585                   return;
1586                end if;
1587             end if;
1588          end loop;
1589       end if;
1590
1591       --  Test if added switch is a known switch with parameter attached
1592
1593       if Parameter = ""
1594         and then Cmd.Config /= null
1595         and then Cmd.Config.Switches /= null
1596       then
1597          for S in Cmd.Config.Switches'Range loop
1598             declare
1599                Sw    : constant String :=
1600                          Actual_Switch (Cmd.Config.Switches (S).all);
1601                Last  : Natural;
1602                Param : Natural;
1603
1604             begin
1605                --  Verify that switch starts with Sw
1606                --  What if the "verification" fails???
1607
1608                if Switch'Length >= Sw'Length
1609                  and then Looking_At (Switch, Switch'First, Sw)
1610                then
1611                   Param := Switch'First + Sw'Length - 1;
1612                   Last := Param;
1613
1614                   if Can_Have_Parameter (Cmd.Config.Switches (S).all) then
1615                      while Last < Switch'Last
1616                        and then Switch (Last + 1) in '0' .. '9'
1617                      loop
1618                         Last := Last + 1;
1619                      end loop;
1620                   end if;
1621
1622                   --  If full Switch is a known switch with attached parameter
1623                   --  then we use this parameter in the callback.
1624
1625                   if Last = Switch'Last then
1626                      Callback
1627                        (Switch (Switch'First .. Param),
1628                         Switch (Param + 1 .. Last));
1629                      return;
1630
1631                   end if;
1632                end if;
1633             end;
1634          end loop;
1635       end if;
1636
1637       Callback (Switch, Parameter);
1638    end For_Each_Simple_Switch;
1639
1640    ----------------
1641    -- Add_Switch --
1642    ----------------
1643
1644    procedure Add_Switch
1645      (Cmd        : in out Command_Line;
1646       Switch     : String;
1647       Parameter  : String    := "";
1648       Separator  : Character := ' ';
1649       Section    : String    := "";
1650       Add_Before : Boolean   := False)
1651    is
1652       Success : Boolean;
1653       pragma Unreferenced (Success);
1654    begin
1655       Add_Switch
1656         (Cmd, Switch, Parameter, Separator, Section, Add_Before, Success);
1657    end Add_Switch;
1658
1659    ----------------
1660    -- Add_Switch --
1661    ----------------
1662
1663    procedure Add_Switch
1664      (Cmd        : in out Command_Line;
1665       Switch     : String;
1666       Parameter  : String := "";
1667       Separator  : Character := ' ';
1668       Section    : String := "";
1669       Add_Before : Boolean := False;
1670       Success    : out Boolean)
1671    is
1672       procedure Add_Simple_Switch (Simple : String; Param : String);
1673       --  Add a new switch that has had all its aliases expanded, and switches
1674       --  ungrouped. We know there are no more aliases in Switches.
1675
1676       -----------------------
1677       -- Add_Simple_Switch --
1678       -----------------------
1679
1680       procedure Add_Simple_Switch (Simple : String; Param : String) is
1681       begin
1682          if Cmd.Expanded = null then
1683             Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
1684
1685             if Param /= "" then
1686                Cmd.Params := new Argument_List'
1687                  (1 .. 1 => new String'(Separator & Param));
1688
1689             else
1690                Cmd.Params := new Argument_List'(1 .. 1 => null);
1691             end if;
1692
1693             if Section = "" then
1694                Cmd.Sections := new Argument_List'(1 .. 1 => null);
1695
1696             else
1697                Cmd.Sections := new Argument_List'
1698                  (1 .. 1 => new String'(Section));
1699             end if;
1700
1701          else
1702             --  Do we already have this switch?
1703
1704             for C in Cmd.Expanded'Range loop
1705                if Cmd.Expanded (C).all = Simple
1706                  and then
1707                    ((Cmd.Params (C) = null and then Param = "")
1708                      or else
1709                        (Cmd.Params (C) /= null
1710                          and then Cmd.Params (C).all = Separator & Param))
1711                  and then
1712                    ((Cmd.Sections (C) = null and then Section = "")
1713                      or else
1714                        (Cmd.Sections (C) /= null
1715                          and then Cmd.Sections (C).all = Section))
1716                then
1717                   return;
1718                end if;
1719             end loop;
1720
1721             --  Inserting at least one switch
1722
1723             Success := True;
1724             Add (Cmd.Expanded, new String'(Simple), Add_Before);
1725
1726             if Param /= "" then
1727                Add
1728                  (Cmd.Params,
1729                   new String'(Separator & Param),
1730                   Add_Before);
1731
1732             else
1733                Add
1734                  (Cmd.Params,
1735                   null,
1736                   Add_Before);
1737             end if;
1738
1739             if Section = "" then
1740                Add
1741                  (Cmd.Sections,
1742                   null,
1743                   Add_Before);
1744             else
1745                Add
1746                  (Cmd.Sections,
1747                   new String'(Section),
1748                   Add_Before);
1749             end if;
1750          end if;
1751       end Add_Simple_Switch;
1752
1753       procedure Add_Simple_Switches is
1754          new For_Each_Simple_Switch (Add_Simple_Switch);
1755
1756    --  Start of processing for Add_Switch
1757
1758    begin
1759       Success := False;
1760       Add_Simple_Switches (Cmd, Switch, Parameter);
1761       Free (Cmd.Coalesce);
1762    end Add_Switch;
1763
1764    ------------
1765    -- Remove --
1766    ------------
1767
1768    procedure Remove (Line : in out Argument_List_Access; Index : Integer) is
1769       Tmp : Argument_List_Access := Line;
1770
1771    begin
1772       Line := new Argument_List (Tmp'First .. Tmp'Last - 1);
1773
1774       if Index /= Tmp'First then
1775          Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1);
1776       end if;
1777
1778       Free (Tmp (Index));
1779
1780       if Index /= Tmp'Last then
1781          Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last);
1782       end if;
1783
1784       Unchecked_Free (Tmp);
1785    end Remove;
1786
1787    ---------
1788    -- Add --
1789    ---------
1790
1791    procedure Add
1792      (Line   : in out Argument_List_Access;
1793       Str    : String_Access;
1794       Before : Boolean := False)
1795    is
1796       Tmp : Argument_List_Access := Line;
1797
1798    begin
1799       if Tmp /= null then
1800          Line := new Argument_List (Tmp'First .. Tmp'Last + 1);
1801
1802          if Before then
1803             Line (Tmp'First)                     := Str;
1804             Line (Tmp'First + 1 .. Tmp'Last + 1) := Tmp.all;
1805          else
1806             Line (Tmp'Range)    := Tmp.all;
1807             Line (Tmp'Last + 1) := Str;
1808          end if;
1809
1810          Unchecked_Free (Tmp);
1811
1812       else
1813          Line := new Argument_List'(1 .. 1 => Str);
1814       end if;
1815    end Add;
1816
1817    -------------------
1818    -- Remove_Switch --
1819    -------------------
1820
1821    procedure Remove_Switch
1822      (Cmd           : in out Command_Line;
1823       Switch        : String;
1824       Remove_All    : Boolean := False;
1825       Has_Parameter : Boolean := False;
1826       Section       : String := "")
1827    is
1828       Success : Boolean;
1829       pragma Unreferenced (Success);
1830    begin
1831       Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success);
1832    end Remove_Switch;
1833
1834    -------------------
1835    -- Remove_Switch --
1836    -------------------
1837
1838    procedure Remove_Switch
1839      (Cmd           : in out Command_Line;
1840       Switch        : String;
1841       Remove_All    : Boolean := False;
1842       Has_Parameter : Boolean := False;
1843       Section       : String  := "";
1844       Success       : out Boolean)
1845    is
1846       procedure Remove_Simple_Switch (Simple : String; Param : String);
1847       --  Removes a simple switch, with no aliasing or grouping
1848
1849       --------------------------
1850       -- Remove_Simple_Switch --
1851       --------------------------
1852
1853       procedure Remove_Simple_Switch (Simple : String; Param : String) is
1854          C : Integer;
1855          pragma Unreferenced (Param);
1856
1857       begin
1858          if Cmd.Expanded /= null then
1859             C := Cmd.Expanded'First;
1860             while C <= Cmd.Expanded'Last loop
1861                if Cmd.Expanded (C).all = Simple
1862                  and then
1863                    (Remove_All
1864                      or else (Cmd.Sections (C) = null
1865                                and then Section = "")
1866                      or else (Cmd.Sections (C) /= null
1867                                and then Section = Cmd.Sections (C).all))
1868                  and then (not Has_Parameter or else Cmd.Params (C) /= null)
1869                then
1870                   Remove (Cmd.Expanded, C);
1871                   Remove (Cmd.Params, C);
1872                   Remove (Cmd.Sections, C);
1873                   Success := True;
1874
1875                   if not Remove_All then
1876                      return;
1877                   end if;
1878
1879                else
1880                   C := C + 1;
1881                end if;
1882             end loop;
1883          end if;
1884       end Remove_Simple_Switch;
1885
1886       procedure Remove_Simple_Switches is
1887         new For_Each_Simple_Switch (Remove_Simple_Switch);
1888
1889    --  Start of processing for Remove_Switch
1890
1891    begin
1892       Success := False;
1893       Remove_Simple_Switches (Cmd, Switch, "", Unalias => not Has_Parameter);
1894       Free (Cmd.Coalesce);
1895    end Remove_Switch;
1896
1897    -------------------
1898    -- Remove_Switch --
1899    -------------------
1900
1901    procedure Remove_Switch
1902      (Cmd       : in out Command_Line;
1903       Switch    : String;
1904       Parameter : String;
1905       Section   : String  := "")
1906    is
1907       procedure Remove_Simple_Switch (Simple : String; Param : String);
1908       --  Removes a simple switch, with no aliasing or grouping
1909
1910       --------------------------
1911       -- Remove_Simple_Switch --
1912       --------------------------
1913
1914       procedure Remove_Simple_Switch (Simple : String; Param : String) is
1915          C : Integer;
1916
1917       begin
1918          if Cmd.Expanded /= null then
1919             C := Cmd.Expanded'First;
1920             while C <= Cmd.Expanded'Last loop
1921                if Cmd.Expanded (C).all = Simple
1922                  and then
1923                    ((Cmd.Sections (C) = null
1924                       and then Section = "")
1925                     or else
1926                       (Cmd.Sections (C) /= null
1927                         and then Section = Cmd.Sections (C).all))
1928                  and then
1929                    ((Cmd.Params (C) = null and then Param = "")
1930                       or else
1931                         (Cmd.Params (C) /= null
1932                            and then
1933
1934                            --  Ignore the separator stored in Parameter
1935
1936                              Cmd.Params (C) (Cmd.Params (C)'First + 1
1937                                              .. Cmd.Params (C)'Last) =
1938                            Param))
1939                then
1940                   Remove (Cmd.Expanded, C);
1941                   Remove (Cmd.Params, C);
1942                   Remove (Cmd.Sections, C);
1943
1944                   --  The switch is necessarily unique by construction of
1945                   --  Add_Switch.
1946
1947                   return;
1948
1949                else
1950                   C := C + 1;
1951                end if;
1952             end loop;
1953          end if;
1954       end Remove_Simple_Switch;
1955
1956       procedure Remove_Simple_Switches is
1957          new For_Each_Simple_Switch (Remove_Simple_Switch);
1958
1959    --  Start of processing for Remove_Switch
1960
1961    begin
1962       Remove_Simple_Switches (Cmd, Switch, Parameter);
1963       Free (Cmd.Coalesce);
1964    end Remove_Switch;
1965
1966    --------------------
1967    -- Group_Switches --
1968    --------------------
1969
1970    procedure Group_Switches
1971      (Cmd      : Command_Line;
1972       Result   : Argument_List_Access;
1973       Sections : Argument_List_Access;
1974       Params   : Argument_List_Access)
1975    is
1976       function Compatible_Parameter (Param : String_Access) return Boolean;
1977       --  True when the parameter can be part of a group
1978
1979       --------------------------
1980       -- Compatible_Parameter --
1981       --------------------------
1982
1983       function Compatible_Parameter (Param : String_Access) return Boolean is
1984       begin
1985          --  No parameter OK
1986
1987          if Param = null then
1988             return True;
1989
1990          --  We need parameters without separators
1991
1992          elsif Param (Param'First) /= ASCII.NUL then
1993             return False;
1994
1995          --  Parameters must be all digits
1996
1997          else
1998             for J in Param'First + 1 .. Param'Last loop
1999                if Param (J) not in '0' .. '9' then
2000                   return False;
2001                end if;
2002             end loop;
2003
2004             return True;
2005          end if;
2006       end Compatible_Parameter;
2007
2008       --  Local declarations
2009
2010       Group : Ada.Strings.Unbounded.Unbounded_String;
2011       First : Natural;
2012       use type Ada.Strings.Unbounded.Unbounded_String;
2013
2014    --  Start of processing for Group_Switches
2015
2016    begin
2017       if Cmd.Config = null
2018         or else Cmd.Config.Prefixes = null
2019       then
2020          return;
2021       end if;
2022
2023       for P in Cmd.Config.Prefixes'Range loop
2024          Group   := Ada.Strings.Unbounded.Null_Unbounded_String;
2025          First   := 0;
2026
2027          for C in Result'Range loop
2028             if Result (C) /= null
2029               and then Compatible_Parameter (Params (C))
2030               and then Looking_At
2031                 (Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all)
2032             then
2033                --  If we are still in the same section, group the switches
2034
2035                if First = 0
2036                  or else
2037                    (Sections (C) = null
2038                      and then Sections (First) = null)
2039                  or else
2040                    (Sections (C) /= null
2041                      and then Sections (First) /= null
2042                      and then Sections (C).all = Sections (First).all)
2043                then
2044                   Group :=
2045                     Group &
2046                       Result (C)
2047                         (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2048                          Result (C)'Last);
2049
2050                   if Params (C) /= null then
2051                      Group :=
2052                        Group &
2053                          Params (C) (Params (C)'First + 1 .. Params (C)'Last);
2054                      Free (Params (C));
2055                   end if;
2056
2057                   if First = 0 then
2058                      First := C;
2059                   end if;
2060
2061                   Free (Result (C));
2062
2063                else
2064                   --  We changed section: we put the grouped switches to the
2065                   --  first place, on continue with the new section.
2066
2067                   Result (First) :=
2068                     new String'
2069                       (Cmd.Config.Prefixes (P).all &
2070                        Ada.Strings.Unbounded.To_String (Group));
2071                   Group :=
2072                     Ada.Strings.Unbounded.To_Unbounded_String
2073                       (Result (C)
2074                        (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2075                             Result (C)'Last));
2076                   First := C;
2077                end if;
2078             end if;
2079          end loop;
2080
2081          if First > 0 then
2082             Result (First) :=
2083               new String'
2084                 (Cmd.Config.Prefixes (P).all &
2085                  Ada.Strings.Unbounded.To_String (Group));
2086          end if;
2087       end loop;
2088    end Group_Switches;
2089
2090    --------------------
2091    -- Alias_Switches --
2092    --------------------
2093
2094    procedure Alias_Switches
2095      (Cmd    : Command_Line;
2096       Result : Argument_List_Access;
2097       Params : Argument_List_Access)
2098    is
2099       Found : Boolean;
2100       First : Natural;
2101
2102       procedure Check_Cb (Switch : String; Param : String);
2103       --  Comment required ???
2104
2105       procedure Remove_Cb (Switch : String; Param : String);
2106       --  Comment required ???
2107
2108       --------------
2109       -- Check_Cb --
2110       --------------
2111
2112       procedure Check_Cb (Switch : String; Param : String) is
2113       begin
2114          if Found then
2115             for E in Result'Range loop
2116                if Result (E) /= null
2117                  and then
2118                    (Params (E) = null
2119                     or else Params (E) (Params (E)'First + 1
2120                                             .. Params (E)'Last) = Param)
2121                  and then Result (E).all = Switch
2122                then
2123                   return;
2124                end if;
2125             end loop;
2126
2127             Found := False;
2128          end if;
2129       end Check_Cb;
2130
2131       ---------------
2132       -- Remove_Cb --
2133       ---------------
2134
2135       procedure Remove_Cb (Switch : String; Param : String) is
2136       begin
2137          for E in Result'Range loop
2138             if Result (E) /= null
2139                  and then
2140                    (Params (E) = null
2141                     or else Params (E) (Params (E)'First + 1
2142                                             .. Params (E)'Last) = Param)
2143               and then Result (E).all = Switch
2144             then
2145                if First > E then
2146                   First := E;
2147                end if;
2148                Free (Result (E));
2149                Free (Params (E));
2150                return;
2151             end if;
2152          end loop;
2153       end Remove_Cb;
2154
2155       procedure Check_All is new For_Each_Simple_Switch (Check_Cb);
2156       procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb);
2157
2158    --  Start of processing for Alias_Switches
2159
2160    begin
2161       if Cmd.Config = null
2162         or else Cmd.Config.Aliases = null
2163       then
2164          return;
2165       end if;
2166
2167       for A in Cmd.Config.Aliases'Range loop
2168
2169          --  Compute the various simple switches that make up the alias. We
2170          --  split the expansion into as many simple switches as possible, and
2171          --  then check whether the expanded command line has all of them.
2172
2173          Found := True;
2174          Check_All (Cmd, Cmd.Config.Expansions (A).all);
2175
2176          if Found then
2177             First := Integer'Last;
2178             Remove_All (Cmd, Cmd.Config.Expansions (A).all);
2179             Result (First) := new String'(Cmd.Config.Aliases (A).all);
2180          end if;
2181       end loop;
2182    end Alias_Switches;
2183
2184    -------------------
2185    -- Sort_Sections --
2186    -------------------
2187
2188    procedure Sort_Sections
2189      (Line     : GNAT.OS_Lib.Argument_List_Access;
2190       Sections : GNAT.OS_Lib.Argument_List_Access;
2191       Params   : GNAT.OS_Lib.Argument_List_Access)
2192    is
2193       Sections_List : Argument_List_Access :=
2194                         new Argument_List'(1 .. 1 => null);
2195       Found         : Boolean;
2196       Old_Line      : constant Argument_List := Line.all;
2197       Old_Sections  : constant Argument_List := Sections.all;
2198       Old_Params    : constant Argument_List := Params.all;
2199       Index         : Natural;
2200
2201    begin
2202       if Line = null then
2203          return;
2204       end if;
2205
2206       --  First construct a list of all sections
2207
2208       for E in Line'Range loop
2209          if Sections (E) /= null then
2210             Found := False;
2211             for S in Sections_List'Range loop
2212                if (Sections_List (S) = null and then Sections (E) = null)
2213                  or else
2214                    (Sections_List (S) /= null
2215                      and then Sections (E) /= null
2216                      and then Sections_List (S).all = Sections (E).all)
2217                then
2218                   Found := True;
2219                   exit;
2220                end if;
2221             end loop;
2222
2223             if not Found then
2224                Add (Sections_List, Sections (E));
2225             end if;
2226          end if;
2227       end loop;
2228
2229       Index := Line'First;
2230
2231       for S in Sections_List'Range loop
2232          for E in Old_Line'Range loop
2233             if (Sections_List (S) = null and then Old_Sections (E) = null)
2234               or else
2235                 (Sections_List (S) /= null
2236                   and then Old_Sections (E) /= null
2237                   and then Sections_List (S).all = Old_Sections (E).all)
2238             then
2239                Line (Index) := Old_Line (E);
2240                Sections (Index) := Old_Sections (E);
2241                Params (Index) := Old_Params (E);
2242                Index := Index + 1;
2243             end if;
2244          end loop;
2245       end loop;
2246    end Sort_Sections;
2247
2248    -----------
2249    -- Start --
2250    -----------
2251
2252    procedure Start
2253      (Cmd      : in out Command_Line;
2254       Iter     : in out Command_Line_Iterator;
2255       Expanded : Boolean)
2256    is
2257    begin
2258       if Cmd.Expanded = null then
2259          Iter.List := null;
2260          return;
2261       end if;
2262
2263       --  Reorder the expanded line so that sections are grouped
2264
2265       Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params);
2266
2267       --  Coalesce the switches as much as possible
2268
2269       if not Expanded
2270         and then Cmd.Coalesce = null
2271       then
2272          Cmd.Coalesce := new Argument_List (Cmd.Expanded'Range);
2273          for E in Cmd.Expanded'Range loop
2274             Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all);
2275          end loop;
2276
2277          Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
2278          for E in Cmd.Sections'Range loop
2279             Cmd.Coalesce_Sections (E) :=
2280               (if Cmd.Sections (E) = null then null
2281                else new String'(Cmd.Sections (E).all));
2282          end loop;
2283
2284          Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range);
2285          for E in Cmd.Params'Range loop
2286             Cmd.Coalesce_Params (E) :=
2287               (if Cmd.Params (E) = null then null
2288                else new String'(Cmd.Params (E).all));
2289          end loop;
2290
2291          --  Not a clone, since we will not modify the parameters anyway
2292
2293          Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params);
2294          Group_Switches
2295            (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params);
2296       end if;
2297
2298       if Expanded then
2299          Iter.List     := Cmd.Expanded;
2300          Iter.Params   := Cmd.Params;
2301          Iter.Sections := Cmd.Sections;
2302       else
2303          Iter.List     := Cmd.Coalesce;
2304          Iter.Params   := Cmd.Coalesce_Params;
2305          Iter.Sections := Cmd.Coalesce_Sections;
2306       end if;
2307
2308       if Iter.List = null then
2309          Iter.Current := Integer'Last;
2310       else
2311          Iter.Current := Iter.List'First;
2312
2313          while Iter.Current <= Iter.List'Last
2314            and then Iter.List (Iter.Current) = null
2315          loop
2316             Iter.Current := Iter.Current + 1;
2317          end loop;
2318       end if;
2319    end Start;
2320
2321    --------------------
2322    -- Current_Switch --
2323    --------------------
2324
2325    function Current_Switch (Iter : Command_Line_Iterator) return String is
2326    begin
2327       return Iter.List (Iter.Current).all;
2328    end Current_Switch;
2329
2330    --------------------
2331    -- Is_New_Section --
2332    --------------------
2333
2334    function Is_New_Section    (Iter : Command_Line_Iterator) return Boolean is
2335       Section : constant String := Current_Section (Iter);
2336    begin
2337       if Iter.Sections = null then
2338          return False;
2339       elsif Iter.Current = Iter.Sections'First
2340         or else Iter.Sections (Iter.Current - 1) = null
2341       then
2342          return Section /= "";
2343       end if;
2344
2345       return Section /= Iter.Sections (Iter.Current - 1).all;
2346    end Is_New_Section;
2347
2348    ---------------------
2349    -- Current_Section --
2350    ---------------------
2351
2352    function Current_Section (Iter : Command_Line_Iterator) return String is
2353    begin
2354       if Iter.Sections = null
2355         or else Iter.Current > Iter.Sections'Last
2356         or else Iter.Sections (Iter.Current) = null
2357       then
2358          return "";
2359       end if;
2360
2361       return Iter.Sections (Iter.Current).all;
2362    end Current_Section;
2363
2364    -----------------------
2365    -- Current_Separator --
2366    -----------------------
2367
2368    function Current_Separator (Iter : Command_Line_Iterator) return String is
2369    begin
2370       if Iter.Params = null
2371         or else Iter.Current > Iter.Params'Last
2372         or else Iter.Params (Iter.Current) = null
2373       then
2374          return "";
2375
2376       else
2377          declare
2378             Sep : constant Character :=
2379               Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First);
2380          begin
2381             if Sep = ASCII.NUL then
2382                return "";
2383             else
2384                return "" & Sep;
2385             end if;
2386          end;
2387       end if;
2388    end Current_Separator;
2389
2390    -----------------------
2391    -- Current_Parameter --
2392    -----------------------
2393
2394    function Current_Parameter (Iter : Command_Line_Iterator) return String is
2395    begin
2396       if Iter.Params = null
2397         or else Iter.Current > Iter.Params'Last
2398         or else Iter.Params (Iter.Current) = null
2399       then
2400          return "";
2401
2402       else
2403          declare
2404             P : constant String := Iter.Params (Iter.Current).all;
2405
2406          begin
2407             --  Skip separator
2408
2409             return P (P'First + 1 .. P'Last);
2410          end;
2411       end if;
2412    end Current_Parameter;
2413
2414    --------------
2415    -- Has_More --
2416    --------------
2417
2418    function Has_More (Iter : Command_Line_Iterator) return Boolean is
2419    begin
2420       return Iter.List /= null and then Iter.Current <= Iter.List'Last;
2421    end Has_More;
2422
2423    ----------
2424    -- Next --
2425    ----------
2426
2427    procedure Next (Iter : in out Command_Line_Iterator) is
2428    begin
2429       Iter.Current := Iter.Current + 1;
2430       while Iter.Current <= Iter.List'Last
2431         and then Iter.List (Iter.Current) = null
2432       loop
2433          Iter.Current := Iter.Current + 1;
2434       end loop;
2435    end Next;
2436
2437    ----------
2438    -- Free --
2439    ----------
2440
2441    procedure Free (Config : in out Command_Line_Configuration) is
2442    begin
2443       if Config /= null then
2444          Free (Config.Aliases);
2445          Free (Config.Expansions);
2446          Free (Config.Prefixes);
2447          Free (Config.Sections);
2448          Free (Config.Switches);
2449          Unchecked_Free (Config);
2450       end if;
2451    end Free;
2452
2453    ----------
2454    -- Free --
2455    ----------
2456
2457    procedure Free (Cmd : in out Command_Line) is
2458    begin
2459       Free (Cmd.Expanded);
2460       Free (Cmd.Coalesce);
2461       Free (Cmd.Params);
2462    end Free;
2463
2464 end GNAT.Command_Line;