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