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