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             if Concatenate then
 578                End_Index := Parser.Current_Index;
 579             else
 580                End_Index := Arg'Last;
 581             end if;
 582
 583             if Switches (Switches'First) = '*' then
 584
 585                --  Always prepend the switch character, so that users know that
 586                --  this comes from a switch on the command line. This is
 587                --  especially important when Concatenate is False, since
 588                --  otherwise the current argument first character is lost.
 589
 590                Set_Parameter
 591                  (Parser.The_Switch,
 592                   Arg_Num => Parser.Current_Argument,
 593                   First   => Parser.Current_Index,
 594                   Last    => Arg'Last,
 595                   Extra   => Parser.Switch_Character);
 596                Parser.Is_Switch (Parser.Current_Argument) := True;
 597                Dummy := Goto_Next_Argument_In_Section (Parser);
 598                return '*';
 599             end if;
 600
 601             Set_Parameter
 602               (Parser.The_Switch,
 603                Arg_Num => Parser.Current_Argument,
 604                First   => Parser.Current_Index,
 605                Last    => End_Index);
 606             Parser.Current_Index := End_Index + 1;
 607             raise Invalid_Switch;
 608          end if;
 609
 610          End_Index := Parser.Current_Index + Max_Length - 1;
 611          Set_Parameter
 612            (Parser.The_Switch,
 613             Arg_Num => Parser.Current_Argument,
 614             First   => Parser.Current_Index,
 615             Last    => End_Index);
 616
 617          case Param is
 618             when Parameter_With_Optional_Space =>
 619                if End_Index < Arg'Last then
 620                   Set_Parameter
 621                     (Parser.The_Parameter,
 622                      Arg_Num => Parser.Current_Argument,
 623                      First   => End_Index + 1,
 624                      Last    => Arg'Last);
 625                   Dummy := Goto_Next_Argument_In_Section (Parser);
 626
 627                elsif Parser.Current_Argument < Parser.Arg_Count
 628                  and then Parser.Section (Parser.Current_Argument + 1) /= 0
 629                then
 630                   Parser.Current_Argument := Parser.Current_Argument + 1;
 631                   Parser.The_Separator := ' ';
 632                   Set_Parameter
 633                     (Parser.The_Parameter,
 634                      Arg_Num => Parser.Current_Argument,
 635                      First => Argument (Parser, Parser.Current_Argument)'First,
 636                      Last  => Argument (Parser, Parser.Current_Argument)'Last);
 637                   Parser.Is_Switch (Parser.Current_Argument) := True;
 638                   Dummy := Goto_Next_Argument_In_Section (Parser);
 639
 640                else
 641                   Parser.Current_Index := End_Index + 1;
 642                   raise Invalid_Parameter;
 643                end if;
 644
 645             when Parameter_With_Space_Or_Equal =>
 646
 647                --  If the switch is of the form <switch>=xxx
 648
 649                if End_Index < Arg'Last then
 650
 651                   if Arg (End_Index + 1) = '='
 652                     and then End_Index + 1 < Arg'Last
 653                   then
 654                      Parser.The_Separator := '=';
 655                      Set_Parameter
 656                        (Parser.The_Parameter,
 657                         Arg_Num => Parser.Current_Argument,
 658                         First   => End_Index + 2,
 659                         Last    => Arg'Last);
 660                      Dummy := Goto_Next_Argument_In_Section (Parser);
 661                   else
 662                      Parser.Current_Index := End_Index + 1;
 663                      raise Invalid_Parameter;
 664                   end if;
 665
 666                --  If the switch is of the form <switch> xxx
 667
 668                elsif Parser.Current_Argument < Parser.Arg_Count
 669                  and then Parser.Section (Parser.Current_Argument + 1) /= 0
 670                then
 671                   Parser.Current_Argument := Parser.Current_Argument + 1;
 672                   Parser.The_Separator := ' ';
 673                   Set_Parameter
 674                     (Parser.The_Parameter,
 675                      Arg_Num => Parser.Current_Argument,
 676                      First => Argument (Parser, Parser.Current_Argument)'First,
 677                      Last  => Argument (Parser, Parser.Current_Argument)'Last);
 678                   Parser.Is_Switch (Parser.Current_Argument) := True;
 679                   Dummy := Goto_Next_Argument_In_Section (Parser);
 680
 681                else
 682                   Parser.Current_Index := End_Index + 1;
 683                   raise Invalid_Parameter;
 684                end if;
 685
 686             when Parameter_No_Space =>
 687
 688                if End_Index < Arg'Last then
 689                   Set_Parameter
 690                     (Parser.The_Parameter,
 691                      Arg_Num => Parser.Current_Argument,
 692                      First   => End_Index + 1,
 693                      Last    => Arg'Last);
 694                   Dummy := Goto_Next_Argument_In_Section (Parser);
 695
 696                else
 697                   Parser.Current_Index := End_Index + 1;
 698                   raise Invalid_Parameter;
 699                end if;
 700
 701             when Parameter_Optional =>
 702
 703                if End_Index < Arg'Last then
 704                   Set_Parameter
 705                     (Parser.The_Parameter,
 706                      Arg_Num => Parser.Current_Argument,
 707                      First   => End_Index + 1,
 708                      Last    => Arg'Last);
 709                end if;
 710
 711                Dummy := Goto_Next_Argument_In_Section (Parser);
 712
 713             when Parameter_None =>
 714
 715                if Concatenate or else End_Index = Arg'Last then
 716                   Parser.Current_Index := End_Index + 1;
 717
 718                else
 719                   --  If Concatenate is False and the full argument is not
 720                   --  recognized as a switch, this is an invalid switch.
 721
 722                   if Switches (Switches'First) = '*' then
 723                      Set_Parameter
 724                        (Parser.The_Switch,
 725                         Arg_Num => Parser.Current_Argument,
 726                         First   => Arg'First,
 727                         Last    => Arg'Last);
 728                      Parser.Is_Switch (Parser.Current_Argument) := True;
 729                      Dummy := Goto_Next_Argument_In_Section (Parser);
 730                      return '*';
 731                   end if;
 732
 733                   Set_Parameter
 734                     (Parser.The_Switch,
 735                      Arg_Num => Parser.Current_Argument,
 736                      First   => Parser.Current_Index,
 737                      Last    => Arg'Last);
 738                   Parser.Current_Index := Arg'Last + 1;
 739                   raise Invalid_Switch;
 740                end if;
 741          end case;
 742
 743          return Switches (Index_Switches);
 744       end;
 745    end Getopt;
 746
 747    -----------------------------------
 748    -- Goto_Next_Argument_In_Section --
 749    -----------------------------------
 750
 751    function Goto_Next_Argument_In_Section
 752      (Parser : Opt_Parser) return Boolean
 753    is
 754    begin
 755       Parser.Current_Argument := Parser.Current_Argument + 1;
 756
 757       if Parser.Current_Argument > Parser.Arg_Count
 758         or else Parser.Section (Parser.Current_Argument) = 0
 759       then
 760          loop
 761             Parser.Current_Argument := Parser.Current_Argument + 1;
 762
 763             if Parser.Current_Argument > Parser.Arg_Count then
 764                Parser.Current_Index := 1;
 765                return False;
 766             end if;
 767
 768             exit when Parser.Section (Parser.Current_Argument) =
 769                                                   Parser.Current_Section;
 770          end loop;
 771       end if;
 772
 773       Parser.Current_Index :=
 774         Argument (Parser, Parser.Current_Argument)'First;
 775
 776       return True;
 777    end Goto_Next_Argument_In_Section;
 778
 779    ------------------
 780    -- Goto_Section --
 781    ------------------
 782
 783    procedure Goto_Section
 784      (Name   : String := "";
 785       Parser : Opt_Parser := Command_Line_Parser)
 786    is
 787       Index : Integer;
 788
 789    begin
 790       Parser.In_Expansion := False;
 791
 792       if Name = "" then
 793          Parser.Current_Argument := 1;
 794          Parser.Current_Index    := 1;
 795          Parser.Current_Section  := 1;
 796          return;
 797       end if;
 798
 799       Index := 1;
 800       while Index <= Parser.Arg_Count loop
 801          if Parser.Section (Index) = 0
 802            and then Argument (Parser, Index) = Parser.Switch_Character & Name
 803          then
 804             Parser.Current_Argument := Index + 1;
 805             Parser.Current_Index    := 1;
 806
 807             if Parser.Current_Argument <= Parser.Arg_Count then
 808                Parser.Current_Section :=
 809                  Parser.Section (Parser.Current_Argument);
 810             end if;
 811             return;
 812          end if;
 813
 814          Index := Index + 1;
 815       end loop;
 816
 817       Parser.Current_Argument := Positive'Last;
 818       Parser.Current_Index := 2;   --  so that Get_Argument returns nothing
 819    end Goto_Section;
 820
 821    ----------------------------
 822    -- Initialize_Option_Scan --
 823    ----------------------------
 824
 825    procedure Initialize_Option_Scan
 826      (Switch_Char              : Character := '-';
 827       Stop_At_First_Non_Switch : Boolean   := False;
 828       Section_Delimiters       : String    := "")
 829    is
 830    begin
 831       Internal_Initialize_Option_Scan
 832         (Parser                   => Command_Line_Parser,
 833          Switch_Char              => Switch_Char,
 834          Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 835          Section_Delimiters       => Section_Delimiters);
 836    end Initialize_Option_Scan;
 837
 838    ----------------------------
 839    -- Initialize_Option_Scan --
 840    ----------------------------
 841
 842    procedure Initialize_Option_Scan
 843      (Parser                   : out Opt_Parser;
 844       Command_Line             : GNAT.OS_Lib.Argument_List_Access;
 845       Switch_Char              : Character := '-';
 846       Stop_At_First_Non_Switch : Boolean := False;
 847       Section_Delimiters       : String := "")
 848    is
 849    begin
 850       Free (Parser);
 851
 852       if Command_Line = null then
 853          Parser := new Opt_Parser_Data (CL.Argument_Count);
 854          Internal_Initialize_Option_Scan
 855            (Parser                   => Parser,
 856             Switch_Char              => Switch_Char,
 857             Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 858             Section_Delimiters       => Section_Delimiters);
 859       else
 860          Parser := new Opt_Parser_Data (Command_Line'Length);
 861          Parser.Arguments := Command_Line;
 862          Internal_Initialize_Option_Scan
 863            (Parser                   => Parser,
 864             Switch_Char              => Switch_Char,
 865             Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 866             Section_Delimiters       => Section_Delimiters);
 867       end if;
 868    end Initialize_Option_Scan;
 869
 870    -------------------------------------
 871    -- Internal_Initialize_Option_Scan --
 872    -------------------------------------
 873
 874    procedure Internal_Initialize_Option_Scan
 875      (Parser                   : Opt_Parser;
 876       Switch_Char              : Character;
 877       Stop_At_First_Non_Switch : Boolean;
 878       Section_Delimiters       : String)
 879    is
 880       Section_Num     : Section_Number;
 881       Section_Index   : Integer;
 882       Last            : Integer;
 883       Delimiter_Found : Boolean;
 884
 885       Discard : Boolean;
 886       pragma Warnings (Off, Discard);
 887
 888    begin
 889       Parser.Current_Argument := 0;
 890       Parser.Current_Index    := 0;
 891       Parser.In_Expansion     := False;
 892       Parser.Switch_Character := Switch_Char;
 893       Parser.Stop_At_First    := Stop_At_First_Non_Switch;
 894       Parser.Section          := (others => 1);
 895
 896       --  If we are using sections, we have to preprocess the command line
 897       --  to delimit them. A section can be repeated, so we just give each
 898       --  item on the command line a section number
 899
 900       Section_Num   := 1;
 901       Section_Index := Section_Delimiters'First;
 902       while Section_Index <= Section_Delimiters'Last loop
 903          Last := Section_Index;
 904          while Last <= Section_Delimiters'Last
 905            and then Section_Delimiters (Last) /= ' '
 906          loop
 907             Last := Last + 1;
 908          end loop;
 909
 910          Delimiter_Found := False;
 911          Section_Num := Section_Num + 1;
 912
 913          for Index in 1 .. Parser.Arg_Count loop
 914             if Argument (Parser, Index)(1) = Parser.Switch_Character
 915               and then
 916                 Argument (Parser, Index) = Parser.Switch_Character &
 917                                         Section_Delimiters
 918                                           (Section_Index .. Last - 1)
 919             then
 920                Parser.Section (Index) := 0;
 921                Delimiter_Found := True;
 922
 923             elsif Parser.Section (Index) = 0 then
 924                Delimiter_Found := False;
 925
 926             elsif Delimiter_Found then
 927                Parser.Section (Index) := Section_Num;
 928             end if;
 929          end loop;
 930
 931          Section_Index := Last + 1;
 932          while Section_Index <= Section_Delimiters'Last
 933            and then Section_Delimiters (Section_Index) = ' '
 934          loop
 935             Section_Index := Section_Index + 1;
 936          end loop;
 937       end loop;
 938
 939       Discard := Goto_Next_Argument_In_Section (Parser);
 940    end Internal_Initialize_Option_Scan;
 941
 942    ---------------
 943    -- Parameter --
 944    ---------------
 945
 946    function Parameter
 947      (Parser : Opt_Parser := Command_Line_Parser) return String
 948    is
 949    begin
 950       if Parser.The_Parameter.First > Parser.The_Parameter.Last then
 951          return String'(1 .. 0 => ' ');
 952       else
 953          return Argument (Parser, Parser.The_Parameter.Arg_Num)
 954            (Parser.The_Parameter.First .. Parser.The_Parameter.Last);
 955       end if;
 956    end Parameter;
 957
 958    ---------------
 959    -- Separator --
 960    ---------------
 961
 962    function Separator
 963      (Parser : Opt_Parser := Command_Line_Parser) return Character
 964    is
 965    begin
 966       return Parser.The_Separator;
 967    end Separator;
 968
 969    -------------------
 970    -- Set_Parameter --
 971    -------------------
 972
 973    procedure Set_Parameter
 974      (Variable : out Parameter_Type;
 975       Arg_Num  : Positive;
 976       First    : Positive;
 977       Last     : Positive;
 978       Extra    : Character := ASCII.NUL)
 979    is
 980    begin
 981       Variable.Arg_Num := Arg_Num;
 982       Variable.First   := First;
 983       Variable.Last    := Last;
 984       Variable.Extra   := Extra;
 985    end Set_Parameter;
 986
 987    ---------------------
 988    -- Start_Expansion --
 989    ---------------------
 990
 991    procedure Start_Expansion
 992      (Iterator     : out Expansion_Iterator;
 993       Pattern      : String;
 994       Directory    : String := "";
 995       Basic_Regexp : Boolean := True)
 996    is
 997       Directory_Separator : Character;
 998       pragma Import (C, Directory_Separator, "__gnat_dir_separator");
 999
1000       First : Positive := Pattern'First;
1001       Pat   : String := Pattern;
1002
1003    begin
1004       Canonical_Case_File_Name (Pat);
1005       Iterator.Current_Depth := 1;
1006
1007       --  If Directory is unspecified, use the current directory ("./" or ".\")
1008
1009       if Directory = "" then
1010          Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
1011          Iterator.Start := 3;
1012
1013       else
1014          Iterator.Dir_Name (1 .. Directory'Length) := Directory;
1015          Iterator.Start := Directory'Length + 1;
1016          Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length));
1017
1018          --  Make sure that the last character is a directory separator
1019
1020          if Directory (Directory'Last) /= Directory_Separator then
1021             Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
1022             Iterator.Start := Iterator.Start + 1;
1023          end if;
1024       end if;
1025
1026       Iterator.Levels (1).Name_Last := Iterator.Start - 1;
1027
1028       --  Open the initial Directory, at depth 1
1029
1030       GNAT.Directory_Operations.Open
1031         (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
1032
1033       --  If in the current directory and the pattern starts with "./" or ".\",
1034       --  drop the "./" or ".\" from the pattern.
1035
1036       if Directory = "" and then Pat'Length > 2
1037         and then Pat (Pat'First) = '.'
1038         and then Pat (Pat'First + 1) = Directory_Separator
1039       then
1040          First := Pat'First + 2;
1041       end if;
1042
1043       Iterator.Regexp :=
1044         GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True);
1045
1046       Iterator.Maximum_Depth := 1;
1047
1048       --  Maximum_Depth is equal to 1 plus the number of directory separators
1049       --  in the pattern.
1050
1051       for Index in First .. Pat'Last loop
1052          if Pat (Index) = Directory_Separator then
1053             Iterator.Maximum_Depth := Iterator.Maximum_Depth + 1;
1054             exit when Iterator.Maximum_Depth = Max_Depth;
1055          end if;
1056       end loop;
1057    end Start_Expansion;
1058
1059    ----------
1060    -- Free --
1061    ----------
1062
1063    procedure Free (Parser : in out Opt_Parser) is
1064       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1065         (Opt_Parser_Data, Opt_Parser);
1066    begin
1067       if Parser /= null
1068         and then Parser /= Command_Line_Parser
1069       then
1070          Free (Parser.Arguments);
1071          Unchecked_Free (Parser);
1072       end if;
1073    end Free;
1074
1075    ------------------
1076    -- Define_Alias --
1077    ------------------
1078
1079    procedure Define_Alias
1080      (Config   : in out Command_Line_Configuration;
1081       Switch   : String;
1082       Expanded : String)
1083    is
1084    begin
1085       if Config = null then
1086          Config := new Command_Line_Configuration_Record;
1087       end if;
1088
1089       Add (Config.Aliases,    new String'(Switch));
1090       Add (Config.Expansions, new String'(Expanded));
1091    end Define_Alias;
1092
1093    -------------------
1094    -- Define_Prefix --
1095    -------------------
1096
1097    procedure Define_Prefix
1098      (Config : in out Command_Line_Configuration;
1099       Prefix : String)
1100    is
1101    begin
1102       if Config = null then
1103          Config := new Command_Line_Configuration_Record;
1104       end if;
1105
1106       Add (Config.Prefixes, new String'(Prefix));
1107    end Define_Prefix;
1108
1109    -------------------
1110    -- Define_Switch --
1111    -------------------
1112
1113    procedure Define_Switch
1114      (Config : in out Command_Line_Configuration;
1115       Switch : String)
1116    is
1117    begin
1118       if Config = null then
1119          Config := new Command_Line_Configuration_Record;
1120       end if;
1121
1122       Add (Config.Switches, new String'(Switch));
1123    end Define_Switch;
1124
1125    --------------------
1126    -- Define_Section --
1127    --------------------
1128
1129    procedure Define_Section
1130      (Config : in out Command_Line_Configuration;
1131       Section : String)
1132    is
1133    begin
1134       if Config = null then
1135          Config := new Command_Line_Configuration_Record;
1136       end if;
1137
1138       Add (Config.Sections, new String'(Section));
1139    end Define_Section;
1140
1141    ------------------
1142    -- Get_Switches --
1143    ------------------
1144
1145    function Get_Switches
1146      (Config      : Command_Line_Configuration;
1147       Switch_Char : Character)
1148       return String
1149    is
1150       Ret : Ada.Strings.Unbounded.Unbounded_String;
1151       use type Ada.Strings.Unbounded.Unbounded_String;
1152
1153    begin
1154       if Config = null or else Config.Switches = null then
1155          return "";
1156       end if;
1157
1158       for J in Config.Switches'Range loop
1159          if Config.Switches (J) (Config.Switches (J)'First) = Switch_Char then
1160             Ret :=
1161               Ret & " " &
1162                 Config.Switches (J)
1163                   (Config.Switches (J)'First + 1 .. Config.Switches (J)'Last);
1164          else
1165             Ret := Ret & " " & Config.Switches (J).all;
1166          end if;
1167       end loop;
1168
1169       return Ada.Strings.Unbounded.To_String (Ret);
1170    end Get_Switches;
1171
1172    -----------------------
1173    -- Set_Configuration --
1174    -----------------------
1175
1176    procedure Set_Configuration
1177      (Cmd    : in out Command_Line;
1178       Config : Command_Line_Configuration)
1179    is
1180    begin
1181       Cmd.Config := Config;
1182    end Set_Configuration;
1183
1184    -----------------------
1185    -- Get_Configuration --
1186    -----------------------
1187
1188    function Get_Configuration
1189      (Cmd : Command_Line) return Command_Line_Configuration is
1190    begin
1191       return Cmd.Config;
1192    end Get_Configuration;
1193
1194    ----------------------
1195    -- Set_Command_Line --
1196    ----------------------
1197
1198    procedure Set_Command_Line
1199      (Cmd                : in out Command_Line;
1200       Switches           : String;
1201       Getopt_Description : String := "";
1202       Switch_Char        : Character := '-')
1203    is
1204       Tmp     : Argument_List_Access;
1205       Parser  : Opt_Parser;
1206       S       : Character;
1207       Section : String_Access := null;
1208
1209       function Real_Full_Switch
1210         (S      : Character;
1211          Parser : Opt_Parser) return String;
1212       --  Ensure that the returned switch value contains the
1213       --  Switch_Char prefix if needed.
1214
1215       ----------------------
1216       -- Real_Full_Switch --
1217       ----------------------
1218
1219       function Real_Full_Switch
1220         (S      : Character;
1221          Parser : Opt_Parser) return String
1222       is
1223       begin
1224          if S = '*' then
1225             return Full_Switch (Parser);
1226          else
1227             return Switch_Char & Full_Switch (Parser);
1228          end if;
1229       end Real_Full_Switch;
1230
1231    --  Start of processing for Set_Command_Line
1232
1233    begin
1234       Free (Cmd.Expanded);
1235       Free (Cmd.Params);
1236
1237       if Switches /= "" then
1238          Tmp := Argument_String_To_List (Switches);
1239          Initialize_Option_Scan (Parser, Tmp, Switch_Char);
1240
1241          loop
1242             begin
1243                S := Getopt (Switches    => "* " & Getopt_Description,
1244                             Concatenate => False,
1245                             Parser      => Parser);
1246                exit when S = ASCII.NUL;
1247
1248                declare
1249                   Sw         : constant String :=
1250                                  Real_Full_Switch (S, Parser);
1251                   Is_Section : Boolean := False;
1252
1253                begin
1254                   if Cmd.Config /= null
1255                     and then Cmd.Config.Sections /= null
1256                   then
1257                      Section_Search :
1258                      for S in Cmd.Config.Sections'Range loop
1259                         if Sw = Cmd.Config.Sections (S).all then
1260                            Section := Cmd.Config.Sections (S);
1261                            Is_Section := True;
1262
1263                            exit Section_Search;
1264                         end if;
1265                      end loop Section_Search;
1266                   end if;
1267
1268                   if not Is_Section then
1269                      if Section = null then
1270
1271                         --  Work around some weird cases: some switches may
1272                         --  expect parameters, but have the same value as
1273                         --  longer switches: -gnaty3 (-gnaty, parameter=3) and
1274                         --  -gnatya (-gnatya, no parameter).
1275
1276                         --  So we are calling add_switch here with parameter
1277                         --  attached. This will be anyway correctly handled by
1278                         --  Add_Switch if -gnaty3 is actually provided.
1279
1280                         if Separator (Parser) = ASCII.NUL then
1281                            Add_Switch
1282                              (Cmd, Sw & Parameter (Parser), "", ASCII.NUL);
1283                         else
1284                            Add_Switch
1285                              (Cmd, Sw, Parameter (Parser), Separator (Parser));
1286                         end if;
1287                      else
1288                         if Separator (Parser) = ASCII.NUL then
1289                            Add_Switch
1290                              (Cmd, Sw & Parameter (Parser), "",
1291                               Separator (Parser),
1292                               Section.all);
1293                         else
1294                            Add_Switch
1295                              (Cmd, Sw,
1296                               Parameter (Parser),
1297                               Separator (Parser),
1298                               Section.all);
1299                         end if;
1300                      end if;
1301                   end if;
1302                end;
1303
1304             exception
1305                when Invalid_Parameter =>
1306
1307                   --  Add it with no parameter, if that's the way the user
1308                   --  wants it.
1309
1310                   --  Specify the separator in all cases, as the switch might
1311                   --  need to be unaliased, and the alias might contain
1312                   --  switches with parameters.
1313
1314                   if Section = null then
1315                      Add_Switch
1316                        (Cmd, Switch_Char & Full_Switch (Parser),
1317                         Separator => Separator (Parser));
1318                   else
1319                      Add_Switch
1320                        (Cmd, Switch_Char & Full_Switch (Parser),
1321                         Separator => Separator (Parser),
1322                         Section   => Section.all);
1323                   end if;
1324             end;
1325          end loop;
1326
1327          Free (Parser);
1328       end if;
1329    end Set_Command_Line;
1330
1331    ----------------
1332    -- Looking_At --
1333    ----------------
1334
1335    function Looking_At
1336      (Type_Str  : String;
1337       Index     : Natural;
1338       Substring : String) return Boolean is
1339    begin
1340       return Index + Substring'Length - 1 <= Type_Str'Last
1341         and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
1342    end Looking_At;
1343
1344    ------------------------
1345    -- Can_Have_Parameter --
1346    ------------------------
1347
1348    function Can_Have_Parameter (S : String) return Boolean is
1349    begin
1350       if S'Length <= 1 then
1351          return False;
1352       end if;
1353
1354       case S (S'Last) is
1355          when '!' | ':' | '?' | '=' =>
1356             return True;
1357          when others =>
1358             return False;
1359       end case;
1360    end Can_Have_Parameter;
1361
1362    -----------------------
1363    -- Require_Parameter --
1364    -----------------------
1365
1366    function Require_Parameter (S : String) return Boolean is
1367    begin
1368       if S'Length <= 1 then
1369          return False;
1370       end if;
1371
1372       case S (S'Last) is
1373          when '!' | ':' | '=' =>
1374             return True;
1375          when others =>
1376             return False;
1377       end case;
1378    end Require_Parameter;
1379
1380    -------------------
1381    -- Actual_Switch --
1382    -------------------
1383
1384    function Actual_Switch (S : String) return String is
1385    begin
1386       if S'Length <= 1 then
1387          return S;
1388       end if;
1389
1390       case S (S'Last) is
1391          when '!' | ':' | '?' | '=' =>
1392             return S (S'First .. S'Last - 1);
1393          when others =>
1394             return S;
1395       end case;
1396    end Actual_Switch;
1397
1398    ----------------------------
1399    -- For_Each_Simple_Switch --
1400    ----------------------------
1401
1402    procedure For_Each_Simple_Switch
1403      (Cmd       : Command_Line;
1404       Switch    : String;
1405       Parameter : String := "";
1406       Unalias   : Boolean := True)
1407    is
1408       function Group_Analysis
1409         (Prefix : String;
1410          Group  : String) return Boolean;
1411       --  Perform the analysis of a group of switches
1412
1413       --------------------
1414       -- Group_Analysis --
1415       --------------------
1416
1417       function Group_Analysis
1418         (Prefix : String;
1419          Group  : String) return Boolean
1420       is
1421          Idx   : Natural;
1422          Found : Boolean;
1423
1424       begin
1425          Idx := Group'First;
1426          while Idx <= Group'Last loop
1427             Found := False;
1428
1429             for S in Cmd.Config.Switches'Range loop
1430                declare
1431                   Sw              : constant String :=
1432                                       Actual_Switch
1433                                         (Cmd.Config.Switches (S).all);
1434                   Full            : constant String :=
1435                                       Prefix & Group (Idx .. Group'Last);
1436                   Last            : Natural;
1437                   Param           : Natural;
1438
1439                begin
1440                   if Sw'Length >= Prefix'Length
1441
1442                      --  Verify that sw starts with Prefix
1443
1444                      and then Looking_At (Sw, Sw'First, Prefix)
1445
1446                      --  Verify that the group starts with sw
1447
1448                      and then Looking_At (Full, Full'First, Sw)
1449                   then
1450                      Last := Idx + Sw'Length - Prefix'Length - 1;
1451                      Param := Last + 1;
1452
1453                      if Can_Have_Parameter (Cmd.Config.Switches (S).all) then
1454
1455                         --  Include potential parameter to the recursive call.
1456                         --  Only numbers are allowed.
1457
1458                         while Last < Group'Last
1459                           and then Group (Last + 1) in '0' .. '9'
1460                         loop
1461                            Last := Last + 1;
1462                         end loop;
1463                      end if;
1464
1465                      if not Require_Parameter (Cmd.Config.Switches (S).all)
1466                        or else Last >= Param
1467                      then
1468                         if Idx = Group'First
1469                           and then Last = Group'Last
1470                           and then Last < Param
1471                         then
1472                            --  The group only concerns a single switch. Do not
1473                            --  perform recursive call.
1474
1475                            --  Note that we still perform a recursive call if
1476                            --  a parameter is detected in the switch, as this
1477                            --  is a way to correctly identify such a parameter
1478                            --  in aliases.
1479
1480                            return False;
1481                         end if;
1482
1483                         Found := True;
1484
1485                         --  Recursive call, using the detected parameter if any
1486
1487                         if Last >= Param then
1488                            For_Each_Simple_Switch
1489                              (Cmd,
1490                               Prefix & Group (Idx .. Param - 1),
1491                               Group (Param .. Last));
1492                         else
1493                            For_Each_Simple_Switch
1494                              (Cmd, Prefix & Group (Idx .. Last), "");
1495                         end if;
1496
1497                         Idx := Last + 1;
1498                         exit;
1499                      end if;
1500                   end if;
1501                end;
1502             end loop;
1503
1504             if not Found then
1505                For_Each_Simple_Switch (Cmd, Prefix & Group (Idx), "");
1506                Idx := Idx + 1;
1507             end if;
1508          end loop;
1509
1510          return True;
1511       end Group_Analysis;
1512
1513    begin
1514       --  First determine if the switch corresponds to one belonging to the
1515       --  configuration. If so, run callback and exit.
1516
1517       if Cmd.Config /= null and then Cmd.Config.Switches /= null then
1518          for S in Cmd.Config.Switches'Range loop
1519             declare
1520                Config_Switch : String renames Cmd.Config.Switches (S).all;
1521             begin
1522                if Actual_Switch (Config_Switch) = Switch
1523                     and then
1524                   ((Can_Have_Parameter (Config_Switch)
1525                       and then Parameter /= "")
1526                    or else
1527                    (not Require_Parameter (Config_Switch)
1528                        and then Parameter = ""))
1529                then
1530                   Callback (Switch, Parameter);
1531                   return;
1532                end if;
1533             end;
1534          end loop;
1535       end if;
1536
1537       --  If adding a switch that can in fact be expanded through aliases,
1538       --  add separately each of its expansions.
1539
1540       --  This takes care of expansions like "-T" -> "-gnatwrs", where the
1541       --  alias and its expansion do not have the same prefix. Given the order
1542       --  in which we do things here, the expansion of the alias will itself
1543       --  be checked for a common prefix and split into simple switches.
1544
1545       if Unalias
1546         and then Cmd.Config /= null
1547         and then Cmd.Config.Aliases /= null
1548       then
1549          for A in Cmd.Config.Aliases'Range loop
1550             if Cmd.Config.Aliases (A).all = Switch and then Parameter = "" then
1551                For_Each_Simple_Switch
1552                  (Cmd, Cmd.Config.Expansions (A).all, "");
1553                return;
1554             end if;
1555          end loop;
1556       end if;
1557
1558       --  If adding a switch grouping several switches, add each of the simple
1559       --  switches instead.
1560
1561       if Cmd.Config /= null and then Cmd.Config.Prefixes /= null then
1562          for P in Cmd.Config.Prefixes'Range loop
1563             if Switch'Length > Cmd.Config.Prefixes (P)'Length + 1
1564               and then Looking_At
1565                 (Switch, Switch'First, Cmd.Config.Prefixes (P).all)
1566             then
1567                --  Alias expansion will be done recursively
1568
1569                if Cmd.Config.Switches = null then
1570                   for S in Switch'First + Cmd.Config.Prefixes (P)'Length
1571                             .. Switch'Last
1572                   loop
1573                      For_Each_Simple_Switch
1574                        (Cmd, Cmd.Config.Prefixes (P).all & Switch (S), "");
1575                   end loop;
1576
1577                   return;
1578
1579                elsif Group_Analysis
1580                  (Cmd.Config.Prefixes (P).all,
1581                   Switch
1582                     (Switch'First + Cmd.Config.Prefixes (P)'Length
1583                       .. Switch'Last))
1584                then
1585                   --  Recursive calls already done on each switch of the group:
1586                   --  Return without executing Callback.
1587
1588                   return;
1589                end if;
1590             end if;
1591          end loop;
1592       end if;
1593
1594       --  Test if added switch is a known switch with parameter attached
1595
1596       if Parameter = ""
1597         and then Cmd.Config /= null
1598         and then Cmd.Config.Switches /= null
1599       then
1600          for S in Cmd.Config.Switches'Range loop
1601             declare
1602                Sw    : constant String :=
1603                          Actual_Switch (Cmd.Config.Switches (S).all);
1604                Last  : Natural;
1605                Param : Natural;
1606
1607             begin
1608                --  Verify that switch starts with Sw
1609                --  What if the "verification" fails???
1610
1611                if Switch'Length >= Sw'Length
1612                  and then Looking_At (Switch, Switch'First, Sw)
1613                then
1614                   Param := Switch'First + Sw'Length - 1;
1615                   Last := Param;
1616
1617                   if Can_Have_Parameter (Cmd.Config.Switches (S).all) then
1618                      while Last < Switch'Last
1619                        and then Switch (Last + 1) in '0' .. '9'
1620                      loop
1621                         Last := Last + 1;
1622                      end loop;
1623                   end if;
1624
1625                   --  If full Switch is a known switch with attached parameter
1626                   --  then we use this parameter in the callback.
1627
1628                   if Last = Switch'Last then
1629                      Callback
1630                        (Switch (Switch'First .. Param),
1631                         Switch (Param + 1 .. Last));
1632                      return;
1633
1634                   end if;
1635                end if;
1636             end;
1637          end loop;
1638       end if;
1639
1640       Callback (Switch, Parameter);
1641    end For_Each_Simple_Switch;
1642
1643    ----------------
1644    -- Add_Switch --
1645    ----------------
1646
1647    procedure Add_Switch
1648      (Cmd        : in out Command_Line;
1649       Switch     : String;
1650       Parameter  : String    := "";
1651       Separator  : Character := ' ';
1652       Section    : String    := "";
1653       Add_Before : Boolean   := False)
1654    is
1655       Success : Boolean;
1656       pragma Unreferenced (Success);
1657    begin
1658       Add_Switch
1659         (Cmd, Switch, Parameter, Separator, Section, Add_Before, Success);
1660    end Add_Switch;
1661
1662    ----------------
1663    -- Add_Switch --
1664    ----------------
1665
1666    procedure Add_Switch
1667      (Cmd        : in out Command_Line;
1668       Switch     : String;
1669       Parameter  : String := "";
1670       Separator  : Character := ' ';
1671       Section    : String := "";
1672       Add_Before : Boolean := False;
1673       Success    : out Boolean)
1674    is
1675       procedure Add_Simple_Switch (Simple : String; Param : String);
1676       --  Add a new switch that has had all its aliases expanded, and switches
1677       --  ungrouped. We know there are no more aliases in Switches.
1678
1679       -----------------------
1680       -- Add_Simple_Switch --
1681       -----------------------
1682
1683       procedure Add_Simple_Switch (Simple : String; Param : String) is
1684       begin
1685          if Cmd.Expanded = null then
1686             Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
1687
1688             if Param /= "" then
1689                Cmd.Params := new Argument_List'
1690                  (1 .. 1 => new String'(Separator & Param));
1691
1692             else
1693                Cmd.Params := new Argument_List'(1 .. 1 => null);
1694             end if;
1695
1696             if Section = "" then
1697                Cmd.Sections := new Argument_List'(1 .. 1 => null);
1698
1699             else
1700                Cmd.Sections := new Argument_List'
1701                  (1 .. 1 => new String'(Section));
1702             end if;
1703
1704          else
1705             --  Do we already have this switch?
1706
1707             for C in Cmd.Expanded'Range loop
1708                if Cmd.Expanded (C).all = Simple
1709                  and then
1710                    ((Cmd.Params (C) = null and then Param = "")
1711                      or else
1712                        (Cmd.Params (C) /= null
1713                          and then Cmd.Params (C).all = Separator & Param))
1714                  and then
1715                    ((Cmd.Sections (C) = null and then Section = "")
1716                      or else
1717                        (Cmd.Sections (C) /= null
1718                          and then Cmd.Sections (C).all = Section))
1719                then
1720                   return;
1721                end if;
1722             end loop;
1723
1724             --  Inserting at least one switch
1725
1726             Success := True;
1727             Add (Cmd.Expanded, new String'(Simple), Add_Before);
1728
1729             if Param /= "" then
1730                Add
1731                  (Cmd.Params,
1732                   new String'(Separator & Param),
1733                   Add_Before);
1734
1735             else
1736                Add
1737                  (Cmd.Params,
1738                   null,
1739                   Add_Before);
1740             end if;
1741
1742             if Section = "" then
1743                Add
1744                  (Cmd.Sections,
1745                   null,
1746                   Add_Before);
1747             else
1748                Add
1749                  (Cmd.Sections,
1750                   new String'(Section),
1751                   Add_Before);
1752             end if;
1753          end if;
1754       end Add_Simple_Switch;
1755
1756       procedure Add_Simple_Switches is
1757          new For_Each_Simple_Switch (Add_Simple_Switch);
1758
1759    --  Start of processing for Add_Switch
1760
1761    begin
1762       Success := False;
1763       Add_Simple_Switches (Cmd, Switch, Parameter);
1764       Free (Cmd.Coalesce);
1765    end Add_Switch;
1766
1767    ------------
1768    -- Remove --
1769    ------------
1770
1771    procedure Remove (Line : in out Argument_List_Access; Index : Integer) is
1772       Tmp : Argument_List_Access := Line;
1773
1774    begin
1775       Line := new Argument_List (Tmp'First .. Tmp'Last - 1);
1776
1777       if Index /= Tmp'First then
1778          Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1);
1779       end if;
1780
1781       Free (Tmp (Index));
1782
1783       if Index /= Tmp'Last then
1784          Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last);
1785       end if;
1786
1787       Unchecked_Free (Tmp);
1788    end Remove;
1789
1790    ---------
1791    -- Add --
1792    ---------
1793
1794    procedure Add
1795      (Line   : in out Argument_List_Access;
1796       Str    : String_Access;
1797       Before : Boolean := False)
1798    is
1799       Tmp : Argument_List_Access := Line;
1800
1801    begin
1802       if Tmp /= null then
1803          Line := new Argument_List (Tmp'First .. Tmp'Last + 1);
1804
1805          if Before then
1806             Line (Tmp'First)                     := Str;
1807             Line (Tmp'First + 1 .. Tmp'Last + 1) := Tmp.all;
1808          else
1809             Line (Tmp'Range)    := Tmp.all;
1810             Line (Tmp'Last + 1) := Str;
1811          end if;
1812
1813          Unchecked_Free (Tmp);
1814
1815       else
1816          Line := new Argument_List'(1 .. 1 => Str);
1817       end if;
1818    end Add;
1819
1820    -------------------
1821    -- Remove_Switch --
1822    -------------------
1823
1824    procedure Remove_Switch
1825      (Cmd           : in out Command_Line;
1826       Switch        : String;
1827       Remove_All    : Boolean := False;
1828       Has_Parameter : Boolean := False;
1829       Section       : String := "")
1830    is
1831       Success : Boolean;
1832       pragma Unreferenced (Success);
1833    begin
1834       Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success);
1835    end Remove_Switch;
1836
1837    -------------------
1838    -- Remove_Switch --
1839    -------------------
1840
1841    procedure Remove_Switch
1842      (Cmd           : in out Command_Line;
1843       Switch        : String;
1844       Remove_All    : Boolean := False;
1845       Has_Parameter : Boolean := False;
1846       Section       : String  := "";
1847       Success       : out Boolean)
1848    is
1849       procedure Remove_Simple_Switch (Simple : String; Param : String);
1850       --  Removes a simple switch, with no aliasing or grouping
1851
1852       --------------------------
1853       -- Remove_Simple_Switch --
1854       --------------------------
1855
1856       procedure Remove_Simple_Switch (Simple : String; Param : String) is
1857          C : Integer;
1858          pragma Unreferenced (Param);
1859
1860       begin
1861          if Cmd.Expanded /= null then
1862             C := Cmd.Expanded'First;
1863             while C <= Cmd.Expanded'Last loop
1864                if Cmd.Expanded (C).all = Simple
1865                  and then
1866                    (Remove_All
1867                      or else (Cmd.Sections (C) = null
1868                                and then Section = "")
1869                      or else (Cmd.Sections (C) /= null
1870                                and then Section = Cmd.Sections (C).all))
1871                  and then (not Has_Parameter or else Cmd.Params (C) /= null)
1872                then
1873                   Remove (Cmd.Expanded, C);
1874                   Remove (Cmd.Params, C);
1875                   Remove (Cmd.Sections, C);
1876                   Success := True;
1877
1878                   if not Remove_All then
1879                      return;
1880                   end if;
1881
1882                else
1883                   C := C + 1;
1884                end if;
1885             end loop;
1886          end if;
1887       end Remove_Simple_Switch;
1888
1889       procedure Remove_Simple_Switches is
1890         new For_Each_Simple_Switch (Remove_Simple_Switch);
1891
1892    --  Start of processing for Remove_Switch
1893
1894    begin
1895       Success := False;
1896       Remove_Simple_Switches (Cmd, Switch, "", Unalias => not Has_Parameter);
1897       Free (Cmd.Coalesce);
1898    end Remove_Switch;
1899
1900    -------------------
1901    -- Remove_Switch --
1902    -------------------
1903
1904    procedure Remove_Switch
1905      (Cmd       : in out Command_Line;
1906       Switch    : String;
1907       Parameter : String;
1908       Section   : String  := "")
1909    is
1910       procedure Remove_Simple_Switch (Simple : String; Param : String);
1911       --  Removes a simple switch, with no aliasing or grouping
1912
1913       --------------------------
1914       -- Remove_Simple_Switch --
1915       --------------------------
1916
1917       procedure Remove_Simple_Switch (Simple : String; Param : String) is
1918          C : Integer;
1919
1920       begin
1921          if Cmd.Expanded /= null then
1922             C := Cmd.Expanded'First;
1923             while C <= Cmd.Expanded'Last loop
1924                if Cmd.Expanded (C).all = Simple
1925                  and then
1926                    ((Cmd.Sections (C) = null
1927                       and then Section = "")
1928                     or else
1929                       (Cmd.Sections (C) /= null
1930                         and then Section = Cmd.Sections (C).all))
1931                  and then
1932                    ((Cmd.Params (C) = null and then Param = "")
1933                       or else
1934                         (Cmd.Params (C) /= null
1935                            and then
1936
1937                            --  Ignore the separator stored in Parameter
1938
1939                              Cmd.Params (C) (Cmd.Params (C)'First + 1
1940                                              .. Cmd.Params (C)'Last) =
1941                            Param))
1942                then
1943                   Remove (Cmd.Expanded, C);
1944                   Remove (Cmd.Params, C);
1945                   Remove (Cmd.Sections, C);
1946
1947                   --  The switch is necessarily unique by construction of
1948                   --  Add_Switch.
1949
1950                   return;
1951
1952                else
1953                   C := C + 1;
1954                end if;
1955             end loop;
1956          end if;
1957       end Remove_Simple_Switch;
1958
1959       procedure Remove_Simple_Switches is
1960          new For_Each_Simple_Switch (Remove_Simple_Switch);
1961
1962    --  Start of processing for Remove_Switch
1963
1964    begin
1965       Remove_Simple_Switches (Cmd, Switch, Parameter);
1966       Free (Cmd.Coalesce);
1967    end Remove_Switch;
1968
1969    --------------------
1970    -- Group_Switches --
1971    --------------------
1972
1973    procedure Group_Switches
1974      (Cmd      : Command_Line;
1975       Result   : Argument_List_Access;
1976       Sections : Argument_List_Access;
1977       Params   : Argument_List_Access)
1978    is
1979       function Compatible_Parameter (Param : String_Access) return Boolean;
1980       --  True when the parameter can be part of a group
1981
1982       --------------------------
1983       -- Compatible_Parameter --
1984       --------------------------
1985
1986       function Compatible_Parameter (Param : String_Access) return Boolean is
1987       begin
1988          --  No parameter OK
1989
1990          if Param = null then
1991             return True;
1992
1993          --  We need parameters without separators
1994
1995          elsif Param (Param'First) /= ASCII.NUL then
1996             return False;
1997
1998          --  Parameters must be all digits
1999
2000          else
2001             for J in Param'First + 1 .. Param'Last loop
2002                if Param (J) not in '0' .. '9' then
2003                   return False;
2004                end if;
2005             end loop;
2006
2007             return True;
2008          end if;
2009       end Compatible_Parameter;
2010
2011       --  Local declarations
2012
2013       Group : Ada.Strings.Unbounded.Unbounded_String;
2014       First : Natural;
2015       use type Ada.Strings.Unbounded.Unbounded_String;
2016
2017    --  Start of processing for Group_Switches
2018
2019    begin
2020       if Cmd.Config = null
2021         or else Cmd.Config.Prefixes = null
2022       then
2023          return;
2024       end if;
2025
2026       for P in Cmd.Config.Prefixes'Range loop
2027          Group   := Ada.Strings.Unbounded.Null_Unbounded_String;
2028          First   := 0;
2029
2030          for C in Result'Range loop
2031             if Result (C) /= null
2032               and then Compatible_Parameter (Params (C))
2033               and then Looking_At
2034                 (Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all)
2035             then
2036                --  If we are still in the same section, group the switches
2037
2038                if First = 0
2039                  or else
2040                    (Sections (C) = null
2041                      and then Sections (First) = null)
2042                  or else
2043                    (Sections (C) /= null
2044                      and then Sections (First) /= null
2045                      and then Sections (C).all = Sections (First).all)
2046                then
2047                   Group :=
2048                     Group &
2049                       Result (C)
2050                         (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2051                          Result (C)'Last);
2052
2053                   if Params (C) /= null then
2054                      Group :=
2055                        Group &
2056                          Params (C) (Params (C)'First + 1 .. Params (C)'Last);
2057                      Free (Params (C));
2058                   end if;
2059
2060                   if First = 0 then
2061                      First := C;
2062                   end if;
2063
2064                   Free (Result (C));
2065
2066                else
2067                   --  We changed section: we put the grouped switches to the
2068                   --  first place, on continue with the new section.
2069
2070                   Result (First) :=
2071                     new String'
2072                       (Cmd.Config.Prefixes (P).all &
2073                        Ada.Strings.Unbounded.To_String (Group));
2074                   Group :=
2075                     Ada.Strings.Unbounded.To_Unbounded_String
2076                       (Result (C)
2077                        (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2078                             Result (C)'Last));
2079                   First := C;
2080                end if;
2081             end if;
2082          end loop;
2083
2084          if First > 0 then
2085             Result (First) :=
2086               new String'
2087                 (Cmd.Config.Prefixes (P).all &
2088                  Ada.Strings.Unbounded.To_String (Group));
2089          end if;
2090       end loop;
2091    end Group_Switches;
2092
2093    --------------------
2094    -- Alias_Switches --
2095    --------------------
2096
2097    procedure Alias_Switches
2098      (Cmd    : Command_Line;
2099       Result : Argument_List_Access;
2100       Params : Argument_List_Access)
2101    is
2102       Found : Boolean;
2103       First : Natural;
2104
2105       procedure Check_Cb (Switch : String; Param : String);
2106       --  Comment required ???
2107
2108       procedure Remove_Cb (Switch : String; Param : String);
2109       --  Comment required ???
2110
2111       --------------
2112       -- Check_Cb --
2113       --------------
2114
2115       procedure Check_Cb (Switch : String; Param : String) is
2116       begin
2117          if Found then
2118             for E in Result'Range loop
2119                if Result (E) /= null
2120                  and then
2121                    (Params (E) = null
2122                     or else Params (E) (Params (E)'First + 1
2123                                             .. Params (E)'Last) = Param)
2124                  and then Result (E).all = Switch
2125                then
2126                   return;
2127                end if;
2128             end loop;
2129
2130             Found := False;
2131          end if;
2132       end Check_Cb;
2133
2134       ---------------
2135       -- Remove_Cb --
2136       ---------------
2137
2138       procedure Remove_Cb (Switch : String; Param : String) is
2139       begin
2140          for E in Result'Range loop
2141             if Result (E) /= null
2142                  and then
2143                    (Params (E) = null
2144                     or else Params (E) (Params (E)'First + 1
2145                                             .. Params (E)'Last) = Param)
2146               and then Result (E).all = Switch
2147             then
2148                if First > E then
2149                   First := E;
2150                end if;
2151                Free (Result (E));
2152                Free (Params (E));
2153                return;
2154             end if;
2155          end loop;
2156       end Remove_Cb;
2157
2158       procedure Check_All is new For_Each_Simple_Switch (Check_Cb);
2159       procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb);
2160
2161    --  Start of processing for Alias_Switches
2162
2163    begin
2164       if Cmd.Config = null
2165         or else Cmd.Config.Aliases = null
2166       then
2167          return;
2168       end if;
2169
2170       for A in Cmd.Config.Aliases'Range loop
2171
2172          --  Compute the various simple switches that make up the alias. We
2173          --  split the expansion into as many simple switches as possible, and
2174          --  then check whether the expanded command line has all of them.
2175
2176          Found := True;
2177          Check_All (Cmd, Cmd.Config.Expansions (A).all);
2178
2179          if Found then
2180             First := Integer'Last;
2181             Remove_All (Cmd, Cmd.Config.Expansions (A).all);
2182             Result (First) := new String'(Cmd.Config.Aliases (A).all);
2183          end if;
2184       end loop;
2185    end Alias_Switches;
2186
2187    -------------------
2188    -- Sort_Sections --
2189    -------------------
2190
2191    procedure Sort_Sections
2192      (Line     : GNAT.OS_Lib.Argument_List_Access;
2193       Sections : GNAT.OS_Lib.Argument_List_Access;
2194       Params   : GNAT.OS_Lib.Argument_List_Access)
2195    is
2196       Sections_List : Argument_List_Access :=
2197                         new Argument_List'(1 .. 1 => null);
2198       Found         : Boolean;
2199       Old_Line      : constant Argument_List := Line.all;
2200       Old_Sections  : constant Argument_List := Sections.all;
2201       Old_Params    : constant Argument_List := Params.all;
2202       Index         : Natural;
2203
2204    begin
2205       if Line = null then
2206          return;
2207       end if;
2208
2209       --  First construct a list of all sections
2210
2211       for E in Line'Range loop
2212          if Sections (E) /= null then
2213             Found := False;
2214             for S in Sections_List'Range loop
2215                if (Sections_List (S) = null and then Sections (E) = null)
2216                  or else
2217                    (Sections_List (S) /= null
2218                      and then Sections (E) /= null
2219                      and then Sections_List (S).all = Sections (E).all)
2220                then
2221                   Found := True;
2222                   exit;
2223                end if;
2224             end loop;
2225
2226             if not Found then
2227                Add (Sections_List, Sections (E));
2228             end if;
2229          end if;
2230       end loop;
2231
2232       Index := Line'First;
2233
2234       for S in Sections_List'Range loop
2235          for E in Old_Line'Range loop
2236             if (Sections_List (S) = null and then Old_Sections (E) = null)
2237               or else
2238                 (Sections_List (S) /= null
2239                   and then Old_Sections (E) /= null
2240                   and then Sections_List (S).all = Old_Sections (E).all)
2241             then
2242                Line (Index) := Old_Line (E);
2243                Sections (Index) := Old_Sections (E);
2244                Params (Index) := Old_Params (E);
2245                Index := Index + 1;
2246             end if;
2247          end loop;
2248       end loop;
2249    end Sort_Sections;
2250
2251    -----------
2252    -- Start --
2253    -----------
2254
2255    procedure Start
2256      (Cmd      : in out Command_Line;
2257       Iter     : in out Command_Line_Iterator;
2258       Expanded : Boolean)
2259    is
2260    begin
2261       if Cmd.Expanded = null then
2262          Iter.List := null;
2263          return;
2264       end if;
2265
2266       --  Reorder the expanded line so that sections are grouped
2267
2268       Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params);
2269
2270       --  Coalesce the switches as much as possible
2271
2272       if not Expanded
2273         and then Cmd.Coalesce = null
2274       then
2275          Cmd.Coalesce := new Argument_List (Cmd.Expanded'Range);
2276          for E in Cmd.Expanded'Range loop
2277             Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all);
2278          end loop;
2279
2280          Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
2281          for E in Cmd.Sections'Range loop
2282             if Cmd.Sections (E) = null then
2283                Cmd.Coalesce_Sections (E) := null;
2284             else
2285                Cmd.Coalesce_Sections (E) := new String'(Cmd.Sections (E).all);
2286             end if;
2287          end loop;
2288
2289          Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range);
2290          for E in Cmd.Params'Range loop
2291             if Cmd.Params (E) = null then
2292                Cmd.Coalesce_Params (E) := null;
2293             else
2294                Cmd.Coalesce_Params (E) := new String'(Cmd.Params (E).all);
2295             end if;
2296          end loop;
2297
2298          --  Not a clone, since we will not modify the parameters anyway
2299
2300          Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params);
2301          Group_Switches
2302            (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params);
2303       end if;
2304
2305       if Expanded then
2306          Iter.List     := Cmd.Expanded;
2307          Iter.Params   := Cmd.Params;
2308          Iter.Sections := Cmd.Sections;
2309       else
2310          Iter.List     := Cmd.Coalesce;
2311          Iter.Params   := Cmd.Coalesce_Params;
2312          Iter.Sections := Cmd.Coalesce_Sections;
2313       end if;
2314
2315       if Iter.List = null then
2316          Iter.Current := Integer'Last;
2317       else
2318          Iter.Current := Iter.List'First;
2319
2320          while Iter.Current <= Iter.List'Last
2321            and then Iter.List (Iter.Current) = null
2322          loop
2323             Iter.Current := Iter.Current + 1;
2324          end loop;
2325       end if;
2326    end Start;
2327
2328    --------------------
2329    -- Current_Switch --
2330    --------------------
2331
2332    function Current_Switch (Iter : Command_Line_Iterator) return String is
2333    begin
2334       return Iter.List (Iter.Current).all;
2335    end Current_Switch;
2336
2337    --------------------
2338    -- Is_New_Section --
2339    --------------------
2340
2341    function Is_New_Section    (Iter : Command_Line_Iterator) return Boolean is
2342       Section : constant String := Current_Section (Iter);
2343    begin
2344       if Iter.Sections = null then
2345          return False;
2346       elsif Iter.Current = Iter.Sections'First
2347         or else Iter.Sections (Iter.Current - 1) = null
2348       then
2349          return Section /= "";
2350       end if;
2351
2352       return Section /= Iter.Sections (Iter.Current - 1).all;
2353    end Is_New_Section;
2354
2355    ---------------------
2356    -- Current_Section --
2357    ---------------------
2358
2359    function Current_Section (Iter : Command_Line_Iterator) return String is
2360    begin
2361       if Iter.Sections = null
2362         or else Iter.Current > Iter.Sections'Last
2363         or else Iter.Sections (Iter.Current) = null
2364       then
2365          return "";
2366       end if;
2367
2368       return Iter.Sections (Iter.Current).all;
2369    end Current_Section;
2370
2371    -----------------------
2372    -- Current_Separator --
2373    -----------------------
2374
2375    function Current_Separator (Iter : Command_Line_Iterator) return String is
2376    begin
2377       if Iter.Params = null
2378         or else Iter.Current > Iter.Params'Last
2379         or else Iter.Params (Iter.Current) = null
2380       then
2381          return "";
2382
2383       else
2384          declare
2385             Sep : constant Character :=
2386               Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First);
2387          begin
2388             if Sep = ASCII.NUL then
2389                return "";
2390             else
2391                return "" & Sep;
2392             end if;
2393          end;
2394       end if;
2395    end Current_Separator;
2396
2397    -----------------------
2398    -- Current_Parameter --
2399    -----------------------
2400
2401    function Current_Parameter (Iter : Command_Line_Iterator) return String is
2402    begin
2403       if Iter.Params = null
2404         or else Iter.Current > Iter.Params'Last
2405         or else Iter.Params (Iter.Current) = null
2406       then
2407          return "";
2408
2409       else
2410          declare
2411             P : constant String := Iter.Params (Iter.Current).all;
2412
2413          begin
2414             --  Skip separator
2415
2416             return P (P'First + 1 .. P'Last);
2417          end;
2418       end if;
2419    end Current_Parameter;
2420
2421    --------------
2422    -- Has_More --
2423    --------------
2424
2425    function Has_More (Iter : Command_Line_Iterator) return Boolean is
2426    begin
2427       return Iter.List /= null and then Iter.Current <= Iter.List'Last;
2428    end Has_More;
2429
2430    ----------
2431    -- Next --
2432    ----------
2433
2434    procedure Next (Iter : in out Command_Line_Iterator) is
2435    begin
2436       Iter.Current := Iter.Current + 1;
2437       while Iter.Current <= Iter.List'Last
2438         and then Iter.List (Iter.Current) = null
2439       loop
2440          Iter.Current := Iter.Current + 1;
2441       end loop;
2442    end Next;
2443
2444    ----------
2445    -- Free --
2446    ----------
2447
2448    procedure Free (Config : in out Command_Line_Configuration) is
2449    begin
2450       if Config /= null then
2451          Free (Config.Aliases);
2452          Free (Config.Expansions);
2453          Free (Config.Prefixes);
2454          Free (Config.Sections);
2455          Free (Config.Switches);
2456          Unchecked_Free (Config);
2457       end if;
2458    end Free;
2459
2460    ----------
2461    -- Free --
2462    ----------
2463
2464    procedure Free (Cmd : in out Command_Line) is
2465    begin
2466       Free (Cmd.Expanded);
2467       Free (Cmd.Coalesce);
2468       Free (Cmd.Params);
2469    end Free;
2470
2471 end GNAT.Command_Line;