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
  37 with GNAT.OS_Lib; use GNAT.OS_Lib;
  38
  39 package body GNAT.Command_Line is
  40
  41    package CL renames Ada.Command_Line;
  42
  43    type Switch_Parameter_Type is
  44      (Parameter_None,
  45       Parameter_With_Optional_Space,  --  ':' in getopt
  46       Parameter_With_Space_Or_Equal,  --  '=' in getopt
  47       Parameter_No_Space,             --  '!' in getopt
  48       Parameter_Optional);            --  '?' in getopt
  49
  50    procedure Set_Parameter
  51      (Variable : out Parameter_Type;
  52       Arg_Num  : Positive;
  53       First    : Positive;
  54       Last     : Positive;
  55       Extra    : Character := ASCII.NUL);
  56    pragma Inline (Set_Parameter);
  57    --  Set the parameter that will be returned by Parameter below
  58    --  Parameters need to be defined ???
  59
  60    function Goto_Next_Argument_In_Section (Parser : Opt_Parser) return Boolean;
  61    --  Go to the next argument on the command line. If we are at the end of
  62    --  the current section, we want to make sure there is no other identical
  63    --  section on the command line (there might be multiple instances of
  64    --  -largs). Returns True iff there is another argument.
  65
  66    function Get_File_Names_Case_Sensitive return Integer;
  67    pragma Import (C, Get_File_Names_Case_Sensitive,
  68                   "__gnat_get_file_names_case_sensitive");
  69
  70    File_Names_Case_Sensitive : constant Boolean :=
  71                                  Get_File_Names_Case_Sensitive /= 0;
  72
  73    procedure Canonical_Case_File_Name (S : in out String);
  74    --  Given a file name, converts it to canonical case form. For systems where
  75    --  file names are case sensitive, this procedure has no effect. If file
  76    --  names are not case sensitive (i.e. for example if you have the file
  77    --  "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then this call
  78    --  converts the given string to canonical all lower case form, so that two
  79    --  file names compare equal if they refer to the same file.
  80
  81    procedure Internal_Initialize_Option_Scan
  82      (Parser                   : Opt_Parser;
  83       Switch_Char              : Character;
  84       Stop_At_First_Non_Switch : Boolean;
  85       Section_Delimiters       : String);
  86    --  Initialize Parser, which must have been allocated already
  87
  88    function Argument (Parser : Opt_Parser; Index : Integer) return String;
  89    --  Return the index-th command line argument
  90
  91    procedure Find_Longest_Matching_Switch
  92      (Switches          : String;
  93       Arg               : String;
  94       Index_In_Switches : out Integer;
  95       Switch_Length     : out Integer;
  96       Param             : out Switch_Parameter_Type);
  97    --  return the Longest switch from Switches that matches at least
  98    --  partially Arg. Index_In_Switches is set to 0 if none matches
  99
 100    procedure Unchecked_Free is new Ada.Unchecked_Deallocation
 101      (Argument_List, Argument_List_Access);
 102
 103    procedure Unchecked_Free is new Ada.Unchecked_Deallocation
 104      (Command_Line_Configuration_Record, Command_Line_Configuration);
 105
 106    procedure Remove (Line : in out Argument_List_Access; Index : Integer);
 107    --  Remove a specific element from Line
 108
 109    procedure Add
 110      (Line   : in out Argument_List_Access;
 111       Str    : String_Access;
 112       Before : Boolean := False);
 113    --  Add a new element to Line. If Before is True, the item is inserted at
 114    --  the beginning, else it is appended.
 115
 116    function Can_Have_Parameter (S : String) return Boolean;
 117    --  True if S can have a parameter.
 118
 119    function Require_Parameter (S : String) return Boolean;
 120    --  True if S requires a parameter.
 121
 122    function Actual_Switch (S : String) return String;
 123    --  Remove any possible trailing '!', ':', '?' and '='
 124
 125    generic
 126       with procedure Callback (Simple_Switch : String; Parameter : String);
 127    procedure For_Each_Simple_Switch
 128      (Cmd       : Command_Line;
 129       Switch    : String;
 130       Parameter : String  := "";
 131       Unalias   : Boolean := True);
 132    --  Breaks Switch into as simple switches as possible (expanding aliases and
 133    --  ungrouping common prefixes when possible), and call Callback for each of
 134    --  these.
 135
 136    procedure Sort_Sections
 137      (Line     : GNAT.OS_Lib.Argument_List_Access;
 138       Sections : GNAT.OS_Lib.Argument_List_Access;
 139       Params   : GNAT.OS_Lib.Argument_List_Access);
 140    --  Reorder the command line switches so that the switches belonging to a
 141    --  section are grouped together.
 142
 143    procedure Group_Switches
 144      (Cmd      : Command_Line;
 145       Result   : Argument_List_Access;
 146       Sections : Argument_List_Access;
 147       Params   : Argument_List_Access);
 148    --  Group switches with common prefixes whenever possible. Once they have
 149    --  been grouped, we also check items for possible aliasing.
 150
 151    procedure Alias_Switches
 152      (Cmd    : Command_Line;
 153       Result : Argument_List_Access;
 154       Params : Argument_List_Access);
 155    --  When possible, replace one or more switches by an alias, i.e. a shorter
 156    --  version.
 157
 158    function Looking_At
 159      (Type_Str  : String;
 160       Index     : Natural;
 161       Substring : String) return Boolean;
 162    --  Return True if the characters starting at Index in Type_Str are
 163    --  equivalent to Substring.
 164
 165    --------------
 166    -- Argument --
 167    --------------
 168
 169    function Argument (Parser : Opt_Parser; Index : Integer) return String is
 170    begin
 171       if Parser.Arguments /= null then
 172          return Parser.Arguments (Index + Parser.Arguments'First - 1).all;
 173       else
 174          return CL.Argument (Index);
 175       end if;
 176    end Argument;
 177
 178    ------------------------------
 179    -- Canonical_Case_File_Name --
 180    ------------------------------
 181
 182    procedure Canonical_Case_File_Name (S : in out String) is
 183    begin
 184       if not File_Names_Case_Sensitive then
 185          for J in S'Range loop
 186             if S (J) in 'A' .. 'Z' then
 187                S (J) := Character'Val
 188                          (Character'Pos (S (J)) +
 189                           Character'Pos ('a')   -
 190                           Character'Pos ('A'));
 191             end if;
 192          end loop;
 193       end if;
 194    end Canonical_Case_File_Name;
 195
 196    ---------------
 197    -- Expansion --
 198    ---------------
 199
 200    function Expansion (Iterator : Expansion_Iterator) return String is
 201       use GNAT.Directory_Operations;
 202       type Pointer is access all Expansion_Iterator;
 203
 204       It   : constant Pointer := Iterator'Unrestricted_Access;
 205       S    : String (1 .. 1024);
 206       Last : Natural;
 207
 208       Current : Depth := It.Current_Depth;
 209       NL      : Positive;
 210
 211    begin
 212       --  It is assumed that a directory is opened at the current level.
 213       --  Otherwise GNAT.Directory_Operations.Directory_Error will be raised
 214       --  at the first call to Read.
 215
 216       loop
 217          Read (It.Levels (Current).Dir, S, Last);
 218
 219          --  If we have exhausted the directory, close it and go back one level
 220
 221          if Last = 0 then
 222             Close (It.Levels (Current).Dir);
 223
 224             --  If we are at level 1, we are finished; return an empty string
 225
 226             if Current = 1 then
 227                return String'(1 .. 0 => ' ');
 228             else
 229                --  Otherwise continue with the directory at the previous level
 230
 231                Current := Current - 1;
 232                It.Current_Depth := Current;
 233             end if;
 234
 235          --  If this is a directory, that is neither "." or "..", attempt to
 236          --  go to the next level.
 237
 238          elsif Is_Directory
 239            (It.Dir_Name (1 .. It.Levels (Current).Name_Last) & S (1 .. Last))
 240            and then S (1 .. Last) /= "."
 241            and then S (1 .. Last) /= ".."
 242          then
 243             --  We can go to the next level only if we have not reached the
 244             --  maximum depth,
 245
 246             if Current < It.Maximum_Depth then
 247                NL := It.Levels (Current).Name_Last;
 248
 249                --  And if relative path of this new directory is not too long
 250
 251                if NL + Last + 1 < Max_Path_Length then
 252                   Current := Current + 1;
 253                   It.Current_Depth := Current;
 254                   It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last);
 255                   NL := NL + Last + 1;
 256                   It.Dir_Name (NL) := Directory_Separator;
 257                   It.Levels (Current).Name_Last := NL;
 258                   Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
 259
 260                   --  Open the new directory, and read from it
 261
 262                   GNAT.Directory_Operations.Open
 263                     (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
 264                end if;
 265             end if;
 266
 267          --  If not a directory, check the relative path against the pattern
 268
 269          else
 270             declare
 271                Name : String :=
 272                         It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
 273                           & S (1 .. Last);
 274             begin
 275                Canonical_Case_File_Name (Name);
 276
 277                --  If it matches return the relative path
 278
 279                if GNAT.Regexp.Match (Name, Iterator.Regexp) then
 280                   return Name;
 281                end if;
 282             end;
 283          end if;
 284       end loop;
 285    end Expansion;
 286
 287    -----------------
 288    -- Full_Switch --
 289    -----------------
 290
 291    function Full_Switch
 292      (Parser : Opt_Parser := Command_Line_Parser) return String
 293    is
 294    begin
 295       if Parser.The_Switch.Extra = ASCII.NUL then
 296          return Argument (Parser, Parser.The_Switch.Arg_Num)
 297            (Parser.The_Switch.First .. Parser.The_Switch.Last);
 298       else
 299          return Parser.The_Switch.Extra
 300            & Argument (Parser, Parser.The_Switch.Arg_Num)
 301            (Parser.The_Switch.First .. Parser.The_Switch.Last);
 302       end if;
 303    end Full_Switch;
 304
 305    ------------------
 306    -- Get_Argument --
 307    ------------------
 308
 309    function Get_Argument
 310      (Do_Expansion : Boolean    := False;
 311       Parser       : Opt_Parser := Command_Line_Parser) return String
 312    is
 313    begin
 314       if Parser.In_Expansion then
 315          declare
 316             S : constant String := Expansion (Parser.Expansion_It);
 317          begin
 318             if S'Length /= 0 then
 319                return S;
 320             else
 321                Parser.In_Expansion := False;
 322             end if;
 323          end;
 324       end if;
 325
 326       if Parser.Current_Argument > Parser.Arg_Count then
 327
 328          --  If this is the first time this function is called
 329
 330          if Parser.Current_Index = 1 then
 331             Parser.Current_Argument := 1;
 332             while Parser.Current_Argument <= Parser.Arg_Count
 333               and then Parser.Section (Parser.Current_Argument) /=
 334                 Parser.Current_Section
 335             loop
 336                Parser.Current_Argument := Parser.Current_Argument + 1;
 337             end loop;
 338          else
 339             return String'(1 .. 0 => ' ');
 340          end if;
 341
 342       elsif Parser.Section (Parser.Current_Argument) = 0 then
 343          while Parser.Current_Argument <= Parser.Arg_Count
 344            and then Parser.Section (Parser.Current_Argument) /=
 345              Parser.Current_Section
 346          loop
 347             Parser.Current_Argument := Parser.Current_Argument + 1;
 348          end loop;
 349       end if;
 350
 351       Parser.Current_Index := Integer'Last;
 352
 353       while Parser.Current_Argument <= Parser.Arg_Count
 354         and then Parser.Is_Switch (Parser.Current_Argument)
 355       loop
 356          Parser.Current_Argument := Parser.Current_Argument + 1;
 357       end loop;
 358
 359       if Parser.Current_Argument > Parser.Arg_Count then
 360          return String'(1 .. 0 => ' ');
 361       elsif Parser.Section (Parser.Current_Argument) = 0 then
 362          return Get_Argument (Do_Expansion);
 363       end if;
 364
 365       Parser.Current_Argument := Parser.Current_Argument + 1;
 366
 367       --  Could it be a file name with wild cards to expand?
 368
 369       if Do_Expansion then
 370          declare
 371             Arg   : constant String :=
 372                       Argument (Parser, Parser.Current_Argument - 1);
 373             Index : Positive;
 374
 375          begin
 376             Index := Arg'First;
 377             while Index <= Arg'Last loop
 378                if Arg (Index) = '*'
 379                  or else Arg (Index) = '?'
 380                  or else Arg (Index) = '['
 381                then
 382                   Parser.In_Expansion := True;
 383                   Start_Expansion (Parser.Expansion_It, Arg);
 384                   return Get_Argument (Do_Expansion);
 385                end if;
 386
 387                Index := Index + 1;
 388             end loop;
 389          end;
 390       end if;
 391
 392       return Argument (Parser, Parser.Current_Argument - 1);
 393    end Get_Argument;
 394
 395    ----------------------------------
 396    -- Find_Longest_Matching_Switch --
 397    ----------------------------------
 398
 399    procedure Find_Longest_Matching_Switch
 400      (Switches          : String;
 401       Arg               : String;
 402       Index_In_Switches : out Integer;
 403       Switch_Length     : out Integer;
 404       Param             : out Switch_Parameter_Type)
 405    is
 406       Index  : Natural;
 407       Length : Natural := 1;
 408       P      : Switch_Parameter_Type;
 409
 410    begin
 411       Index_In_Switches := 0;
 412       Switch_Length     := 0;
 413
 414       --  Remove all leading spaces first to make sure that Index points
 415       --  at the start of the first switch.
 416
 417       Index := Switches'First;
 418       while Index <= Switches'Last and then Switches (Index) = ' ' loop
 419          Index := Index + 1;
 420       end loop;
 421
 422       while Index <= Switches'Last loop
 423
 424          --  Search the length of the parameter at this position in Switches
 425
 426          Length := Index;
 427          while Length <= Switches'Last
 428            and then Switches (Length) /= ' '
 429          loop
 430             Length := Length + 1;
 431          end loop;
 432
 433          if Length = Index + 1 then
 434             P := Parameter_None;
 435          else
 436             case Switches (Length - 1) is
 437                when ':'    =>
 438                   P      := Parameter_With_Optional_Space;
 439                   Length := Length - 1;
 440                when '='    =>
 441                   P      := Parameter_With_Space_Or_Equal;
 442                   Length := Length - 1;
 443                when '!'    =>
 444                   P      := Parameter_No_Space;
 445                   Length := Length - 1;
 446                when '?'    =>
 447                   P      := Parameter_Optional;
 448                   Length := Length - 1;
 449                when others =>
 450                   P      := Parameter_None;
 451             end case;
 452          end if;
 453
 454          --  If it is the one we searched, it may be a candidate
 455
 456          if Arg'First + Length - 1 - Index <= Arg'Last
 457            and then Switches (Index .. Length - 1) =
 458                       Arg (Arg'First .. Arg'First + Length - 1 - Index)
 459            and then Length - Index > Switch_Length
 460          then
 461             Param             := P;
 462             Index_In_Switches := Index;
 463             Switch_Length     := Length - Index;
 464          end if;
 465
 466          --  Look for the next switch in Switches
 467
 468          while Index <= Switches'Last
 469            and then Switches (Index) /= ' '
 470          loop
 471             Index := Index + 1;
 472          end loop;
 473
 474          Index := Index + 1;
 475       end loop;
 476    end Find_Longest_Matching_Switch;
 477
 478    ------------
 479    -- Getopt --
 480    ------------
 481
 482    function Getopt
 483      (Switches    : String;
 484       Concatenate : Boolean := True;
 485       Parser      : Opt_Parser := Command_Line_Parser) return Character
 486    is
 487       Dummy : Boolean;
 488       pragma Unreferenced (Dummy);
 489
 490    begin
 491       <<Restart>>
 492
 493       --  If we have finished parsing the current command line item (there
 494       --  might be multiple switches in a single item), then go to the next
 495       --  element
 496
 497       if Parser.Current_Argument > Parser.Arg_Count
 498         or else (Parser.Current_Index >
 499                    Argument (Parser, Parser.Current_Argument)'Last
 500                  and then not Goto_Next_Argument_In_Section (Parser))
 501       then
 502          return ASCII.NUL;
 503       end if;
 504
 505       --  By default, the switch will not have a parameter
 506
 507       Parser.The_Parameter :=
 508         (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
 509       Parser.The_Separator := ASCII.NUL;
 510
 511       declare
 512          Arg            : constant String :=
 513                             Argument (Parser, Parser.Current_Argument);
 514          Index_Switches : Natural := 0;
 515          Max_Length     : Natural := 0;
 516          End_Index      : Natural;
 517          Param          : Switch_Parameter_Type;
 518       begin
 519          --  If we are on a new item, test if this might be a switch
 520
 521          if Parser.Current_Index = Arg'First then
 522             if Arg (Arg'First) /= Parser.Switch_Character then
 523
 524                --  If it isn't a switch, return it immediately. We also know it
 525                --  isn't the parameter to a previous switch, since that has
 526                --  already been handled
 527
 528                if Switches (Switches'First) = '*' then
 529                   Set_Parameter
 530                     (Parser.The_Switch,
 531                      Arg_Num => Parser.Current_Argument,
 532                      First   => Arg'First,
 533                      Last    => Arg'Last);
 534                   Parser.Is_Switch (Parser.Current_Argument) := True;
 535                   Dummy := Goto_Next_Argument_In_Section (Parser);
 536                   return '*';
 537                end if;
 538
 539                if Parser.Stop_At_First then
 540                   Parser.Current_Argument := Positive'Last;
 541                   return ASCII.NUL;
 542
 543                elsif not Goto_Next_Argument_In_Section (Parser) then
 544                   return ASCII.NUL;
 545
 546                else
 547                   --  Recurse to get the next switch on the command line
 548
 549                   goto Restart;
 550                end if;
 551             end if;
 552
 553             --  We are on the first character of a new command line argument,
 554             --  which starts with Switch_Character. Further analysis is needed.
 555
 556             Parser.Current_Index := Parser.Current_Index + 1;
 557             Parser.Is_Switch (Parser.Current_Argument) := True;
 558          end if;
 559
 560          Find_Longest_Matching_Switch
 561            (Switches          => Switches,
 562             Arg               => Arg (Parser.Current_Index .. Arg'Last),
 563             Index_In_Switches => Index_Switches,
 564             Switch_Length     => Max_Length,
 565             Param             => Param);
 566
 567          --  If switch is not accepted, it is either invalid or is returned
 568          --  in the context of '*'.
 569
 570          if Index_Switches = 0 then
 571
 572             --  Depending on the value of Concatenate, the full switch is
 573             --  a single character or the rest of the argument.
 574
 575             if Concatenate then
 576                End_Index := Parser.Current_Index;
 577             else
 578                End_Index := Arg'Last;
 579             end if;
 580
 581             if Switches (Switches'First) = '*' then
 582
 583                --  Always prepend the switch character, so that users know that
 584                --  this comes from a switch on the command line. This is
 585                --  especially important when Concatenate is False, since
 586                --  otherwise the current argument first character is lost.
 587
 588                Set_Parameter
 589                  (Parser.The_Switch,
 590                   Arg_Num => Parser.Current_Argument,
 591                   First   => Parser.Current_Index,
 592                   Last    => Arg'Last,
 593                   Extra   => Parser.Switch_Character);
 594                Parser.Is_Switch (Parser.Current_Argument) := True;
 595                Dummy := Goto_Next_Argument_In_Section (Parser);
 596                return '*';
 597             end if;
 598
 599             Set_Parameter
 600               (Parser.The_Switch,
 601                Arg_Num => Parser.Current_Argument,
 602                First   => Parser.Current_Index,
 603                Last    => End_Index);
 604             Parser.Current_Index := End_Index + 1;
 605             raise Invalid_Switch;
 606          end if;
 607
 608          End_Index := Parser.Current_Index + Max_Length - 1;
 609          Set_Parameter
 610            (Parser.The_Switch,
 611             Arg_Num => Parser.Current_Argument,
 612             First   => Parser.Current_Index,
 613             Last    => End_Index);
 614
 615          case Param is
 616             when Parameter_With_Optional_Space =>
 617                if End_Index < Arg'Last then
 618                   Set_Parameter
 619                     (Parser.The_Parameter,
 620                      Arg_Num => Parser.Current_Argument,
 621                      First   => End_Index + 1,
 622                      Last    => Arg'Last);
 623                   Dummy := Goto_Next_Argument_In_Section (Parser);
 624
 625                elsif Parser.Current_Argument < Parser.Arg_Count
 626                  and then Parser.Section (Parser.Current_Argument + 1) /= 0
 627                then
 628                   Parser.Current_Argument := Parser.Current_Argument + 1;
 629                   Parser.The_Separator := ' ';
 630                   Set_Parameter
 631                     (Parser.The_Parameter,
 632                      Arg_Num => Parser.Current_Argument,
 633                      First => Argument (Parser, Parser.Current_Argument)'First,
 634                      Last  => Argument (Parser, Parser.Current_Argument)'Last);
 635                   Parser.Is_Switch (Parser.Current_Argument) := True;
 636                   Dummy := Goto_Next_Argument_In_Section (Parser);
 637
 638                else
 639                   Parser.Current_Index := End_Index + 1;
 640                   raise Invalid_Parameter;
 641                end if;
 642
 643             when Parameter_With_Space_Or_Equal =>
 644
 645                --  If the switch is of the form <switch>=xxx
 646
 647                if End_Index < Arg'Last then
 648
 649                   if Arg (End_Index + 1) = '='
 650                     and then End_Index + 1 < Arg'Last
 651                   then
 652                      Parser.The_Separator := '=';
 653                      Set_Parameter
 654                        (Parser.The_Parameter,
 655                         Arg_Num => Parser.Current_Argument,
 656                         First   => End_Index + 2,
 657                         Last    => Arg'Last);
 658                      Dummy := Goto_Next_Argument_In_Section (Parser);
 659                   else
 660                      Parser.Current_Index := End_Index + 1;
 661                      raise Invalid_Parameter;
 662                   end if;
 663
 664                --  If the switch is of the form <switch> xxx
 665
 666                elsif Parser.Current_Argument < Parser.Arg_Count
 667                  and then Parser.Section (Parser.Current_Argument + 1) /= 0
 668                then
 669                   Parser.Current_Argument := Parser.Current_Argument + 1;
 670                   Parser.The_Separator := ' ';
 671                   Set_Parameter
 672                     (Parser.The_Parameter,
 673                      Arg_Num => Parser.Current_Argument,
 674                      First => Argument (Parser, Parser.Current_Argument)'First,
 675                      Last  => Argument (Parser, Parser.Current_Argument)'Last);
 676                   Parser.Is_Switch (Parser.Current_Argument) := True;
 677                   Dummy := Goto_Next_Argument_In_Section (Parser);
 678
 679                else
 680                   Parser.Current_Index := End_Index + 1;
 681                   raise Invalid_Parameter;
 682                end if;
 683
 684             when Parameter_No_Space =>
 685
 686                if End_Index < Arg'Last then
 687                   Set_Parameter
 688                     (Parser.The_Parameter,
 689                      Arg_Num => Parser.Current_Argument,
 690                      First   => End_Index + 1,
 691                      Last    => Arg'Last);
 692                   Dummy := Goto_Next_Argument_In_Section (Parser);
 693
 694                else
 695                   Parser.Current_Index := End_Index + 1;
 696                   raise Invalid_Parameter;
 697                end if;
 698
 699             when Parameter_Optional =>
 700
 701                if End_Index < Arg'Last then
 702                   Set_Parameter
 703                     (Parser.The_Parameter,
 704                      Arg_Num => Parser.Current_Argument,
 705                      First   => End_Index + 1,
 706                      Last    => Arg'Last);
 707                end if;
 708
 709                Dummy := Goto_Next_Argument_In_Section (Parser);
 710
 711             when Parameter_None =>
 712
 713                if Concatenate or else End_Index = Arg'Last then
 714                   Parser.Current_Index := End_Index + 1;
 715
 716                else
 717                   --  If Concatenate is False and the full argument is not
 718                   --  recognized as a switch, this is an invalid switch.
 719
 720                   if Switches (Switches'First) = '*' then
 721                      Set_Parameter
 722                        (Parser.The_Switch,
 723                         Arg_Num => Parser.Current_Argument,
 724                         First   => Arg'First,
 725                         Last    => Arg'Last);
 726                      Parser.Is_Switch (Parser.Current_Argument) := True;
 727                      Dummy := Goto_Next_Argument_In_Section (Parser);
 728                      return '*';
 729                   end if;
 730
 731                   Set_Parameter
 732                     (Parser.The_Switch,
 733                      Arg_Num => Parser.Current_Argument,
 734                      First   => Parser.Current_Index,
 735                      Last    => Arg'Last);
 736                   Parser.Current_Index := Arg'Last + 1;
 737                   raise Invalid_Switch;
 738                end if;
 739          end case;
 740
 741          return Switches (Index_Switches);
 742       end;
 743    end Getopt;
 744
 745    -----------------------------------
 746    -- Goto_Next_Argument_In_Section --
 747    -----------------------------------
 748
 749    function Goto_Next_Argument_In_Section
 750      (Parser : Opt_Parser) return Boolean
 751    is
 752    begin
 753       Parser.Current_Argument := Parser.Current_Argument + 1;
 754
 755       if Parser.Current_Argument > Parser.Arg_Count
 756         or else Parser.Section (Parser.Current_Argument) = 0
 757       then
 758          loop
 759             Parser.Current_Argument := Parser.Current_Argument + 1;
 760
 761             if Parser.Current_Argument > Parser.Arg_Count then
 762                Parser.Current_Index := 1;
 763                return False;
 764             end if;
 765
 766             exit when Parser.Section (Parser.Current_Argument) =
 767                                                   Parser.Current_Section;
 768          end loop;
 769       end if;
 770
 771       Parser.Current_Index :=
 772         Argument (Parser, Parser.Current_Argument)'First;
 773
 774       return True;
 775    end Goto_Next_Argument_In_Section;
 776
 777    ------------------
 778    -- Goto_Section --
 779    ------------------
 780
 781    procedure Goto_Section
 782      (Name   : String := "";
 783       Parser : Opt_Parser := Command_Line_Parser)
 784    is
 785       Index : Integer;
 786
 787    begin
 788       Parser.In_Expansion := False;
 789
 790       if Name = "" then
 791          Parser.Current_Argument := 1;
 792          Parser.Current_Index    := 1;
 793          Parser.Current_Section  := 1;
 794          return;
 795       end if;
 796
 797       Index := 1;
 798       while Index <= Parser.Arg_Count loop
 799          if Parser.Section (Index) = 0
 800            and then Argument (Parser, Index) = Parser.Switch_Character & Name
 801          then
 802             Parser.Current_Argument := Index + 1;
 803             Parser.Current_Index    := 1;
 804
 805             if Parser.Current_Argument <= Parser.Arg_Count then
 806                Parser.Current_Section :=
 807                  Parser.Section (Parser.Current_Argument);
 808             end if;
 809             return;
 810          end if;
 811
 812          Index := Index + 1;
 813       end loop;
 814
 815       Parser.Current_Argument := Positive'Last;
 816       Parser.Current_Index := 2;   --  so that Get_Argument returns nothing
 817    end Goto_Section;
 818
 819    ----------------------------
 820    -- Initialize_Option_Scan --
 821    ----------------------------
 822
 823    procedure Initialize_Option_Scan
 824      (Switch_Char              : Character := '-';
 825       Stop_At_First_Non_Switch : Boolean   := False;
 826       Section_Delimiters       : String    := "")
 827    is
 828    begin
 829       Internal_Initialize_Option_Scan
 830         (Parser                   => Command_Line_Parser,
 831          Switch_Char              => Switch_Char,
 832          Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 833          Section_Delimiters       => Section_Delimiters);
 834    end Initialize_Option_Scan;
 835
 836    ----------------------------
 837    -- Initialize_Option_Scan --
 838    ----------------------------
 839
 840    procedure Initialize_Option_Scan
 841      (Parser                   : out Opt_Parser;
 842       Command_Line             : GNAT.OS_Lib.Argument_List_Access;
 843       Switch_Char              : Character := '-';
 844       Stop_At_First_Non_Switch : Boolean := False;
 845       Section_Delimiters       : String := "")
 846    is
 847    begin
 848       Free (Parser);
 849
 850       if Command_Line = null then
 851          Parser := new Opt_Parser_Data (CL.Argument_Count);
 852          Initialize_Option_Scan
 853            (Switch_Char              => Switch_Char,
 854             Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 855             Section_Delimiters       => Section_Delimiters);
 856       else
 857          Parser := new Opt_Parser_Data (Command_Line'Length);
 858          Parser.Arguments := Command_Line;
 859          Internal_Initialize_Option_Scan
 860            (Parser                   => Parser,
 861             Switch_Char              => Switch_Char,
 862             Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 863             Section_Delimiters       => Section_Delimiters);
 864       end if;
 865    end Initialize_Option_Scan;
 866
 867    -------------------------------------
 868    -- Internal_Initialize_Option_Scan --
 869    -------------------------------------
 870
 871    procedure Internal_Initialize_Option_Scan
 872      (Parser                   : Opt_Parser;
 873       Switch_Char              : Character;
 874       Stop_At_First_Non_Switch : Boolean;
 875       Section_Delimiters       : String)
 876    is
 877       Section_Num     : Section_Number;
 878       Section_Index   : Integer;
 879       Last            : Integer;
 880       Delimiter_Found : Boolean;
 881
 882       Discard : Boolean;
 883       pragma Warnings (Off, Discard);
 884
 885    begin
 886       Parser.Current_Argument := 0;
 887       Parser.Current_Index    := 0;
 888       Parser.In_Expansion     := False;
 889       Parser.Switch_Character := Switch_Char;
 890       Parser.Stop_At_First    := Stop_At_First_Non_Switch;
 891
 892       --  If we are using sections, we have to preprocess the command line
 893       --  to delimit them. A section can be repeated, so we just give each
 894       --  item on the command line a section number
 895
 896       Section_Num   := 1;
 897       Section_Index := Section_Delimiters'First;
 898       while Section_Index <= Section_Delimiters'Last loop
 899          Last := Section_Index;
 900          while Last <= Section_Delimiters'Last
 901            and then Section_Delimiters (Last) /= ' '
 902          loop
 903             Last := Last + 1;
 904          end loop;
 905
 906          Delimiter_Found := False;
 907          Section_Num := Section_Num + 1;
 908
 909          for Index in 1 .. Parser.Arg_Count loop
 910             if Argument (Parser, Index)(1) = Parser.Switch_Character
 911               and then
 912                 Argument (Parser, Index) = Parser.Switch_Character &
 913                                         Section_Delimiters
 914                                           (Section_Index .. Last - 1)
 915             then
 916                Parser.Section (Index) := 0;
 917                Delimiter_Found := True;
 918
 919             elsif Parser.Section (Index) = 0 then
 920                Delimiter_Found := False;
 921
 922             elsif Delimiter_Found then
 923                Parser.Section (Index) := Section_Num;
 924             end if;
 925          end loop;
 926
 927          Section_Index := Last + 1;
 928          while Section_Index <= Section_Delimiters'Last
 929            and then Section_Delimiters (Section_Index) = ' '
 930          loop
 931             Section_Index := Section_Index + 1;
 932          end loop;
 933       end loop;
 934
 935       Discard := Goto_Next_Argument_In_Section (Parser);
 936    end Internal_Initialize_Option_Scan;
 937
 938    ---------------
 939    -- Parameter --
 940    ---------------
 941
 942    function Parameter
 943      (Parser : Opt_Parser := Command_Line_Parser) return String
 944    is
 945    begin
 946       if Parser.The_Parameter.First > Parser.The_Parameter.Last then
 947          return String'(1 .. 0 => ' ');
 948       else
 949          return Argument (Parser, Parser.The_Parameter.Arg_Num)
 950            (Parser.The_Parameter.First .. Parser.The_Parameter.Last);
 951       end if;
 952    end Parameter;
 953
 954    ---------------
 955    -- Separator --
 956    ---------------
 957
 958    function Separator
 959      (Parser : Opt_Parser := Command_Line_Parser) return Character
 960    is
 961    begin
 962       return Parser.The_Separator;
 963    end Separator;
 964
 965    -------------------
 966    -- Set_Parameter --
 967    -------------------
 968
 969    procedure Set_Parameter
 970      (Variable : out Parameter_Type;
 971       Arg_Num  : Positive;
 972       First    : Positive;
 973       Last     : Positive;
 974       Extra    : Character := ASCII.NUL)
 975    is
 976    begin
 977       Variable.Arg_Num := Arg_Num;
 978       Variable.First   := First;
 979       Variable.Last    := Last;
 980       Variable.Extra   := Extra;
 981    end Set_Parameter;
 982
 983    ---------------------
 984    -- Start_Expansion --
 985    ---------------------
 986
 987    procedure Start_Expansion
 988      (Iterator     : out Expansion_Iterator;
 989       Pattern      : String;
 990       Directory    : String := "";
 991       Basic_Regexp : Boolean := True)
 992    is
 993       Directory_Separator : Character;
 994       pragma Import (C, Directory_Separator, "__gnat_dir_separator");
 995
 996       First : Positive := Pattern'First;
 997       Pat   : String := Pattern;
 998
 999    begin
1000       Canonical_Case_File_Name (Pat);
1001       Iterator.Current_Depth := 1;
1002
1003       --  If Directory is unspecified, use the current directory ("./" or ".\")
1004
1005       if Directory = "" then
1006          Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
1007          Iterator.Start := 3;
1008
1009       else
1010          Iterator.Dir_Name (1 .. Directory'Length) := Directory;
1011          Iterator.Start := Directory'Length + 1;
1012          Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length));
1013
1014          --  Make sure that the last character is a directory separator
1015
1016          if Directory (Directory'Last) /= Directory_Separator then
1017             Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
1018             Iterator.Start := Iterator.Start + 1;
1019          end if;
1020       end if;
1021
1022       Iterator.Levels (1).Name_Last := Iterator.Start - 1;
1023
1024       --  Open the initial Directory, at depth 1
1025
1026       GNAT.Directory_Operations.Open
1027         (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
1028
1029       --  If in the current directory and the pattern starts with "./" or ".\",
1030       --  drop the "./" or ".\" from the pattern.
1031
1032       if Directory = "" and then Pat'Length > 2
1033         and then Pat (Pat'First) = '.'
1034         and then Pat (Pat'First + 1) = Directory_Separator
1035       then
1036          First := Pat'First + 2;
1037       end if;
1038
1039       Iterator.Regexp :=
1040         GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True);
1041
1042       Iterator.Maximum_Depth := 1;
1043
1044       --  Maximum_Depth is equal to 1 plus the number of directory separators
1045       --  in the pattern.
1046
1047       for Index in First .. Pat'Last loop
1048          if Pat (Index) = Directory_Separator then
1049             Iterator.Maximum_Depth := Iterator.Maximum_Depth + 1;
1050             exit when Iterator.Maximum_Depth = Max_Depth;
1051          end if;
1052       end loop;
1053    end Start_Expansion;
1054
1055    ----------
1056    -- Free --
1057    ----------
1058
1059    procedure Free (Parser : in out Opt_Parser) is
1060       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1061         (Opt_Parser_Data, Opt_Parser);
1062    begin
1063       if Parser /= null
1064         and then Parser /= Command_Line_Parser
1065       then
1066          Free (Parser.Arguments);
1067          Unchecked_Free (Parser);
1068       end if;
1069    end Free;
1070
1071    ------------------
1072    -- Define_Alias --
1073    ------------------
1074
1075    procedure Define_Alias
1076      (Config   : in out Command_Line_Configuration;
1077       Switch   : String;
1078       Expanded : String)
1079    is
1080    begin
1081       if Config = null then
1082          Config := new Command_Line_Configuration_Record;
1083       end if;
1084
1085       Add (Config.Aliases,    new String'(Switch));
1086       Add (Config.Expansions, new String'(Expanded));
1087    end Define_Alias;
1088
1089    -------------------
1090    -- Define_Prefix --
1091    -------------------
1092
1093    procedure Define_Prefix
1094      (Config : in out Command_Line_Configuration;
1095       Prefix : String)
1096    is
1097    begin
1098       if Config = null then
1099          Config := new Command_Line_Configuration_Record;
1100       end if;
1101
1102       Add (Config.Prefixes, new String'(Prefix));
1103    end Define_Prefix;
1104
1105    -------------------
1106    -- Define_Switch --
1107    -------------------
1108
1109    procedure Define_Switch
1110      (Config : in out Command_Line_Configuration;
1111       Switch : String)
1112    is
1113    begin
1114       if Config = null then
1115          Config := new Command_Line_Configuration_Record;
1116       end if;
1117
1118       Add (Config.Switches, new String'(Switch));
1119    end Define_Switch;
1120
1121    --------------------
1122    -- Define_Section --
1123    --------------------
1124
1125    procedure Define_Section
1126      (Config : in out Command_Line_Configuration;
1127       Section : String)
1128    is
1129    begin
1130       if Config = null then
1131          Config := new Command_Line_Configuration_Record;
1132       end if;
1133
1134       Add (Config.Sections, new String'(Section));
1135    end Define_Section;
1136
1137    ------------------
1138    -- Get_Switches --
1139    ------------------
1140
1141    function Get_Switches
1142      (Config      : Command_Line_Configuration;
1143       Switch_Char : Character)
1144       return String
1145    is
1146       Ret : Ada.Strings.Unbounded.Unbounded_String;
1147       use type Ada.Strings.Unbounded.Unbounded_String;
1148
1149    begin
1150       if Config = null or else Config.Switches = null then
1151          return "";
1152       end if;
1153
1154       for J in Config.Switches'Range loop
1155          if Config.Switches (J) (Config.Switches (J)'First) = Switch_Char then
1156             Ret :=
1157               Ret & " " &
1158                 Config.Switches (J)
1159                   (Config.Switches (J)'First + 1 .. Config.Switches (J)'Last);
1160          else
1161             Ret := Ret & " " & Config.Switches (J).all;
1162          end if;
1163       end loop;
1164
1165       return Ada.Strings.Unbounded.To_String (Ret);
1166    end Get_Switches;
1167
1168    -----------------------
1169    -- Set_Configuration --
1170    -----------------------
1171
1172    procedure Set_Configuration
1173      (Cmd    : in out Command_Line;
1174       Config : Command_Line_Configuration)
1175    is
1176    begin
1177       Cmd.Config := Config;
1178    end Set_Configuration;
1179
1180    -----------------------
1181    -- Get_Configuration --
1182    -----------------------
1183
1184    function Get_Configuration
1185      (Cmd : Command_Line) return Command_Line_Configuration is
1186    begin
1187       return Cmd.Config;
1188    end Get_Configuration;
1189
1190    ----------------------
1191    -- Set_Command_Line --
1192    ----------------------
1193
1194    procedure Set_Command_Line
1195      (Cmd                : in out Command_Line;
1196       Switches           : String;
1197       Getopt_Description : String := "";
1198       Switch_Char        : Character := '-')
1199    is
1200       Tmp     : Argument_List_Access;
1201       Parser  : Opt_Parser;
1202       S       : Character;
1203       Section : String_Access := null;
1204
1205       function Real_Full_Switch
1206         (S      : Character;
1207          Parser : Opt_Parser) return String;
1208       --  Ensure that the returned switch value contains the
1209       --  Switch_Char prefix if needed.
1210
1211       ----------------------
1212       -- Real_Full_Switch --
1213       ----------------------
1214
1215       function Real_Full_Switch
1216         (S      : Character;
1217          Parser : Opt_Parser) return String
1218       is
1219       begin
1220          if S = '*' then
1221             return Full_Switch (Parser);
1222          else
1223             return Switch_Char & Full_Switch (Parser);
1224          end if;
1225       end Real_Full_Switch;
1226
1227    --  Start of processing for Set_Command_Line
1228
1229    begin
1230       Free (Cmd.Expanded);
1231       Free (Cmd.Params);
1232
1233       if Switches /= "" then
1234          Tmp := Argument_String_To_List (Switches);
1235          Initialize_Option_Scan (Parser, Tmp, Switch_Char);
1236
1237          loop
1238             begin
1239                S := Getopt (Switches    => "* " & Getopt_Description,
1240                             Concatenate => False,
1241                             Parser      => Parser);
1242                exit when S = ASCII.NUL;
1243
1244                declare
1245                   Sw         : constant String :=
1246                                  Real_Full_Switch (S, Parser);
1247                   Is_Section : Boolean := False;
1248
1249                begin
1250                   if Cmd.Config /= null
1251                     and then Cmd.Config.Sections /= null
1252                   then
1253                      Section_Search :
1254                      for S in Cmd.Config.Sections'Range loop
1255                         if Sw = Cmd.Config.Sections (S).all then
1256                            Section := Cmd.Config.Sections (S);
1257                            Is_Section := True;
1258
1259                            exit Section_Search;
1260                         end if;
1261                      end loop Section_Search;
1262                   end if;
1263
1264                   if not Is_Section then
1265                      if Section = null then
1266
1267                         --  Work around some weird cases: some switches may
1268                         --  expect parameters, but have the same value as
1269                         --  longer switches: -gnaty3 (-gnaty, parameter=3) and
1270                         --  -gnatya (-gnatya, no parameter).
1271
1272                         --  So we are calling add_switch here with parameter
1273                         --  attached. This will be anyway correctly handled by
1274                         --  Add_Switch if -gnaty3 is actually provided.
1275
1276                         if Separator (Parser) = ASCII.NUL then
1277                            Add_Switch
1278                              (Cmd, Sw & Parameter (Parser), "");
1279                         else
1280                            Add_Switch
1281                              (Cmd, Sw, Parameter (Parser), Separator (Parser));
1282                         end if;
1283                      else
1284                         if Separator (Parser) = ASCII.NUL then
1285                            Add_Switch
1286                              (Cmd, Sw & Parameter (Parser), "",
1287                               Separator (Parser),
1288                               Section.all);
1289                         else
1290                            Add_Switch
1291                              (Cmd, Sw,
1292                               Parameter (Parser),
1293                               Separator (Parser),
1294                               Section.all);
1295                         end if;
1296                      end if;
1297                   end if;
1298                end;
1299
1300             exception
1301                when Invalid_Parameter =>
1302
1303                   --  Add it with no parameter, if that's the way the user
1304                   --  wants it.
1305
1306                   --  Specify the separator in all cases, as the switch might
1307                   --  need to be unaliased, and the alias might contain
1308                   --  switches with parameters.
1309
1310                   if Section = null then
1311                      Add_Switch
1312                        (Cmd, Switch_Char & Full_Switch (Parser),
1313                         Separator => Separator (Parser));
1314                   else
1315                      Add_Switch
1316                        (Cmd, Switch_Char & Full_Switch (Parser),
1317                         Separator => Separator (Parser),
1318                         Section   => Section.all);
1319                   end if;
1320             end;
1321          end loop;
1322
1323          Free (Parser);
1324       end if;
1325    end Set_Command_Line;
1326
1327    ----------------
1328    -- Looking_At --
1329    ----------------
1330
1331    function Looking_At
1332      (Type_Str  : String;
1333       Index     : Natural;
1334       Substring : String) return Boolean is
1335    begin
1336       return Index + Substring'Length - 1 <= Type_Str'Last
1337         and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
1338    end Looking_At;
1339
1340    ------------------------
1341    -- Can_Have_Parameter --
1342    ------------------------
1343
1344    function Can_Have_Parameter (S : String) return Boolean is
1345    begin
1346       if S'Length <= 1 then
1347          return False;
1348       end if;
1349
1350       case S (S'Last) is
1351          when '!' | ':' | '?' | '=' =>
1352             return True;
1353          when others =>
1354             return False;
1355       end case;
1356    end Can_Have_Parameter;
1357
1358    -----------------------
1359    -- Require_Parameter --
1360    -----------------------
1361
1362    function Require_Parameter (S : String) return Boolean is
1363    begin
1364       if S'Length <= 1 then
1365          return False;
1366       end if;
1367
1368       case S (S'Last) is
1369          when '!' | ':' | '=' =>
1370             return True;
1371          when others =>
1372             return False;
1373       end case;
1374    end Require_Parameter;
1375
1376    -------------------
1377    -- Actual_Switch --
1378    -------------------
1379
1380    function Actual_Switch (S : String) return String is
1381    begin
1382       if S'Length <= 1 then
1383          return S;
1384       end if;
1385
1386       case S (S'Last) is
1387          when '!' | ':' | '?' | '=' =>
1388             return S (S'First .. S'Last - 1);
1389          when others =>
1390             return S;
1391       end case;
1392    end Actual_Switch;
1393
1394    ----------------------------
1395    -- For_Each_Simple_Switch --
1396    ----------------------------
1397
1398    procedure For_Each_Simple_Switch
1399      (Cmd       : Command_Line;
1400       Switch    : String;
1401       Parameter : String := "";
1402       Unalias   : Boolean := True)
1403    is
1404       function Group_Analysis
1405         (Prefix : String;
1406          Group  : String) return Boolean;
1407       --  Perform the analysis of a group of switches.
1408
1409       --------------------
1410       -- Group_Analysis --
1411       --------------------
1412
1413       function Group_Analysis
1414         (Prefix : String;
1415          Group  : String) return Boolean
1416       is
1417          Idx   : Natural;
1418          Found : Boolean;
1419
1420       begin
1421          Idx := Group'First;
1422          while Idx <= Group'Last loop
1423             Found := False;
1424
1425             for S in Cmd.Config.Switches'Range loop
1426                declare
1427                   Sw              : constant String :=
1428                                       Actual_Switch
1429                                         (Cmd.Config.Switches (S).all);
1430                   Full            : constant String :=
1431                                       Prefix & Group (Idx .. Group'Last);
1432                   Last            : Natural;
1433                   Param           : Natural;
1434
1435                begin
1436                   if Sw'Length >= Prefix'Length
1437
1438                      --  Verify that sw starts with Prefix
1439
1440                      and then Looking_At (Sw, Sw'First, Prefix)
1441
1442                      --  Verify that the group starts with sw
1443
1444                      and then Looking_At (Full, Full'First, Sw)
1445                   then
1446                      Last := Idx + Sw'Length - Prefix'Length - 1;
1447                      Param := Last + 1;
1448
1449                      if Can_Have_Parameter (Cmd.Config.Switches (S).all) then
1450
1451                         --  Include potential parameter to the recursive call.
1452                         --  Only numbers are allowed.
1453
1454                         while Last < Group'Last
1455                           and then Group (Last + 1) in '0' .. '9'
1456                         loop
1457                            Last := Last + 1;
1458                         end loop;
1459                      end if;
1460
1461                      if not Require_Parameter (Cmd.Config.Switches (S).all)
1462                        or else Last >= Param
1463                      then
1464                         if Idx = Group'First
1465                           and then Last = Group'Last
1466                           and then Last < Param
1467                         then
1468                            --  The group only concerns a single switch. Do not
1469                            --  perform recursive call.
1470
1471                            --  Note that we still perform a recursive call if
1472                            --  a parameter is detected in the switch, as this
1473                            --  is a way to correctly identify such a parameter
1474                            --  in aliases.
1475
1476                            return False;
1477                         end if;
1478
1479                         Found := True;
1480
1481                         --  Recursive call, using the detected parameter if any
1482
1483                         if Last >= Param then
1484                            For_Each_Simple_Switch
1485                              (Cmd,
1486                               Prefix & Group (Idx .. Param - 1),
1487                               Group (Param .. Last));
1488                         else
1489                            For_Each_Simple_Switch
1490                              (Cmd, Prefix & Group (Idx .. Last), "");
1491                         end if;
1492
1493                         Idx := Last + 1;
1494                         exit;
1495                      end if;
1496                   end if;
1497                end;
1498             end loop;
1499
1500             if not Found then
1501                For_Each_Simple_Switch (Cmd, Prefix & Group (Idx), "");
1502                Idx := Idx + 1;
1503             end if;
1504          end loop;
1505
1506          return True;
1507       end Group_Analysis;
1508
1509    begin
1510       --  Are we adding a switch that can in fact be expanded through aliases ?
1511       --  If yes, we add separately each of its expansion.
1512
1513       --  This takes care of expansions like "-T" -> "-gnatwrs", where the
1514       --  alias and its expansion do not have the same prefix. Given the order
1515       --  in which we do things here, the expansion of the alias will itself
1516       --  be checked for a common prefix and further split into simple switches
1517
1518       if Unalias
1519         and then Cmd.Config /= null
1520         and then Cmd.Config.Aliases /= null
1521       then
1522          for A in Cmd.Config.Aliases'Range loop
1523             if Cmd.Config.Aliases (A).all = Switch
1524               and then Parameter = ""
1525             then
1526                For_Each_Simple_Switch
1527                  (Cmd, Cmd.Config.Expansions (A).all, "");
1528                return;
1529             end if;
1530          end loop;
1531       end if;
1532
1533       --  Are we adding a switch grouping several switches ? If yes, add each
1534       --  of the simple switches instead.
1535
1536       if Cmd.Config /= null
1537         and then Cmd.Config.Prefixes /= null
1538       then
1539          for P in Cmd.Config.Prefixes'Range loop
1540             if Switch'Length > Cmd.Config.Prefixes (P)'Length + 1
1541               and then Looking_At
1542                 (Switch, Switch'First, Cmd.Config.Prefixes (P).all)
1543             then
1544                --  Alias expansion will be done recursively
1545                if Cmd.Config.Switches = null then
1546                   for S in Switch'First + Cmd.Config.Prefixes (P)'Length
1547                             .. Switch'Last
1548                   loop
1549                      For_Each_Simple_Switch
1550                        (Cmd, Cmd.Config.Prefixes (P).all & Switch (S), "");
1551                   end loop;
1552
1553                   return;
1554
1555                elsif Group_Analysis
1556                  (Cmd.Config.Prefixes (P).all,
1557                   Switch
1558                     (Switch'First + Cmd.Config.Prefixes (P)'Length
1559                       .. Switch'Last))
1560                then
1561                   --  Recursive calls already done on each switch of the
1562                   --  group. Let's return to not call Callback.
1563                   return;
1564                end if;
1565             end if;
1566          end loop;
1567       end if;
1568
1569       --  Test if added switch is a known switch with parameter attached
1570
1571       if Parameter = ""
1572         and then Cmd.Config /= null
1573         and then Cmd.Config.Switches /= null
1574       then
1575          for S in Cmd.Config.Switches'Range loop
1576             declare
1577                Sw    : constant String :=
1578                          Actual_Switch (Cmd.Config.Switches (S).all);
1579                Last  : Natural;
1580                Param : Natural;
1581
1582             begin
1583                --  Verify that switch starts with Sw
1584                --  What if the "verification" fails???
1585
1586                if Switch'Length >= Sw'Length
1587                  and then Looking_At (Switch, Switch'First, Sw)
1588                then
1589                   Param := Switch'First + Sw'Length - 1;
1590                   Last := Param;
1591
1592                   if Can_Have_Parameter (Cmd.Config.Switches (S).all) then
1593                      while Last < Switch'Last
1594                        and then Switch (Last + 1) in '0' .. '9'
1595                      loop
1596                         Last := Last + 1;
1597                      end loop;
1598                   end if;
1599
1600                   --  If full Switch is a known switch with attached parameter
1601                   --  then we use this parameter in the callback.
1602
1603                   if Last = Switch'Last then
1604                      Callback
1605                        (Switch (Switch'First .. Param),
1606                         Switch (Param + 1 .. Last));
1607                      return;
1608
1609                   end if;
1610                end if;
1611             end;
1612          end loop;
1613       end if;
1614
1615       Callback (Switch, Parameter);
1616    end For_Each_Simple_Switch;
1617
1618    ----------------
1619    -- Add_Switch --
1620    ----------------
1621
1622    procedure Add_Switch
1623      (Cmd        : in out Command_Line;
1624       Switch     : String;
1625       Parameter  : String    := "";
1626       Separator  : Character := ' ';
1627       Section    : String    := "";
1628       Add_Before : Boolean   := False)
1629    is
1630       Success : Boolean;
1631       pragma Unreferenced (Success);
1632    begin
1633       Add_Switch
1634         (Cmd, Switch, Parameter, Separator, Section, Add_Before, Success);
1635    end Add_Switch;
1636
1637    ----------------
1638    -- Add_Switch --
1639    ----------------
1640
1641    procedure Add_Switch
1642      (Cmd        : in out Command_Line;
1643       Switch     : String;
1644       Parameter  : String := "";
1645       Separator  : Character := ' ';
1646       Section    : String := "";
1647       Add_Before : Boolean := False;
1648       Success    : out Boolean)
1649    is
1650       procedure Add_Simple_Switch (Simple : String; Param : String);
1651       --  Add a new switch that has had all its aliases expanded, and switches
1652       --  ungrouped. We know there are no more aliases in Switches.
1653
1654       -----------------------
1655       -- Add_Simple_Switch --
1656       -----------------------
1657
1658       procedure Add_Simple_Switch (Simple : String; Param : String) is
1659       begin
1660          if Cmd.Expanded = null then
1661             Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
1662
1663             if Param /= "" then
1664                Cmd.Params := new Argument_List'
1665                  (1 .. 1 => new String'(Separator & Param));
1666
1667             else
1668                Cmd.Params := new Argument_List'(1 .. 1 => null);
1669             end if;
1670
1671             if Section = "" then
1672                Cmd.Sections := new Argument_List'(1 .. 1 => null);
1673
1674             else
1675                Cmd.Sections := new Argument_List'
1676                  (1 .. 1 => new String'(Section));
1677             end if;
1678
1679          else
1680             --  Do we already have this switch?
1681
1682             for C in Cmd.Expanded'Range loop
1683                if Cmd.Expanded (C).all = Simple
1684                  and then
1685                    ((Cmd.Params (C) = null and then Param = "")
1686                      or else
1687                        (Cmd.Params (C) /= null
1688                          and then Cmd.Params (C).all = Separator & Param))
1689                  and then
1690                    ((Cmd.Sections (C) = null and then Section = "")
1691                      or else
1692                        (Cmd.Sections (C) /= null
1693                          and then Cmd.Sections (C).all = Section))
1694                then
1695                   return;
1696                end if;
1697             end loop;
1698
1699             --  Inserting at least one switch
1700
1701             Success := True;
1702             Add (Cmd.Expanded, new String'(Simple), Add_Before);
1703
1704             if Param /= "" then
1705                Add
1706                  (Cmd.Params,
1707                   new String'(Separator & Param),
1708                   Add_Before);
1709
1710             else
1711                Add
1712                  (Cmd.Params,
1713                   null,
1714                   Add_Before);
1715             end if;
1716
1717             if Section = "" then
1718                Add
1719                  (Cmd.Sections,
1720                   null,
1721                   Add_Before);
1722             else
1723                Add
1724                  (Cmd.Sections,
1725                   new String'(Section),
1726                   Add_Before);
1727             end if;
1728          end if;
1729       end Add_Simple_Switch;
1730
1731       procedure Add_Simple_Switches is
1732          new For_Each_Simple_Switch (Add_Simple_Switch);
1733
1734    --  Start of processing for Add_Switch
1735
1736    begin
1737       Success := False;
1738       Add_Simple_Switches (Cmd, Switch, Parameter);
1739       Free (Cmd.Coalesce);
1740    end Add_Switch;
1741
1742    ------------
1743    -- Remove --
1744    ------------
1745
1746    procedure Remove (Line : in out Argument_List_Access; Index : Integer) is
1747       Tmp : Argument_List_Access := Line;
1748
1749    begin
1750       Line := new Argument_List (Tmp'First .. Tmp'Last - 1);
1751
1752       if Index /= Tmp'First then
1753          Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1);
1754       end if;
1755
1756       Free (Tmp (Index));
1757
1758       if Index /= Tmp'Last then
1759          Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last);
1760       end if;
1761
1762       Unchecked_Free (Tmp);
1763    end Remove;
1764
1765    ---------
1766    -- Add --
1767    ---------
1768
1769    procedure Add
1770      (Line   : in out Argument_List_Access;
1771       Str    : String_Access;
1772       Before : Boolean := False)
1773    is
1774       Tmp : Argument_List_Access := Line;
1775
1776    begin
1777       if Tmp /= null then
1778          Line := new Argument_List (Tmp'First .. Tmp'Last + 1);
1779
1780          if Before then
1781             Line (Tmp'First)                     := Str;
1782             Line (Tmp'First + 1 .. Tmp'Last + 1) := Tmp.all;
1783          else
1784             Line (Tmp'Range)    := Tmp.all;
1785             Line (Tmp'Last + 1) := Str;
1786          end if;
1787
1788          Unchecked_Free (Tmp);
1789
1790       else
1791          Line := new Argument_List'(1 .. 1 => Str);
1792       end if;
1793    end Add;
1794
1795    -------------------
1796    -- Remove_Switch --
1797    -------------------
1798
1799    procedure Remove_Switch
1800      (Cmd           : in out Command_Line;
1801       Switch        : String;
1802       Remove_All    : Boolean := False;
1803       Has_Parameter : Boolean := False;
1804       Section       : String := "")
1805    is
1806       Success : Boolean;
1807       pragma Unreferenced (Success);
1808    begin
1809       Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success);
1810    end Remove_Switch;
1811
1812    -------------------
1813    -- Remove_Switch --
1814    -------------------
1815
1816    procedure Remove_Switch
1817      (Cmd           : in out Command_Line;
1818       Switch        : String;
1819       Remove_All    : Boolean := False;
1820       Has_Parameter : Boolean := False;
1821       Section       : String  := "";
1822       Success       : out Boolean)
1823    is
1824       procedure Remove_Simple_Switch (Simple : String; Param : String);
1825       --  Removes a simple switch, with no aliasing or grouping
1826
1827       --------------------------
1828       -- Remove_Simple_Switch --
1829       --------------------------
1830
1831       procedure Remove_Simple_Switch (Simple : String; Param : String) is
1832          C : Integer;
1833          pragma Unreferenced (Param);
1834
1835       begin
1836          if Cmd.Expanded /= null then
1837             C := Cmd.Expanded'First;
1838             while C <= Cmd.Expanded'Last loop
1839                if Cmd.Expanded (C).all = Simple
1840                  and then
1841                    (Remove_All
1842                      or else (Cmd.Sections (C) = null
1843                                and then Section = "")
1844                      or else (Cmd.Sections (C) /= null
1845                                and then Section = Cmd.Sections (C).all))
1846                  and then (not Has_Parameter or else Cmd.Params (C) /= null)
1847                then
1848                   Remove (Cmd.Expanded, C);
1849                   Remove (Cmd.Params, C);
1850                   Remove (Cmd.Sections, C);
1851                   Success := True;
1852
1853                   if not Remove_All then
1854                      return;
1855                   end if;
1856
1857                else
1858                   C := C + 1;
1859                end if;
1860             end loop;
1861          end if;
1862       end Remove_Simple_Switch;
1863
1864       procedure Remove_Simple_Switches is
1865         new For_Each_Simple_Switch (Remove_Simple_Switch);
1866
1867    --  Start of processing for Remove_Switch
1868
1869    begin
1870       Success := False;
1871       Remove_Simple_Switches (Cmd, Switch, "", Unalias => not Has_Parameter);
1872       Free (Cmd.Coalesce);
1873    end Remove_Switch;
1874
1875    -------------------
1876    -- Remove_Switch --
1877    -------------------
1878
1879    procedure Remove_Switch
1880      (Cmd       : in out Command_Line;
1881       Switch    : String;
1882       Parameter : String;
1883       Section   : String  := "")
1884    is
1885       procedure Remove_Simple_Switch (Simple : String; Param : String);
1886       --  Removes a simple switch, with no aliasing or grouping
1887
1888       --------------------------
1889       -- Remove_Simple_Switch --
1890       --------------------------
1891
1892       procedure Remove_Simple_Switch (Simple : String; Param : String) is
1893          C : Integer;
1894
1895       begin
1896          if Cmd.Expanded /= null then
1897             C := Cmd.Expanded'First;
1898             while C <= Cmd.Expanded'Last loop
1899                if Cmd.Expanded (C).all = Simple
1900                  and then
1901                    ((Cmd.Sections (C) = null
1902                       and then Section = "")
1903                     or else
1904                       (Cmd.Sections (C) /= null
1905                         and then Section = Cmd.Sections (C).all))
1906                  and then
1907                    ((Cmd.Params (C) = null and then Param = "")
1908                       or else
1909                         (Cmd.Params (C) /= null
1910                            and then
1911
1912                            --  Ignore the separator stored in Parameter
1913
1914                              Cmd.Params (C) (Cmd.Params (C)'First + 1
1915                                              .. Cmd.Params (C)'Last) =
1916                            Param))
1917                then
1918                   Remove (Cmd.Expanded, C);
1919                   Remove (Cmd.Params, C);
1920                   Remove (Cmd.Sections, C);
1921
1922                   --  The switch is necessarily unique by construction of
1923                   --  Add_Switch.
1924
1925                   return;
1926
1927                else
1928                   C := C + 1;
1929                end if;
1930             end loop;
1931          end if;
1932       end Remove_Simple_Switch;
1933
1934       procedure Remove_Simple_Switches is
1935          new For_Each_Simple_Switch (Remove_Simple_Switch);
1936
1937    --  Start of processing for Remove_Switch
1938
1939    begin
1940       Remove_Simple_Switches (Cmd, Switch, Parameter);
1941       Free (Cmd.Coalesce);
1942    end Remove_Switch;
1943
1944    --------------------
1945    -- Group_Switches --
1946    --------------------
1947
1948    procedure Group_Switches
1949      (Cmd      : Command_Line;
1950       Result   : Argument_List_Access;
1951       Sections : Argument_List_Access;
1952       Params   : Argument_List_Access)
1953    is
1954       function Compatible_Parameter (Param : String_Access) return Boolean;
1955       --  True when the parameter can be part of a group
1956
1957       --------------------------
1958       -- Compatible_Parameter --
1959       --------------------------
1960
1961       function Compatible_Parameter (Param : String_Access) return Boolean is
1962       begin
1963          --  No parameter OK
1964
1965          if Param = null then
1966             return True;
1967
1968          --  We need parameters without separators
1969
1970          elsif Param (Param'First) /= ASCII.NUL then
1971             return False;
1972
1973          --  Parameters must be all digits
1974
1975          else
1976             for J in Param'First + 1 .. Param'Last loop
1977                if Param (J) not in '0' .. '9' then
1978                   return False;
1979                end if;
1980             end loop;
1981
1982             return True;
1983          end if;
1984       end Compatible_Parameter;
1985
1986       --  Local declarations
1987
1988       Group : Ada.Strings.Unbounded.Unbounded_String;
1989       First : Natural;
1990       use type Ada.Strings.Unbounded.Unbounded_String;
1991
1992    --  Start of processing for Group_Switches
1993
1994    begin
1995       if Cmd.Config = null
1996         or else Cmd.Config.Prefixes = null
1997       then
1998          return;
1999       end if;
2000
2001       for P in Cmd.Config.Prefixes'Range loop
2002          Group   := Ada.Strings.Unbounded.Null_Unbounded_String;
2003          First   := 0;
2004
2005          for C in Result'Range loop
2006             if Result (C) /= null
2007               and then Compatible_Parameter (Params (C))
2008               and then Looking_At
2009                 (Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all)
2010             then
2011                --  If we are still in the same section, group the switches
2012
2013                if First = 0
2014                  or else
2015                    (Sections (C) = null
2016                      and then Sections (First) = null)
2017                  or else
2018                    (Sections (C) /= null
2019                      and then Sections (First) /= null
2020                      and then Sections (C).all = Sections (First).all)
2021                then
2022                   Group :=
2023                     Group &
2024                       Result (C)
2025                         (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2026                          Result (C)'Last);
2027
2028                   if Params (C) /= null then
2029                      Group :=
2030                        Group &
2031                          Params (C) (Params (C)'First + 1 .. Params (C)'Last);
2032                      Free (Params (C));
2033                   end if;
2034
2035                   if First = 0 then
2036                      First := C;
2037                   end if;
2038
2039                   Free (Result (C));
2040
2041                else
2042                   --  We changed section: we put the grouped switches to the
2043                   --  first place, on continue with the new section.
2044
2045                   Result (First) :=
2046                     new String'
2047                       (Cmd.Config.Prefixes (P).all &
2048                        Ada.Strings.Unbounded.To_String (Group));
2049                   Group :=
2050                     Ada.Strings.Unbounded.To_Unbounded_String
2051                       (Result (C)
2052                        (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2053                             Result (C)'Last));
2054                   First := C;
2055                end if;
2056             end if;
2057          end loop;
2058
2059          if First > 0 then
2060             Result (First) :=
2061               new String'
2062                 (Cmd.Config.Prefixes (P).all &
2063                  Ada.Strings.Unbounded.To_String (Group));
2064          end if;
2065       end loop;
2066    end Group_Switches;
2067
2068    --------------------
2069    -- Alias_Switches --
2070    --------------------
2071
2072    procedure Alias_Switches
2073      (Cmd    : Command_Line;
2074       Result : Argument_List_Access;
2075       Params : Argument_List_Access)
2076    is
2077       Found : Boolean;
2078       First : Natural;
2079
2080       procedure Check_Cb (Switch : String; Param : String);
2081       --  Comment required ???
2082
2083       procedure Remove_Cb (Switch : String; Param : String);
2084       --  Comment required ???
2085
2086       --------------
2087       -- Check_Cb --
2088       --------------
2089
2090       procedure Check_Cb (Switch : String; Param : String) is
2091       begin
2092          if Found then
2093             for E in Result'Range loop
2094                if Result (E) /= null
2095                  and then
2096                    (Params (E) = null
2097                     or else Params (E) (Params (E)'First + 1
2098                                             .. Params (E)'Last) = Param)
2099                  and then Result (E).all = Switch
2100                then
2101                   return;
2102                end if;
2103             end loop;
2104
2105             Found := False;
2106          end if;
2107       end Check_Cb;
2108
2109       ---------------
2110       -- Remove_Cb --
2111       ---------------
2112
2113       procedure Remove_Cb (Switch : String; Param : String) is
2114       begin
2115          for E in Result'Range loop
2116             if Result (E) /= null
2117                  and then
2118                    (Params (E) = null
2119                     or else Params (E) (Params (E)'First + 1
2120                                             .. Params (E)'Last) = Param)
2121               and then Result (E).all = Switch
2122             then
2123                if First > E then
2124                   First := E;
2125                end if;
2126                Free (Result (E));
2127                Free (Params (E));
2128                return;
2129             end if;
2130          end loop;
2131       end Remove_Cb;
2132
2133       procedure Check_All is new For_Each_Simple_Switch (Check_Cb);
2134       procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb);
2135
2136    --  Start of processing for Alias_Switches
2137
2138    begin
2139       if Cmd.Config = null
2140         or else Cmd.Config.Aliases = null
2141       then
2142          return;
2143       end if;
2144
2145       for A in Cmd.Config.Aliases'Range loop
2146
2147          --  Compute the various simple switches that make up the alias. We
2148          --  split the expansion into as many simple switches as possible, and
2149          --  then check whether the expanded command line has all of them.
2150
2151          Found := True;
2152          Check_All (Cmd, Cmd.Config.Expansions (A).all);
2153
2154          if Found then
2155             First := Integer'Last;
2156             Remove_All (Cmd, Cmd.Config.Expansions (A).all);
2157             Result (First) := new String'(Cmd.Config.Aliases (A).all);
2158          end if;
2159       end loop;
2160    end Alias_Switches;
2161
2162    -------------------
2163    -- Sort_Sections --
2164    -------------------
2165
2166    procedure Sort_Sections
2167      (Line     : GNAT.OS_Lib.Argument_List_Access;
2168       Sections : GNAT.OS_Lib.Argument_List_Access;
2169       Params   : GNAT.OS_Lib.Argument_List_Access)
2170    is
2171       Sections_List : Argument_List_Access :=
2172                         new Argument_List'(1 .. 1 => null);
2173       Found         : Boolean;
2174       Old_Line      : constant Argument_List := Line.all;
2175       Old_Sections  : constant Argument_List := Sections.all;
2176       Old_Params    : constant Argument_List := Params.all;
2177       Index         : Natural;
2178
2179    begin
2180       if Line = null then
2181          return;
2182       end if;
2183
2184       --  First construct a list of all sections
2185
2186       for E in Line'Range loop
2187          if Sections (E) /= null then
2188             Found := False;
2189             for S in Sections_List'Range loop
2190                if (Sections_List (S) = null and then Sections (E) = null)
2191                  or else
2192                    (Sections_List (S) /= null
2193                      and then Sections (E) /= null
2194                      and then Sections_List (S).all = Sections (E).all)
2195                then
2196                   Found := True;
2197                   exit;
2198                end if;
2199             end loop;
2200
2201             if not Found then
2202                Add (Sections_List, Sections (E));
2203             end if;
2204          end if;
2205       end loop;
2206
2207       Index := Line'First;
2208
2209       for S in Sections_List'Range loop
2210          for E in Old_Line'Range loop
2211             if (Sections_List (S) = null and then Old_Sections (E) = null)
2212               or else
2213                 (Sections_List (S) /= null
2214                   and then Old_Sections (E) /= null
2215                   and then Sections_List (S).all = Old_Sections (E).all)
2216             then
2217                Line (Index) := Old_Line (E);
2218                Sections (Index) := Old_Sections (E);
2219                Params (Index) := Old_Params (E);
2220                Index := Index + 1;
2221             end if;
2222          end loop;
2223       end loop;
2224    end Sort_Sections;
2225
2226    -----------
2227    -- Start --
2228    -----------
2229
2230    procedure Start
2231      (Cmd      : in out Command_Line;
2232       Iter     : in out Command_Line_Iterator;
2233       Expanded : Boolean)
2234    is
2235    begin
2236       if Cmd.Expanded = null then
2237          Iter.List := null;
2238          return;
2239       end if;
2240
2241       --  Reorder the expanded line so that sections are grouped
2242
2243       Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params);
2244
2245       --  Coalesce the switches as much as possible
2246
2247       if not Expanded
2248         and then Cmd.Coalesce = null
2249       then
2250          Cmd.Coalesce := new Argument_List (Cmd.Expanded'Range);
2251          for E in Cmd.Expanded'Range loop
2252             Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all);
2253          end loop;
2254
2255          Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
2256          for E in Cmd.Sections'Range loop
2257             if Cmd.Sections (E) = null then
2258                Cmd.Coalesce_Sections (E) := null;
2259             else
2260                Cmd.Coalesce_Sections (E) := new String'(Cmd.Sections (E).all);
2261             end if;
2262          end loop;
2263
2264          Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range);
2265          for E in Cmd.Params'Range loop
2266             if Cmd.Params (E) = null then
2267                Cmd.Coalesce_Params (E) := null;
2268             else
2269                Cmd.Coalesce_Params (E) := new String'(Cmd.Params (E).all);
2270             end if;
2271          end loop;
2272
2273          --  Not a clone, since we will not modify the parameters anyway
2274
2275          Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params);
2276          Group_Switches
2277            (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params);
2278       end if;
2279
2280       if Expanded then
2281          Iter.List     := Cmd.Expanded;
2282          Iter.Params   := Cmd.Params;
2283          Iter.Sections := Cmd.Sections;
2284       else
2285          Iter.List     := Cmd.Coalesce;
2286          Iter.Params   := Cmd.Coalesce_Params;
2287          Iter.Sections := Cmd.Coalesce_Sections;
2288       end if;
2289
2290       if Iter.List = null then
2291          Iter.Current := Integer'Last;
2292       else
2293          Iter.Current := Iter.List'First;
2294
2295          while Iter.Current <= Iter.List'Last
2296            and then Iter.List (Iter.Current) = null
2297          loop
2298             Iter.Current := Iter.Current + 1;
2299          end loop;
2300       end if;
2301    end Start;
2302
2303    --------------------
2304    -- Current_Switch --
2305    --------------------
2306
2307    function Current_Switch (Iter : Command_Line_Iterator) return String is
2308    begin
2309       return Iter.List (Iter.Current).all;
2310    end Current_Switch;
2311
2312    --------------------
2313    -- Is_New_Section --
2314    --------------------
2315
2316    function Is_New_Section    (Iter : Command_Line_Iterator) return Boolean is
2317       Section : constant String := Current_Section (Iter);
2318    begin
2319       if Iter.Sections = null then
2320          return False;
2321       elsif Iter.Current = Iter.Sections'First
2322         or else Iter.Sections (Iter.Current - 1) = null
2323       then
2324          return Section /= "";
2325       end if;
2326
2327       return Section /= Iter.Sections (Iter.Current - 1).all;
2328    end Is_New_Section;
2329
2330    ---------------------
2331    -- Current_Section --
2332    ---------------------
2333
2334    function Current_Section (Iter : Command_Line_Iterator) return String is
2335    begin
2336       if Iter.Sections = null
2337         or else Iter.Current > Iter.Sections'Last
2338         or else Iter.Sections (Iter.Current) = null
2339       then
2340          return "";
2341       end if;
2342
2343       return Iter.Sections (Iter.Current).all;
2344    end Current_Section;
2345
2346    -----------------------
2347    -- Current_Separator --
2348    -----------------------
2349
2350    function Current_Separator (Iter : Command_Line_Iterator) return String is
2351    begin
2352       if Iter.Params = null
2353         or else Iter.Current > Iter.Params'Last
2354         or else Iter.Params (Iter.Current) = null
2355       then
2356          return "";
2357
2358       else
2359          declare
2360             Sep : constant Character :=
2361               Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First);
2362          begin
2363             if Sep = ASCII.NUL then
2364                return "";
2365             else
2366                return "" & Sep;
2367             end if;
2368          end;
2369       end if;
2370    end Current_Separator;
2371
2372    -----------------------
2373    -- Current_Parameter --
2374    -----------------------
2375
2376    function Current_Parameter (Iter : Command_Line_Iterator) return String is
2377    begin
2378       if Iter.Params = null
2379         or else Iter.Current > Iter.Params'Last
2380         or else Iter.Params (Iter.Current) = null
2381       then
2382          return "";
2383
2384       else
2385          declare
2386             P : constant String := Iter.Params (Iter.Current).all;
2387
2388          begin
2389             --  Skip separator
2390
2391             return P (P'First + 1 .. P'Last);
2392          end;
2393       end if;
2394    end Current_Parameter;
2395
2396    --------------
2397    -- Has_More --
2398    --------------
2399
2400    function Has_More (Iter : Command_Line_Iterator) return Boolean is
2401    begin
2402       return Iter.List /= null and then Iter.Current <= Iter.List'Last;
2403    end Has_More;
2404
2405    ----------
2406    -- Next --
2407    ----------
2408
2409    procedure Next (Iter : in out Command_Line_Iterator) is
2410    begin
2411       Iter.Current := Iter.Current + 1;
2412       while Iter.Current <= Iter.List'Last
2413         and then Iter.List (Iter.Current) = null
2414       loop
2415          Iter.Current := Iter.Current + 1;
2416       end loop;
2417    end Next;
2418
2419    ----------
2420    -- Free --
2421    ----------
2422
2423    procedure Free (Config : in out Command_Line_Configuration) is
2424    begin
2425       if Config /= null then
2426          Free (Config.Aliases);
2427          Free (Config.Expansions);
2428          Free (Config.Prefixes);
2429          Unchecked_Free (Config);
2430       end if;
2431    end Free;
2432
2433    ----------
2434    -- Free --
2435    ----------
2436
2437    procedure Free (Cmd : in out Command_Line) is
2438    begin
2439       Free (Cmd.Expanded);
2440       Free (Cmd.Coalesce);
2441       Free (Cmd.Params);
2442    end Free;
2443
2444 end GNAT.Command_Line;