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