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-2008, 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 2,  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.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 with Ada.Unchecked_Deallocation;
  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 matches at least
  96    --  partially Arg. Index_In_Switches is set to 0 if none matches
  97
  98    procedure Unchecked_Free is new Ada.Unchecked_Deallocation
  99      (Argument_List, Argument_List_Access);
 100
 101    procedure Unchecked_Free is new Ada.Unchecked_Deallocation
 102      (Command_Line_Configuration_Record, Command_Line_Configuration);
 103
 104    type Boolean_Chars is array (Character) of Boolean;
 105
 106    procedure Remove (Line : in out Argument_List_Access; Index : Integer);
 107    --  Remove a specific element from Line
 108
 109    procedure Append
 110      (Line : in out Argument_List_Access;
 111       Str  : String_Access);
 112    --  Append a new element to Line
 113
 114    function Args_From_Expanded (Args : Boolean_Chars) return String;
 115    --  Return the string made of all characters with True in Args
 116
 117    generic
 118       with procedure Callback (Simple_Switch : String);
 119    procedure For_Each_Simple_Switch
 120      (Cmd    : Command_Line;
 121       Switch : String);
 122    --  Breaks Switch into as simple switches as possible (expanding aliases and
 123    --  ungrouping common prefixes when possible), and call Callback for each of
 124    --  these.
 125
 126    procedure Group_Switches
 127      (Cmd    : Command_Line;
 128       Result : Argument_List_Access;
 129       Params : Argument_List_Access);
 130    --  Group switches with common prefixes whenever possible.
 131    --  Once they have been grouped, we also check items for possible aliasing
 132
 133    procedure Alias_Switches
 134      (Cmd    : Command_Line;
 135       Result : Argument_List_Access;
 136       Params : Argument_List_Access);
 137    --  When possible, replace or more switches by an alias, i.e. a shorter
 138    --  version.
 139
 140    function Looking_At
 141      (Type_Str  : String;
 142       Index     : Natural;
 143       Substring : String) return Boolean;
 144    --  Return True if the characters starting at Index in Type_Str are
 145    --  equivalent to Substring.
 146
 147    --------------
 148    -- Argument --
 149    --------------
 150
 151    function Argument (Parser : Opt_Parser; Index : Integer) return String is
 152    begin
 153       if Parser.Arguments /= null then
 154          return Parser.Arguments (Index + Parser.Arguments'First - 1).all;
 155       else
 156          return CL.Argument (Index);
 157       end if;
 158    end Argument;
 159
 160    ------------------------------
 161    -- Canonical_Case_File_Name --
 162    ------------------------------
 163
 164    procedure Canonical_Case_File_Name (S : in out String) is
 165    begin
 166       if not File_Names_Case_Sensitive then
 167          for J in S'Range loop
 168             if S (J) in 'A' .. 'Z' then
 169                S (J) := Character'Val
 170                          (Character'Pos (S (J)) +
 171                           Character'Pos ('a')   -
 172                           Character'Pos ('A'));
 173             end if;
 174          end loop;
 175       end if;
 176    end Canonical_Case_File_Name;
 177
 178    ---------------
 179    -- Expansion --
 180    ---------------
 181
 182    function Expansion (Iterator : Expansion_Iterator) return String is
 183       use GNAT.Directory_Operations;
 184       type Pointer is access all Expansion_Iterator;
 185
 186       It   : constant Pointer := Iterator'Unrestricted_Access;
 187       S    : String (1 .. 1024);
 188       Last : Natural;
 189
 190       Current : Depth := It.Current_Depth;
 191       NL      : Positive;
 192
 193    begin
 194       --  It is assumed that a directory is opened at the current level.
 195       --  Otherwise GNAT.Directory_Operations.Directory_Error will be raised
 196       --  at the first call to Read.
 197
 198       loop
 199          Read (It.Levels (Current).Dir, S, Last);
 200
 201          --  If we have exhausted the directory, close it and go back one level
 202
 203          if Last = 0 then
 204             Close (It.Levels (Current).Dir);
 205
 206             --  If we are at level 1, we are finished; return an empty string
 207
 208             if Current = 1 then
 209                return String'(1 .. 0 => ' ');
 210             else
 211                --  Otherwise continue with the directory at the previous level
 212
 213                Current := Current - 1;
 214                It.Current_Depth := Current;
 215             end if;
 216
 217          --  If this is a directory, that is neither "." or "..", attempt to
 218          --  go to the next level.
 219
 220          elsif Is_Directory
 221            (It.Dir_Name (1 .. It.Levels (Current).Name_Last) & S (1 .. Last))
 222            and then S (1 .. Last) /= "."
 223            and then S (1 .. Last) /= ".."
 224          then
 225             --  We can go to the next level only if we have not reached the
 226             --  maximum depth,
 227
 228             if Current < It.Maximum_Depth then
 229                NL := It.Levels (Current).Name_Last;
 230
 231                --  And if relative path of this new directory is not too long
 232
 233                if NL + Last + 1 < Max_Path_Length then
 234                   Current := Current + 1;
 235                   It.Current_Depth := Current;
 236                   It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last);
 237                   NL := NL + Last + 1;
 238                   It.Dir_Name (NL) := Directory_Separator;
 239                   It.Levels (Current).Name_Last := NL;
 240                   Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
 241
 242                   --  Open the new directory, and read from it
 243
 244                   GNAT.Directory_Operations.Open
 245                     (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
 246                end if;
 247             end if;
 248
 249          --  If not a directory, check the relative path against the pattern
 250
 251          else
 252             declare
 253                Name : String :=
 254                         It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
 255                           & S (1 .. Last);
 256             begin
 257                Canonical_Case_File_Name (Name);
 258
 259                --  If it matches return the relative path
 260
 261                if GNAT.Regexp.Match (Name, Iterator.Regexp) then
 262                   return Name;
 263                end if;
 264             end;
 265          end if;
 266       end loop;
 267    end Expansion;
 268
 269    -----------------
 270    -- Full_Switch --
 271    -----------------
 272
 273    function Full_Switch
 274      (Parser : Opt_Parser := Command_Line_Parser) return String
 275    is
 276    begin
 277       if Parser.The_Switch.Extra = ASCII.NUL then
 278          return Argument (Parser, Parser.The_Switch.Arg_Num)
 279            (Parser.The_Switch.First .. Parser.The_Switch.Last);
 280       else
 281          return Parser.The_Switch.Extra
 282            & Argument (Parser, Parser.The_Switch.Arg_Num)
 283            (Parser.The_Switch.First .. Parser.The_Switch.Last);
 284       end if;
 285    end Full_Switch;
 286
 287    ------------------
 288    -- Get_Argument --
 289    ------------------
 290
 291    function Get_Argument
 292      (Do_Expansion : Boolean    := False;
 293       Parser       : Opt_Parser := Command_Line_Parser) return String
 294    is
 295    begin
 296       if Parser.In_Expansion then
 297          declare
 298             S : constant String := Expansion (Parser.Expansion_It);
 299          begin
 300             if S'Length /= 0 then
 301                return S;
 302             else
 303                Parser.In_Expansion := False;
 304             end if;
 305          end;
 306       end if;
 307
 308       if Parser.Current_Argument > Parser.Arg_Count then
 309
 310          --  If this is the first time this function is called
 311
 312          if Parser.Current_Index = 1 then
 313             Parser.Current_Argument := 1;
 314             while Parser.Current_Argument <= Parser.Arg_Count
 315               and then Parser.Section (Parser.Current_Argument) /=
 316                 Parser.Current_Section
 317             loop
 318                Parser.Current_Argument := Parser.Current_Argument + 1;
 319             end loop;
 320          else
 321             return String'(1 .. 0 => ' ');
 322          end if;
 323
 324       elsif Parser.Section (Parser.Current_Argument) = 0 then
 325          while Parser.Current_Argument <= Parser.Arg_Count
 326            and then Parser.Section (Parser.Current_Argument) /=
 327              Parser.Current_Section
 328          loop
 329             Parser.Current_Argument := Parser.Current_Argument + 1;
 330          end loop;
 331       end if;
 332
 333       Parser.Current_Index := Integer'Last;
 334
 335       while Parser.Current_Argument <= Parser.Arg_Count
 336         and then Parser.Is_Switch (Parser.Current_Argument)
 337       loop
 338          Parser.Current_Argument := Parser.Current_Argument + 1;
 339       end loop;
 340
 341       if Parser.Current_Argument > Parser.Arg_Count then
 342          return String'(1 .. 0 => ' ');
 343       elsif Parser.Section (Parser.Current_Argument) = 0 then
 344          return Get_Argument (Do_Expansion);
 345       end if;
 346
 347       Parser.Current_Argument := Parser.Current_Argument + 1;
 348
 349       --  Could it be a file name with wild cards to expand?
 350
 351       if Do_Expansion then
 352          declare
 353             Arg   : constant String :=
 354                       Argument (Parser, Parser.Current_Argument - 1);
 355             Index : Positive;
 356
 357          begin
 358             Index := Arg'First;
 359             while Index <= Arg'Last loop
 360                if Arg (Index) = '*'
 361                  or else Arg (Index) = '?'
 362                  or else Arg (Index) = '['
 363                then
 364                   Parser.In_Expansion := True;
 365                   Start_Expansion (Parser.Expansion_It, Arg);
 366                   return Get_Argument (Do_Expansion);
 367                end if;
 368
 369                Index := Index + 1;
 370             end loop;
 371          end;
 372       end if;
 373
 374       return Argument (Parser, Parser.Current_Argument - 1);
 375    end Get_Argument;
 376
 377    ----------------------------------
 378    -- Find_Longest_Matching_Switch --
 379    ----------------------------------
 380
 381    procedure Find_Longest_Matching_Switch
 382      (Switches          : String;
 383       Arg               : String;
 384       Index_In_Switches : out Integer;
 385       Switch_Length     : out Integer;
 386       Param             : out Switch_Parameter_Type)
 387    is
 388       Index  : Natural;
 389       Length : Natural := 1;
 390       P      : Switch_Parameter_Type;
 391
 392    begin
 393       Index_In_Switches := 0;
 394       Switch_Length     := 0;
 395
 396       --  Remove all leading spaces first to make sure that Index points
 397       --  at the start of the first switch.
 398
 399       Index := Switches'First;
 400       while Index <= Switches'Last and then Switches (Index) = ' ' loop
 401          Index := Index + 1;
 402       end loop;
 403
 404       while Index <= Switches'Last loop
 405
 406          --  Search the length of the parameter at this position in Switches
 407
 408          Length := Index;
 409          while Length <= Switches'Last
 410            and then Switches (Length) /= ' '
 411          loop
 412             Length := Length + 1;
 413          end loop;
 414
 415          if Length = Index + 1 then
 416             P := Parameter_None;
 417          else
 418             case Switches (Length - 1) is
 419                when ':'    =>
 420                   P      := Parameter_With_Optional_Space;
 421                   Length := Length - 1;
 422                when '='    =>
 423                   P      := Parameter_With_Space_Or_Equal;
 424                   Length := Length - 1;
 425                when '!'    =>
 426                   P      := Parameter_No_Space;
 427                   Length := Length - 1;
 428                when '?'    =>
 429                   P      := Parameter_Optional;
 430                   Length := Length - 1;
 431                when others =>
 432                   P      := Parameter_None;
 433             end case;
 434          end if;
 435
 436          --  If it is the one we searched, it may be a candidate
 437
 438          if Arg'First + Length - 1 - Index <= Arg'Last
 439            and then Switches (Index .. Length - 1) =
 440                       Arg (Arg'First .. Arg'First + Length - 1 - Index)
 441            and then Length - Index > Switch_Length
 442          then
 443             Param             := P;
 444             Index_In_Switches := Index;
 445             Switch_Length     := Length - Index;
 446          end if;
 447
 448          --  Look for the next switch in Switches
 449
 450          while Index <= Switches'Last
 451            and then Switches (Index) /= ' '
 452          loop
 453             Index := Index + 1;
 454          end loop;
 455
 456          Index := Index + 1;
 457       end loop;
 458    end Find_Longest_Matching_Switch;
 459
 460    ------------
 461    -- Getopt --
 462    ------------
 463
 464    function Getopt
 465      (Switches    : String;
 466       Concatenate : Boolean := True;
 467       Parser      : Opt_Parser := Command_Line_Parser) return Character
 468    is
 469       Dummy : Boolean;
 470       pragma Unreferenced (Dummy);
 471
 472    begin
 473       <<Restart>>
 474
 475       --  If we have finished parsing the current command line item (there
 476       --  might be multiple switches in a single item), then go to the next
 477       --  element
 478
 479       if Parser.Current_Argument > Parser.Arg_Count
 480         or else (Parser.Current_Index >
 481                    Argument (Parser, Parser.Current_Argument)'Last
 482                  and then not Goto_Next_Argument_In_Section (Parser))
 483       then
 484          return ASCII.NUL;
 485       end if;
 486
 487       --  By default, the switch will not have a parameter
 488
 489       Parser.The_Parameter :=
 490         (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
 491       Parser.The_Separator := ASCII.NUL;
 492
 493       declare
 494          Arg            : constant String :=
 495                             Argument (Parser, Parser.Current_Argument);
 496          Index_Switches : Natural := 0;
 497          Max_Length     : Natural := 0;
 498          End_Index      : Natural;
 499          Param          : Switch_Parameter_Type;
 500       begin
 501          --  If we are on a new item, test if this might be a switch
 502
 503          if Parser.Current_Index = Arg'First then
 504             if Arg (Arg'First) /= Parser.Switch_Character then
 505
 506                --  If it isn't a switch, return it immediately. We also know it
 507                --  isn't the parameter to a previous switch, since that has
 508                --  already been handled
 509
 510                if Switches (Switches'First) = '*' then
 511                   Set_Parameter
 512                     (Parser.The_Switch,
 513                      Arg_Num => Parser.Current_Argument,
 514                      First   => Arg'First,
 515                      Last    => Arg'Last);
 516                   Parser.Is_Switch (Parser.Current_Argument) := True;
 517                   Dummy := Goto_Next_Argument_In_Section (Parser);
 518                   return '*';
 519                end if;
 520
 521                if Parser.Stop_At_First then
 522                   Parser.Current_Argument := Positive'Last;
 523                   return ASCII.NUL;
 524
 525                elsif not Goto_Next_Argument_In_Section (Parser) then
 526                   return ASCII.NUL;
 527
 528                else
 529                   --  Recurse to get the next switch on the command line
 530
 531                   goto Restart;
 532                end if;
 533             end if;
 534
 535             --  We are on the first character of a new command line argument,
 536             --  which starts with Switch_Character. Further analysis is needed.
 537
 538             Parser.Current_Index := Parser.Current_Index + 1;
 539             Parser.Is_Switch (Parser.Current_Argument) := True;
 540          end if;
 541
 542          Find_Longest_Matching_Switch
 543            (Switches          => Switches,
 544             Arg               => Arg (Parser.Current_Index .. Arg'Last),
 545             Index_In_Switches => Index_Switches,
 546             Switch_Length     => Max_Length,
 547             Param             => Param);
 548
 549          --  If switch is not accepted, it is either invalid or is returned
 550          --  in the context of '*'.
 551
 552          if Index_Switches = 0 then
 553
 554             --  Depending on the value of Concatenate, the full switch is
 555             --  a single character or the rest of the argument.
 556
 557             if Concatenate then
 558                End_Index := Parser.Current_Index;
 559             else
 560                End_Index := Arg'Last;
 561             end if;
 562
 563             if Switches (Switches'First) = '*' then
 564
 565                --  Always prepend the switch character, so that users know that
 566                --  this comes from a switch on the command line. This is
 567                --  especially important when Concatenate is False, since
 568                --  otherwise the current argument first character is lost.
 569
 570                Set_Parameter
 571                  (Parser.The_Switch,
 572                   Arg_Num => Parser.Current_Argument,
 573                   First   => Parser.Current_Index,
 574                   Last    => Arg'Last,
 575                   Extra   => Parser.Switch_Character);
 576                Parser.Is_Switch (Parser.Current_Argument) := True;
 577                Dummy := Goto_Next_Argument_In_Section (Parser);
 578                return '*';
 579             end if;
 580
 581             Set_Parameter
 582               (Parser.The_Switch,
 583                Arg_Num => Parser.Current_Argument,
 584                First   => Parser.Current_Index,
 585                Last    => End_Index);
 586             Parser.Current_Index := End_Index + 1;
 587             raise Invalid_Switch;
 588          end if;
 589
 590          End_Index := Parser.Current_Index + Max_Length - 1;
 591          Set_Parameter
 592            (Parser.The_Switch,
 593             Arg_Num => Parser.Current_Argument,
 594             First   => Parser.Current_Index,
 595             Last    => End_Index);
 596
 597          case Param is
 598             when Parameter_With_Optional_Space =>
 599                if End_Index < Arg'Last then
 600                   Set_Parameter
 601                     (Parser.The_Parameter,
 602                      Arg_Num => Parser.Current_Argument,
 603                      First   => End_Index + 1,
 604                      Last    => Arg'Last);
 605                   Dummy := Goto_Next_Argument_In_Section (Parser);
 606
 607                elsif Parser.Current_Argument < Parser.Arg_Count
 608                  and then Parser.Section (Parser.Current_Argument + 1) /= 0
 609                then
 610                   Parser.Current_Argument := Parser.Current_Argument + 1;
 611                   Parser.The_Separator := ' ';
 612                   Set_Parameter
 613                     (Parser.The_Parameter,
 614                      Arg_Num => Parser.Current_Argument,
 615                      First => Argument (Parser, Parser.Current_Argument)'First,
 616                      Last  => Argument (Parser, Parser.Current_Argument)'Last);
 617                   Parser.Is_Switch (Parser.Current_Argument) := True;
 618                   Dummy := Goto_Next_Argument_In_Section (Parser);
 619
 620                else
 621                   Parser.Current_Index := End_Index + 1;
 622                   raise Invalid_Parameter;
 623                end if;
 624
 625             when Parameter_With_Space_Or_Equal =>
 626
 627                --  If the switch is of the form <switch>=xxx
 628
 629                if End_Index < Arg'Last then
 630
 631                   if Arg (End_Index + 1) = '='
 632                     and then End_Index + 1 < Arg'Last
 633                   then
 634                      Parser.The_Separator := '=';
 635                      Set_Parameter
 636                        (Parser.The_Parameter,
 637                         Arg_Num => Parser.Current_Argument,
 638                         First   => End_Index + 2,
 639                         Last    => Arg'Last);
 640                      Dummy := Goto_Next_Argument_In_Section (Parser);
 641                   else
 642                      Parser.Current_Index := End_Index + 1;
 643                      raise Invalid_Parameter;
 644                   end if;
 645
 646                --  If the switch is of the form <switch> xxx
 647
 648                elsif Parser.Current_Argument < Parser.Arg_Count
 649                  and then Parser.Section (Parser.Current_Argument + 1) /= 0
 650                then
 651                   Parser.Current_Argument := Parser.Current_Argument + 1;
 652                   Parser.The_Separator := ' ';
 653                   Set_Parameter
 654                     (Parser.The_Parameter,
 655                      Arg_Num => Parser.Current_Argument,
 656                      First => Argument (Parser, Parser.Current_Argument)'First,
 657                      Last  => Argument (Parser, Parser.Current_Argument)'Last);
 658                   Parser.Is_Switch (Parser.Current_Argument) := True;
 659                   Dummy := Goto_Next_Argument_In_Section (Parser);
 660
 661                else
 662                   Parser.Current_Index := End_Index + 1;
 663                   raise Invalid_Parameter;
 664                end if;
 665
 666             when Parameter_No_Space =>
 667
 668                if End_Index < Arg'Last then
 669                   Set_Parameter
 670                     (Parser.The_Parameter,
 671                      Arg_Num => Parser.Current_Argument,
 672                      First   => End_Index + 1,
 673                      Last    => Arg'Last);
 674                   Dummy := Goto_Next_Argument_In_Section (Parser);
 675
 676                else
 677                   Parser.Current_Index := End_Index + 1;
 678                   raise Invalid_Parameter;
 679                end if;
 680
 681             when Parameter_Optional =>
 682
 683                if End_Index < Arg'Last then
 684                   Set_Parameter
 685                     (Parser.The_Parameter,
 686                      Arg_Num => Parser.Current_Argument,
 687                      First   => End_Index + 1,
 688                      Last    => Arg'Last);
 689                end if;
 690
 691                Dummy := Goto_Next_Argument_In_Section (Parser);
 692
 693             when Parameter_None =>
 694
 695                if Concatenate or else End_Index = Arg'Last then
 696                   Parser.Current_Index := End_Index + 1;
 697
 698                else
 699                   --  If Concatenate is False and the full argument is not
 700                   --  recognized as a switch, this is an invalid switch.
 701
 702                   if Switches (Switches'First) = '*' then
 703                      Set_Parameter
 704                        (Parser.The_Switch,
 705                         Arg_Num => Parser.Current_Argument,
 706                         First   => Arg'First,
 707                         Last    => Arg'Last);
 708                      Parser.Is_Switch (Parser.Current_Argument) := True;
 709                      Dummy := Goto_Next_Argument_In_Section (Parser);
 710                      return '*';
 711                   end if;
 712
 713                   Set_Parameter
 714                     (Parser.The_Switch,
 715                      Arg_Num => Parser.Current_Argument,
 716                      First   => Parser.Current_Index,
 717                      Last    => Arg'Last);
 718                   Parser.Current_Index := Arg'Last + 1;
 719                   raise Invalid_Switch;
 720                end if;
 721          end case;
 722
 723          return Switches (Index_Switches);
 724       end;
 725    end Getopt;
 726
 727    -----------------------------------
 728    -- Goto_Next_Argument_In_Section --
 729    -----------------------------------
 730
 731    function Goto_Next_Argument_In_Section
 732      (Parser : Opt_Parser) return Boolean
 733    is
 734    begin
 735       Parser.Current_Argument := Parser.Current_Argument + 1;
 736
 737       if Parser.Current_Argument > Parser.Arg_Count
 738         or else Parser.Section (Parser.Current_Argument) = 0
 739       then
 740          loop
 741             Parser.Current_Argument := Parser.Current_Argument + 1;
 742
 743             if Parser.Current_Argument > Parser.Arg_Count then
 744                Parser.Current_Index := 1;
 745                return False;
 746             end if;
 747
 748             exit when Parser.Section (Parser.Current_Argument) =
 749                                                   Parser.Current_Section;
 750          end loop;
 751       end if;
 752
 753       Parser.Current_Index :=
 754         Argument (Parser, Parser.Current_Argument)'First;
 755
 756       return True;
 757    end Goto_Next_Argument_In_Section;
 758
 759    ------------------
 760    -- Goto_Section --
 761    ------------------
 762
 763    procedure Goto_Section
 764      (Name   : String := "";
 765       Parser : Opt_Parser := Command_Line_Parser)
 766    is
 767       Index : Integer;
 768
 769    begin
 770       Parser.In_Expansion := False;
 771
 772       if Name = "" then
 773          Parser.Current_Argument := 1;
 774          Parser.Current_Index    := 1;
 775          Parser.Current_Section  := 1;
 776          return;
 777       end if;
 778
 779       Index := 1;
 780       while Index <= Parser.Arg_Count loop
 781          if Parser.Section (Index) = 0
 782            and then Argument (Parser, Index) = Parser.Switch_Character & Name
 783          then
 784             Parser.Current_Argument := Index + 1;
 785             Parser.Current_Index    := 1;
 786
 787             if Parser.Current_Argument <= Parser.Arg_Count then
 788                Parser.Current_Section :=
 789                  Parser.Section (Parser.Current_Argument);
 790             end if;
 791             return;
 792          end if;
 793
 794          Index := Index + 1;
 795       end loop;
 796
 797       Parser.Current_Argument := Positive'Last;
 798       Parser.Current_Index := 2;   --  so that Get_Argument returns nothing
 799    end Goto_Section;
 800
 801    ----------------------------
 802    -- Initialize_Option_Scan --
 803    ----------------------------
 804
 805    procedure Initialize_Option_Scan
 806      (Switch_Char              : Character := '-';
 807       Stop_At_First_Non_Switch : Boolean   := False;
 808       Section_Delimiters       : String    := "")
 809    is
 810    begin
 811       Internal_Initialize_Option_Scan
 812         (Parser                   => Command_Line_Parser,
 813          Switch_Char              => Switch_Char,
 814          Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 815          Section_Delimiters       => Section_Delimiters);
 816    end Initialize_Option_Scan;
 817
 818    ----------------------------
 819    -- Initialize_Option_Scan --
 820    ----------------------------
 821
 822    procedure Initialize_Option_Scan
 823      (Parser                   : out Opt_Parser;
 824       Command_Line             : GNAT.OS_Lib.Argument_List_Access;
 825       Switch_Char              : Character := '-';
 826       Stop_At_First_Non_Switch : Boolean := False;
 827       Section_Delimiters       : String := "")
 828    is
 829    begin
 830       Free (Parser);
 831
 832       if Command_Line = null then
 833          Parser := new Opt_Parser_Data (CL.Argument_Count);
 834          Initialize_Option_Scan
 835            (Switch_Char              => Switch_Char,
 836             Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 837             Section_Delimiters       => Section_Delimiters);
 838       else
 839          Parser := new Opt_Parser_Data (Command_Line'Length);
 840          Parser.Arguments := Command_Line;
 841          Internal_Initialize_Option_Scan
 842            (Parser                   => Parser,
 843             Switch_Char              => Switch_Char,
 844             Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 845             Section_Delimiters       => Section_Delimiters);
 846       end if;
 847    end Initialize_Option_Scan;
 848
 849    -------------------------------------
 850    -- Internal_Initialize_Option_Scan --
 851    -------------------------------------
 852
 853    procedure Internal_Initialize_Option_Scan
 854      (Parser                   : Opt_Parser;
 855       Switch_Char              : Character;
 856       Stop_At_First_Non_Switch : Boolean;
 857       Section_Delimiters       : String)
 858    is
 859       Section_Num     : Section_Number;
 860       Section_Index   : Integer;
 861       Last            : Integer;
 862       Delimiter_Found : Boolean;
 863
 864       Discard : Boolean;
 865       pragma Warnings (Off, Discard);
 866
 867    begin
 868       Parser.Current_Argument := 0;
 869       Parser.Current_Index    := 0;
 870       Parser.In_Expansion     := False;
 871       Parser.Switch_Character := Switch_Char;
 872       Parser.Stop_At_First    := Stop_At_First_Non_Switch;
 873
 874       --  If we are using sections, we have to preprocess the command line
 875       --  to delimit them. A section can be repeated, so we just give each
 876       --  item on the command line a section number
 877
 878       Section_Num   := 1;
 879       Section_Index := Section_Delimiters'First;
 880       while Section_Index <= Section_Delimiters'Last loop
 881          Last := Section_Index;
 882          while Last <= Section_Delimiters'Last
 883            and then Section_Delimiters (Last) /= ' '
 884          loop
 885             Last := Last + 1;
 886          end loop;
 887
 888          Delimiter_Found := False;
 889          Section_Num := Section_Num + 1;
 890
 891          for Index in 1 .. Parser.Arg_Count loop
 892             if Argument (Parser, Index)(1) = Parser.Switch_Character
 893               and then
 894                 Argument (Parser, Index) = Parser.Switch_Character &
 895                                         Section_Delimiters
 896                                           (Section_Index .. Last - 1)
 897             then
 898                Parser.Section (Index) := 0;
 899                Delimiter_Found := True;
 900
 901             elsif Parser.Section (Index) = 0 then
 902                Delimiter_Found := False;
 903
 904             elsif Delimiter_Found then
 905                Parser.Section (Index) := Section_Num;
 906             end if;
 907          end loop;
 908
 909          Section_Index := Last + 1;
 910          while Section_Index <= Section_Delimiters'Last
 911            and then Section_Delimiters (Section_Index) = ' '
 912          loop
 913             Section_Index := Section_Index + 1;
 914          end loop;
 915       end loop;
 916
 917       Discard := Goto_Next_Argument_In_Section (Parser);
 918    end Internal_Initialize_Option_Scan;
 919
 920    ---------------
 921    -- Parameter --
 922    ---------------
 923
 924    function Parameter
 925      (Parser : Opt_Parser := Command_Line_Parser) return String
 926    is
 927    begin
 928       if Parser.The_Parameter.First > Parser.The_Parameter.Last then
 929          return String'(1 .. 0 => ' ');
 930       else
 931          return Argument (Parser, Parser.The_Parameter.Arg_Num)
 932            (Parser.The_Parameter.First .. Parser.The_Parameter.Last);
 933       end if;
 934    end Parameter;
 935
 936    ---------------
 937    -- Separator --
 938    ---------------
 939
 940    function Separator
 941      (Parser : Opt_Parser := Command_Line_Parser) return Character
 942    is
 943    begin
 944       return Parser.The_Separator;
 945    end Separator;
 946
 947    -------------------
 948    -- Set_Parameter --
 949    -------------------
 950
 951    procedure Set_Parameter
 952      (Variable : out Parameter_Type;
 953       Arg_Num  : Positive;
 954       First    : Positive;
 955       Last     : Positive;
 956       Extra    : Character := ASCII.NUL)
 957    is
 958    begin
 959       Variable.Arg_Num := Arg_Num;
 960       Variable.First   := First;
 961       Variable.Last    := Last;
 962       Variable.Extra   := Extra;
 963    end Set_Parameter;
 964
 965    ---------------------
 966    -- Start_Expansion --
 967    ---------------------
 968
 969    procedure Start_Expansion
 970      (Iterator     : out Expansion_Iterator;
 971       Pattern      : String;
 972       Directory    : String := "";
 973       Basic_Regexp : Boolean := True)
 974    is
 975       Directory_Separator : Character;
 976       pragma Import (C, Directory_Separator, "__gnat_dir_separator");
 977
 978       First : Positive := Pattern'First;
 979       Pat   : String := Pattern;
 980
 981    begin
 982       Canonical_Case_File_Name (Pat);
 983       Iterator.Current_Depth := 1;
 984
 985       --  If Directory is unspecified, use the current directory ("./" or ".\")
 986
 987       if Directory = "" then
 988          Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
 989          Iterator.Start := 3;
 990
 991       else
 992          Iterator.Dir_Name (1 .. Directory'Length) := Directory;
 993          Iterator.Start := Directory'Length + 1;
 994          Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length));
 995
 996          --  Make sure that the last character is a directory separator
 997
 998          if Directory (Directory'Last) /= Directory_Separator then
 999             Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
1000             Iterator.Start := Iterator.Start + 1;
1001          end if;
1002       end if;
1003
1004       Iterator.Levels (1).Name_Last := Iterator.Start - 1;
1005
1006       --  Open the initial Directory, at depth 1
1007
1008       GNAT.Directory_Operations.Open
1009         (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
1010
1011       --  If in the current directory and the pattern starts with "./" or ".\",
1012       --  drop the "./" or ".\" from the pattern.
1013
1014       if Directory = "" and then Pat'Length > 2
1015         and then Pat (Pat'First) = '.'
1016         and then Pat (Pat'First + 1) = Directory_Separator
1017       then
1018          First := Pat'First + 2;
1019       end if;
1020
1021       Iterator.Regexp :=
1022         GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True);
1023
1024       Iterator.Maximum_Depth := 1;
1025
1026       --  Maximum_Depth is equal to 1 plus the number of directory separators
1027       --  in the pattern.
1028
1029       for Index in First .. Pat'Last loop
1030          if Pat (Index) = Directory_Separator then
1031             Iterator.Maximum_Depth := Iterator.Maximum_Depth + 1;
1032             exit when Iterator.Maximum_Depth = Max_Depth;
1033          end if;
1034       end loop;
1035    end Start_Expansion;
1036
1037    ----------
1038    -- Free --
1039    ----------
1040
1041    procedure Free (Parser : in out Opt_Parser) is
1042       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1043         (Opt_Parser_Data, Opt_Parser);
1044    begin
1045       if Parser /= null
1046         and then Parser /= Command_Line_Parser
1047       then
1048          Free (Parser.Arguments);
1049          Unchecked_Free (Parser);
1050       end if;
1051    end Free;
1052
1053    ------------------------
1054    -- Args_From_Expanded --
1055    ------------------------
1056
1057    function Args_From_Expanded (Args : Boolean_Chars) return String is
1058       Result : String (1 .. Args'Length);
1059       Index  : Natural := Result'First;
1060
1061    begin
1062       for A in Args'Range loop
1063          if Args (A) then
1064             Result (Index) := A;
1065             Index := Index + 1;
1066          end if;
1067       end loop;
1068
1069       return Result (1 .. Index - 1);
1070    end Args_From_Expanded;
1071
1072    ------------------
1073    -- Define_Alias --
1074    ------------------
1075
1076    procedure Define_Alias
1077      (Config   : in out Command_Line_Configuration;
1078       Switch   : String;
1079       Expanded : String)
1080    is
1081    begin
1082       if Config = null then
1083          Config := new Command_Line_Configuration_Record;
1084       end if;
1085
1086       Append (Config.Aliases,    new String'(Switch));
1087       Append (Config.Expansions, new String'(Expanded));
1088    end Define_Alias;
1089
1090    -------------------
1091    -- Define_Prefix --
1092    -------------------
1093
1094    procedure Define_Prefix
1095      (Config : in out Command_Line_Configuration;
1096       Prefix : String)
1097    is
1098    begin
1099       if Config = null then
1100          Config := new Command_Line_Configuration_Record;
1101       end if;
1102
1103       Append (Config.Prefixes, new String'(Prefix));
1104    end Define_Prefix;
1105
1106    -----------------------
1107    -- Set_Configuration --
1108    -----------------------
1109
1110    procedure Set_Configuration
1111      (Cmd    : in out Command_Line;
1112       Config : Command_Line_Configuration)
1113    is
1114    begin
1115       Cmd.Config := Config;
1116    end Set_Configuration;
1117
1118    -----------------------
1119    -- Get_Configuration --
1120    -----------------------
1121
1122    function Get_Configuration
1123      (Cmd : Command_Line) return Command_Line_Configuration is
1124    begin
1125       return Cmd.Config;
1126    end Get_Configuration;
1127
1128    ----------------------
1129    -- Set_Command_Line --
1130    ----------------------
1131
1132    procedure Set_Command_Line
1133      (Cmd                : in out Command_Line;
1134       Switches           : String;
1135       Getopt_Description : String := "";
1136       Switch_Char        : Character := '-')
1137    is
1138       Tmp    : Argument_List_Access;
1139       Parser : Opt_Parser;
1140       S      : Character;
1141
1142    begin
1143       Free (Cmd.Expanded);
1144       Free (Cmd.Params);
1145
1146       if Switches /= "" then
1147          Tmp := Argument_String_To_List (Switches);
1148          Initialize_Option_Scan (Parser, Tmp, Switch_Char);
1149
1150          loop
1151             begin
1152                S := Getopt (Switches    => "* " & Getopt_Description,
1153                             Concatenate => False,
1154                             Parser      => Parser);
1155                exit when S = ASCII.NUL;
1156
1157                if S = '*' then
1158                   Add_Switch (Cmd, Full_Switch (Parser), Parameter (Parser),
1159                               Separator (Parser));
1160                else
1161                   Add_Switch
1162                     (Cmd, Switch_Char & Full_Switch (Parser),
1163                      Parameter (Parser), Separator (Parser));
1164                end if;
1165
1166             exception
1167                when Invalid_Parameter =>
1168                   --  Add it with no parameter, if that's the way the user
1169                   --  wants it
1170                   Add_Switch (Cmd, Switch_Char & Full_Switch (Parser));
1171             end;
1172          end loop;
1173
1174          Free (Parser);
1175       end if;
1176    end Set_Command_Line;
1177
1178    ----------------
1179    -- Looking_At --
1180    ----------------
1181
1182    function Looking_At
1183      (Type_Str  : String;
1184       Index     : Natural;
1185       Substring : String) return Boolean is
1186    begin
1187       return Index + Substring'Length - 1 <= Type_Str'Last
1188         and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
1189    end Looking_At;
1190
1191    ----------------------------
1192    -- For_Each_Simple_Switch --
1193    ----------------------------
1194
1195    procedure For_Each_Simple_Switch
1196      (Cmd    : Command_Line;
1197       Switch : String)
1198    is
1199    begin
1200       --  Are we adding a switch that can in fact be expanded through aliases ?
1201       --  If yes, we add separately each of its expansion.
1202
1203       --  This takes care of expansions like "-T" -> "-gnatwrs", where the
1204       --  alias and its expansion do not have the same prefix. Given the order
1205       --  in which we do things here, the expansion of the alias will itself
1206       --  be checked for a common prefix and further split into simple switches
1207
1208       if Cmd.Config /= null
1209         and then Cmd.Config.Aliases /= null
1210       then
1211          for A in Cmd.Config.Aliases'Range loop
1212             if Cmd.Config.Aliases (A).all = Switch then
1213                For_Each_Simple_Switch
1214                  (Cmd, Cmd.Config.Expansions (A).all);
1215                return;
1216             end if;
1217          end loop;
1218       end if;
1219
1220       --  Are we adding a switch grouping several switches ? If yes, add each
1221       --  of the simple switches instead.
1222
1223       if Cmd.Config /= null
1224         and then Cmd.Config.Prefixes /= null
1225       then
1226          for P in Cmd.Config.Prefixes'Range loop
1227             if Switch'Length > Cmd.Config.Prefixes (P)'Length + 1
1228               and then Looking_At
1229                 (Switch, Switch'First, Cmd.Config.Prefixes (P).all)
1230             then
1231                --  Alias expansion will be done recursively
1232
1233                for S in Switch'First + Cmd.Config.Prefixes (P)'Length
1234                           .. Switch'Last
1235                loop
1236                   For_Each_Simple_Switch
1237                     (Cmd, Cmd.Config.Prefixes (P).all & Switch (S));
1238                end loop;
1239                return;
1240             end if;
1241          end loop;
1242       end if;
1243
1244       Callback (Switch);
1245    end For_Each_Simple_Switch;
1246
1247    ----------------
1248    -- Add_Switch --
1249    ----------------
1250
1251    procedure Add_Switch
1252      (Cmd       : in out Command_Line;
1253       Switch    : String;
1254       Parameter : String := "";
1255       Separator : Character := ' ')
1256    is
1257       procedure Add_Simple_Switch (Simple : String);
1258       --  Add a new switch that has had all its aliases expanded, and switches
1259       --  ungrouped. We know there is no more aliases in Switches
1260
1261       -----------------------
1262       -- Add_Simple_Switch --
1263       -----------------------
1264
1265       procedure Add_Simple_Switch (Simple : String) is
1266       begin
1267          if Cmd.Expanded = null then
1268             Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
1269             if Parameter = "" then
1270                Cmd.Params := new Argument_List'(1 .. 1 => null);
1271             else
1272                Cmd.Params := new Argument_List'
1273                  (1 .. 1 => new String'(Separator & Parameter));
1274             end if;
1275
1276          else
1277             --  Do we already have this switch ?
1278
1279             for C in Cmd.Expanded'Range loop
1280                if Cmd.Expanded (C).all = Simple
1281                  and then
1282                    ((Cmd.Params (C) = null and then Parameter = "")
1283                     or else
1284                       (Cmd.Params (C) /= null
1285                        and then Cmd.Params (C).all = Separator & Parameter))
1286                then
1287                   return;
1288                end if;
1289             end loop;
1290
1291             Append (Cmd.Expanded, new String'(Simple));
1292
1293             if Parameter = "" then
1294                Append (Cmd.Params, null);
1295             else
1296                Append (Cmd.Params, new String'(Separator & Parameter));
1297             end if;
1298          end if;
1299       end Add_Simple_Switch;
1300
1301       procedure Add_Simple_Switches is
1302          new For_Each_Simple_Switch (Add_Simple_Switch);
1303
1304    --  Start of processing for Add_Switch
1305
1306    begin
1307       Add_Simple_Switches (Cmd, Switch);
1308       Free (Cmd.Coalesce);
1309    end Add_Switch;
1310
1311    ------------
1312    -- Remove --
1313    ------------
1314
1315    procedure Remove (Line : in out Argument_List_Access; Index : Integer) is
1316       Tmp : Argument_List_Access := Line;
1317
1318    begin
1319       Line := new Argument_List (Tmp'First .. Tmp'Last - 1);
1320
1321       if Index /= Tmp'First then
1322          Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1);
1323       end if;
1324
1325       Free (Tmp (Index));
1326
1327       if Index /= Tmp'Last then
1328          Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last);
1329       end if;
1330
1331       Unchecked_Free (Tmp);
1332    end Remove;
1333
1334    ------------
1335    -- Append --
1336    ------------
1337
1338    procedure Append
1339      (Line : in out Argument_List_Access;
1340       Str  : String_Access)
1341    is
1342       Tmp : Argument_List_Access := Line;
1343    begin
1344       if Tmp /= null then
1345          Line := new Argument_List (Tmp'First .. Tmp'Last + 1);
1346          Line (Tmp'Range) := Tmp.all;
1347          Unchecked_Free (Tmp);
1348       else
1349          Line := new Argument_List (1 .. 1);
1350       end if;
1351
1352       Line (Line'Last) := Str;
1353    end Append;
1354
1355    -------------------
1356    -- Remove_Switch --
1357    -------------------
1358
1359    procedure Remove_Switch
1360      (Cmd        : in out Command_Line;
1361       Switch     : String;
1362       Remove_All : Boolean := False)
1363    is
1364       procedure Remove_Simple_Switch (Simple : String);
1365       --  Removes a simple switch, with no aliasing or grouping
1366
1367       --------------------------
1368       -- Remove_Simple_Switch --
1369       --------------------------
1370
1371       procedure Remove_Simple_Switch (Simple : String) is
1372          C : Integer;
1373
1374       begin
1375          if Cmd.Expanded /= null then
1376             C := Cmd.Expanded'First;
1377             while C <= Cmd.Expanded'Last loop
1378                if Cmd.Expanded (C).all = Simple then
1379                   Remove (Cmd.Expanded, C);
1380                   Remove (Cmd.Params, C);
1381
1382                   if not Remove_All then
1383                      return;
1384                   end if;
1385
1386                else
1387                   C := C + 1;
1388                end if;
1389             end loop;
1390          end if;
1391       end Remove_Simple_Switch;
1392
1393       procedure Remove_Simple_Switches is
1394          new For_Each_Simple_Switch (Remove_Simple_Switch);
1395
1396    --  Start of processing for Remove_Switch
1397
1398    begin
1399       Remove_Simple_Switches (Cmd, Switch);
1400       Free (Cmd.Coalesce);
1401    end Remove_Switch;
1402
1403    -------------------
1404    -- Remove_Switch --
1405    -------------------
1406
1407    procedure Remove_Switch
1408      (Cmd       : in out Command_Line;
1409       Switch    : String;
1410       Parameter : String)
1411    is
1412       procedure Remove_Simple_Switch (Simple : String);
1413       --  Removes a simple switch, with no aliasing or grouping
1414
1415       --------------------------
1416       -- Remove_Simple_Switch --
1417       --------------------------
1418
1419       procedure Remove_Simple_Switch (Simple : String) is
1420          C : Integer;
1421
1422       begin
1423          if Cmd.Expanded /= null then
1424             C := Cmd.Expanded'First;
1425             while C <= Cmd.Expanded'Last loop
1426                if Cmd.Expanded (C).all = Simple
1427                  and then
1428                    ((Cmd.Params (C) = null and then Parameter = "")
1429                       or else
1430                         (Cmd.Params (C) /= null
1431                            and then
1432
1433                            --  Ignore the separator stored in Parameter
1434
1435                              Cmd.Params (C) (Cmd.Params (C)'First + 1
1436                                              .. Cmd.Params (C)'Last) =
1437                          Parameter))
1438                then
1439                   Remove (Cmd.Expanded, C);
1440                   Remove (Cmd.Params, C);
1441
1442                   --  The switch is necessarily unique by construction of
1443                   --  Add_Switch
1444
1445                   return;
1446
1447                else
1448                   C := C + 1;
1449                end if;
1450             end loop;
1451          end if;
1452       end Remove_Simple_Switch;
1453
1454       procedure Remove_Simple_Switches is
1455          new For_Each_Simple_Switch (Remove_Simple_Switch);
1456
1457    --  Start of processing for Remove_Switch
1458
1459    begin
1460       Remove_Simple_Switches (Cmd, Switch);
1461       Free (Cmd.Coalesce);
1462    end Remove_Switch;
1463
1464    --------------------
1465    -- Group_Switches --
1466    --------------------
1467
1468    procedure Group_Switches
1469      (Cmd    : Command_Line;
1470       Result : Argument_List_Access;
1471       Params : Argument_List_Access)
1472    is
1473       type Boolean_Array is array (Result'Range) of Boolean;
1474
1475       Matched   : Boolean_Array;
1476       Count     : Natural;
1477       First     : Natural;
1478       From_Args : Boolean_Chars;
1479
1480    begin
1481       if Cmd.Config = null
1482         or else Cmd.Config.Prefixes = null
1483       then
1484          return;
1485       end if;
1486
1487       for P in Cmd.Config.Prefixes'Range loop
1488          Matched := (others => False);
1489          Count   := 0;
1490
1491          for C in Result'Range loop
1492             if Result (C) /= null
1493               and then Params (C) = null  --  ignored if has a parameter
1494               and then Looking_At
1495                 (Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all)
1496             then
1497                Matched (C) := True;
1498                Count := Count + 1;
1499             end if;
1500          end loop;
1501
1502          if Count > 1 then
1503             From_Args := (others => False);
1504             First   := 0;
1505
1506             for M in Matched'Range loop
1507                if Matched (M) then
1508                   if First = 0 then
1509                      First := M;
1510                   end if;
1511
1512                   for A in Result (M)'First + Cmd.Config.Prefixes (P)'Length
1513                     .. Result (M)'Last
1514                   loop
1515                      From_Args (Result (M)(A)) := True;
1516                   end loop;
1517                   Free (Result (M));
1518                end if;
1519             end loop;
1520
1521             Result (First) := new String'
1522               (Cmd.Config.Prefixes (P).all & Args_From_Expanded (From_Args));
1523          end if;
1524       end loop;
1525    end Group_Switches;
1526
1527    --------------------
1528    -- Alias_Switches --
1529    --------------------
1530
1531    procedure Alias_Switches
1532      (Cmd    : Command_Line;
1533       Result : Argument_List_Access;
1534       Params : Argument_List_Access)
1535    is
1536       Found : Boolean;
1537       First : Natural;
1538
1539       procedure Check_Cb (Switch : String);
1540       --  Comment required ???
1541
1542       procedure Remove_Cb (Switch : String);
1543       --  Comment required ???
1544
1545       --------------
1546       -- Check_Cb --
1547       --------------
1548
1549       procedure Check_Cb (Switch : String) is
1550       begin
1551          if Found then
1552             for E in Result'Range loop
1553                if Result (E) /= null
1554                  and then Params (E) = null    --  Ignore if has a param
1555                  and then Result (E).all = Switch
1556                then
1557                   return;
1558                end if;
1559             end loop;
1560
1561             Found := False;
1562          end if;
1563       end Check_Cb;
1564
1565       ---------------
1566       -- Remove_Cb --
1567       ---------------
1568
1569       procedure Remove_Cb (Switch : String) is
1570       begin
1571          for E in Result'Range loop
1572             if Result (E) /= null and then Result (E).all = Switch then
1573                if First > E then
1574                   First := E;
1575                end if;
1576                Free (Result (E));
1577                return;
1578             end if;
1579          end loop;
1580       end Remove_Cb;
1581
1582       procedure Check_All is new For_Each_Simple_Switch (Check_Cb);
1583       procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb);
1584
1585    --  Start of processing for Alias_Switches
1586
1587    begin
1588       if Cmd.Config = null
1589         or else Cmd.Config.Aliases = null
1590       then
1591          return;
1592       end if;
1593
1594       for A in Cmd.Config.Aliases'Range loop
1595
1596          --  Compute the various simple switches that make up the alias. We
1597          --  split the expansion into as many simple switches as possible, and
1598          --  then check whether the expanded command line has all of them.
1599
1600          Found := True;
1601          Check_All (Cmd, Cmd.Config.Expansions (A).all);
1602
1603          if Found then
1604             First := Integer'Last;
1605             Remove_All (Cmd, Cmd.Config.Expansions (A).all);
1606             Result (First) := new String'(Cmd.Config.Aliases (A).all);
1607          end if;
1608       end loop;
1609    end Alias_Switches;
1610
1611    -----------
1612    -- Start --
1613    -----------
1614
1615    procedure Start
1616      (Cmd      : in out Command_Line;
1617       Iter     : in out Command_Line_Iterator;
1618       Expanded : Boolean)
1619    is
1620    begin
1621       if Cmd.Expanded = null then
1622          Iter.List := null;
1623          return;
1624       end if;
1625
1626       --  Coalesce the switches as much as possible
1627
1628       if not Expanded
1629         and then Cmd.Coalesce = null
1630       then
1631          Cmd.Coalesce := new Argument_List (Cmd.Expanded'Range);
1632          for E in Cmd.Expanded'Range loop
1633             Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all);
1634          end loop;
1635
1636          --  Not a clone, since we will not modify the parameters anyway
1637
1638          Cmd.Coalesce_Params := Cmd.Params;
1639          Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Params);
1640          Group_Switches (Cmd, Cmd.Coalesce, Cmd.Params);
1641       end if;
1642
1643       if Expanded then
1644          Iter.List   := Cmd.Expanded;
1645          Iter.Params := Cmd.Params;
1646       else
1647          Iter.List   := Cmd.Coalesce;
1648          Iter.Params := Cmd.Coalesce_Params;
1649       end if;
1650
1651       if Iter.List = null then
1652          Iter.Current := Integer'Last;
1653       else
1654          Iter.Current := Iter.List'First;
1655          while Iter.Current <= Iter.List'Last
1656            and then Iter.List (Iter.Current) = null
1657          loop
1658             Iter.Current := Iter.Current + 1;
1659          end loop;
1660       end if;
1661    end Start;
1662
1663    --------------------
1664    -- Current_Switch --
1665    --------------------
1666
1667    function Current_Switch (Iter : Command_Line_Iterator) return String is
1668    begin
1669       return Iter.List (Iter.Current).all;
1670    end Current_Switch;
1671
1672    -----------------------
1673    -- Current_Separator --
1674    -----------------------
1675
1676    function Current_Separator (Iter : Command_Line_Iterator) return String is
1677    begin
1678       if Iter.Params = null
1679         or else Iter.Current > Iter.Params'Last
1680         or else Iter.Params (Iter.Current) = null
1681       then
1682          return "";
1683
1684       else
1685          declare
1686             Sep : constant Character :=
1687               Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First);
1688          begin
1689             if Sep = ASCII.NUL then
1690                return "";
1691             else
1692                return "" & Sep;
1693             end if;
1694          end;
1695       end if;
1696    end Current_Separator;
1697
1698    -----------------------
1699    -- Current_Parameter --
1700    -----------------------
1701
1702    function Current_Parameter (Iter : Command_Line_Iterator) return String is
1703    begin
1704       if Iter.Params = null
1705         or else Iter.Current > Iter.Params'Last
1706         or else Iter.Params (Iter.Current) = null
1707       then
1708          return "";
1709
1710       else
1711          declare
1712             P : constant String := Iter.Params (Iter.Current).all;
1713
1714          begin
1715             --  Skip separator
1716
1717             return P (P'First + 1 .. P'Last);
1718          end;
1719       end if;
1720    end Current_Parameter;
1721
1722    --------------
1723    -- Has_More --
1724    --------------
1725
1726    function Has_More (Iter : Command_Line_Iterator) return Boolean is
1727    begin
1728       return Iter.List /= null and then Iter.Current <= Iter.List'Last;
1729    end Has_More;
1730
1731    ----------
1732    -- Next --
1733    ----------
1734
1735    procedure Next (Iter : in out Command_Line_Iterator) is
1736    begin
1737       Iter.Current := Iter.Current + 1;
1738       while Iter.Current <= Iter.List'Last
1739         and then Iter.List (Iter.Current) = null
1740       loop
1741          Iter.Current := Iter.Current + 1;
1742       end loop;
1743    end Next;
1744
1745    ----------
1746    -- Free --
1747    ----------
1748
1749    procedure Free (Config : in out Command_Line_Configuration) is
1750    begin
1751       if Config /= null then
1752          Free (Config.Aliases);
1753          Free (Config.Expansions);
1754          Free (Config.Prefixes);
1755          Unchecked_Free (Config);
1756       end if;
1757    end Free;
1758
1759    ----------
1760    -- Free --
1761    ----------
1762
1763    procedure Free (Cmd : in out Command_Line) is
1764    begin
1765       Free (Cmd.Expanded);
1766       Free (Cmd.Coalesce);
1767       Free (Cmd.Params);
1768    end Free;
1769
1770 end GNAT.Command_Line;