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-2014, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Ada.Characters.Handling;    use Ada.Characters.Handling;
  33 with Ada.Strings.Unbounded;
  34 with Ada.Text_IO;                use Ada.Text_IO;
  35 with Ada.Unchecked_Deallocation;
  36
  37 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  38 with GNAT.OS_Lib;               use GNAT.OS_Lib;
  39
  40 package body GNAT.Command_Line is
  41
  42    --  General note: this entire body could use much more commenting. There
  43    --  are large sections of uncommented code throughout, and many formal
  44    --  parameters of local subprograms are not documented at all ???
  45
  46    package CL renames Ada.Command_Line;
  47
  48    type Switch_Parameter_Type is
  49      (Parameter_None,
  50       Parameter_With_Optional_Space,  --  ':' in getopt
  51       Parameter_With_Space_Or_Equal,  --  '=' in getopt
  52       Parameter_No_Space,             --  '!' in getopt
  53       Parameter_Optional);            --  '?' in getopt
  54
  55    procedure Set_Parameter
  56      (Variable : out Parameter_Type;
  57       Arg_Num  : Positive;
  58       First    : Positive;
  59       Last     : Positive;
  60       Extra    : Character := ASCII.NUL);
  61    pragma Inline (Set_Parameter);
  62    --  Set the parameter that will be returned by Parameter below
  63    --
  64    --  Extra is a character that needs to be added when reporting Full_Switch.
  65    --  (it will in general be the switch character, for instance '-').
  66    --  Otherwise, Full_Switch will report 'f' instead of '-f'. In particular,
  67    --  it needs to be set when reporting an invalid switch or handling '*'.
  68    --
  69    --  Parameters need to be defined ???
  70
  71    function Goto_Next_Argument_In_Section (Parser : Opt_Parser) return Boolean;
  72    --  Go to the next argument on the command line. If we are at the end of
  73    --  the current section, we want to make sure there is no other identical
  74    --  section on the command line (there might be multiple instances of
  75    --  -largs). Returns True iff there is another argument.
  76
  77    function Get_File_Names_Case_Sensitive return Integer;
  78    pragma Import (C, Get_File_Names_Case_Sensitive,
  79                   "__gnat_get_file_names_case_sensitive");
  80
  81    File_Names_Case_Sensitive : constant Boolean :=
  82                                  Get_File_Names_Case_Sensitive /= 0;
  83
  84    procedure Canonical_Case_File_Name (S : in out String);
  85    --  Given a file name, converts it to canonical case form. For systems where
  86    --  file names are case sensitive, this procedure has no effect. If file
  87    --  names are not case sensitive (i.e. for example if you have the file
  88    --  "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then this call
  89    --  converts the given string to canonical all lower case form, so that two
  90    --  file names compare equal if they refer to the same file.
  91
  92    procedure Internal_Initialize_Option_Scan
  93      (Parser                   : Opt_Parser;
  94       Switch_Char              : Character;
  95       Stop_At_First_Non_Switch : Boolean;
  96       Section_Delimiters       : String);
  97    --  Initialize Parser, which must have been allocated already
  98
  99    function Argument (Parser : Opt_Parser; Index : Integer) return String;
 100    --  Return the index-th command line argument
 101
 102    procedure Find_Longest_Matching_Switch
 103      (Switches          : String;
 104       Arg               : String;
 105       Index_In_Switches : out Integer;
 106       Switch_Length     : out Integer;
 107       Param             : out Switch_Parameter_Type);
 108    --  Return the Longest switch from Switches that at least partially matches
 109    --  Arg. Index_In_Switches is set to 0 if none matches. What are other
 110    --  parameters??? in particular Param is not always set???
 111
 112    procedure Unchecked_Free is new Ada.Unchecked_Deallocation
 113      (Argument_List, Argument_List_Access);
 114
 115    procedure Unchecked_Free is new Ada.Unchecked_Deallocation
 116      (Command_Line_Configuration_Record, Command_Line_Configuration);
 117
 118    procedure Remove (Line : in out Argument_List_Access; Index : Integer);
 119    --  Remove a specific element from Line
 120
 121    procedure Add
 122      (Line   : in out Argument_List_Access;
 123       Str    : String_Access;
 124       Before : Boolean := False);
 125    --  Add a new element to Line. If Before is True, the item is inserted at
 126    --  the beginning, else it is appended.
 127
 128    procedure Add
 129      (Config : in out Command_Line_Configuration;
 130       Switch : Switch_Definition);
 131    procedure Add
 132      (Def   : in out Alias_Definitions_List;
 133       Alias : Alias_Definition);
 134    --  Add a new element to Def
 135
 136    procedure Initialize_Switch_Def
 137      (Def         : out Switch_Definition;
 138       Switch      : String := "";
 139       Long_Switch : String := "";
 140       Help        : String := "";
 141       Section     : String := "";
 142       Argument    : String := "ARG");
 143    --  Initialize [Def] with the contents of the other parameters.
 144    --  This also checks consistency of the switch parameters, and will raise
 145    --  Invalid_Switch if they do not match.
 146
 147    procedure Decompose_Switch
 148      (Switch         : String;
 149       Parameter_Type : out Switch_Parameter_Type;
 150       Switch_Last    : out Integer);
 151    --  Given a switch definition ("name:" for instance), extracts the type of
 152    --  parameter that is expected, and the name of the switch
 153
 154    function Can_Have_Parameter (S : String) return Boolean;
 155    --  True if S can have a parameter
 156
 157    function Require_Parameter (S : String) return Boolean;
 158    --  True if S requires a parameter
 159
 160    function Actual_Switch (S : String) return String;
 161    --  Remove any possible trailing '!', ':', '?' and '='
 162
 163    generic
 164       with procedure Callback
 165         (Simple_Switch : String;
 166          Separator     : String;
 167          Parameter     : String;
 168          Index         : Integer);  --  Index in Config.Switches, or -1
 169    procedure For_Each_Simple_Switch
 170      (Config    : Command_Line_Configuration;
 171       Section   : String;
 172       Switch    : String;
 173       Parameter : String  := "";
 174       Unalias   : Boolean := True);
 175    --  Breaks Switch into as simple switches as possible (expanding aliases and
 176    --  ungrouping common prefixes when possible), and call Callback for each of
 177    --  these.
 178
 179    procedure Sort_Sections
 180      (Line     : GNAT.OS_Lib.Argument_List_Access;
 181       Sections : GNAT.OS_Lib.Argument_List_Access;
 182       Params   : GNAT.OS_Lib.Argument_List_Access);
 183    --  Reorder the command line switches so that the switches belonging to a
 184    --  section are grouped together.
 185
 186    procedure Group_Switches
 187      (Cmd      : Command_Line;
 188       Result   : Argument_List_Access;
 189       Sections : Argument_List_Access;
 190       Params   : Argument_List_Access);
 191    --  Group switches with common prefixes whenever possible. Once they have
 192    --  been grouped, we also check items for possible aliasing.
 193
 194    procedure Alias_Switches
 195      (Cmd    : Command_Line;
 196       Result : Argument_List_Access;
 197       Params : Argument_List_Access);
 198    --  When possible, replace one or more switches by an alias, i.e. a shorter
 199    --  version.
 200
 201    function Looking_At
 202      (Type_Str  : String;
 203       Index     : Natural;
 204       Substring : String) return Boolean;
 205    --  Return True if the characters starting at Index in Type_Str are
 206    --  equivalent to Substring.
 207
 208    generic
 209       with function Callback (S : String; Index : Integer) return Boolean;
 210    procedure Foreach_Switch
 211      (Config   : Command_Line_Configuration;
 212       Section  : String);
 213    --  Iterate over all switches defined in Config, for a specific section.
 214    --  Index is set to the index in Config.Switches. Stop iterating when
 215    --  Callback returns False.
 216
 217    --------------
 218    -- Argument --
 219    --------------
 220
 221    function Argument (Parser : Opt_Parser; Index : Integer) return String is
 222    begin
 223       if Parser.Arguments /= null then
 224          return Parser.Arguments (Index + Parser.Arguments'First - 1).all;
 225       else
 226          return CL.Argument (Index);
 227       end if;
 228    end Argument;
 229
 230    ------------------------------
 231    -- Canonical_Case_File_Name --
 232    ------------------------------
 233
 234    procedure Canonical_Case_File_Name (S : in out String) is
 235    begin
 236       if not File_Names_Case_Sensitive then
 237          for J in S'Range loop
 238             if S (J) in 'A' .. 'Z' then
 239                S (J) := Character'Val
 240                           (Character'Pos (S (J)) +
 241                             (Character'Pos ('a') - Character'Pos ('A')));
 242             end if;
 243          end loop;
 244       end if;
 245    end Canonical_Case_File_Name;
 246
 247    ---------------
 248    -- Expansion --
 249    ---------------
 250
 251    function Expansion (Iterator : Expansion_Iterator) return String is
 252       type Pointer is access all Expansion_Iterator;
 253
 254       It   : constant Pointer := Iterator'Unrestricted_Access;
 255       S    : String (1 .. 1024);
 256       Last : Natural;
 257
 258       Current : Depth := It.Current_Depth;
 259       NL      : Positive;
 260
 261    begin
 262       --  It is assumed that a directory is opened at the current level.
 263       --  Otherwise GNAT.Directory_Operations.Directory_Error will be raised
 264       --  at the first call to Read.
 265
 266       loop
 267          Read (It.Levels (Current).Dir, S, Last);
 268
 269          --  If we have exhausted the directory, close it and go back one level
 270
 271          if Last = 0 then
 272             Close (It.Levels (Current).Dir);
 273
 274             --  If we are at level 1, we are finished; return an empty string
 275
 276             if Current = 1 then
 277                return String'(1 .. 0 => ' ');
 278
 279             --  Otherwise continue with the directory at the previous level
 280
 281             else
 282                Current := Current - 1;
 283                It.Current_Depth := Current;
 284             end if;
 285
 286          --  If this is a directory, that is neither "." or "..", attempt to
 287          --  go to the next level.
 288
 289          elsif Is_Directory
 290                  (It.Dir_Name (1 .. It.Levels (Current).Name_Last) &
 291                     S (1 .. Last))
 292              and then S (1 .. Last) /= "."
 293              and then S (1 .. Last) /= ".."
 294          then
 295             --  We can go to the next level only if we have not reached the
 296             --  maximum depth,
 297
 298             if Current < It.Maximum_Depth then
 299                NL := It.Levels (Current).Name_Last;
 300
 301                --  And if relative path of this new directory is not too long
 302
 303                if NL + Last + 1 < Max_Path_Length then
 304                   Current := Current + 1;
 305                   It.Current_Depth := Current;
 306                   It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last);
 307                   NL := NL + Last + 1;
 308                   It.Dir_Name (NL) := Directory_Separator;
 309                   It.Levels (Current).Name_Last := NL;
 310                   Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
 311
 312                   --  Open the new directory, and read from it
 313
 314                   GNAT.Directory_Operations.Open
 315                     (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
 316                end if;
 317             end if;
 318          end if;
 319
 320          --  Check the relative path against the pattern
 321
 322          --  Note that we try to match also against directory names, since
 323          --  clients of this function may expect to retrieve directories.
 324
 325          declare
 326             Name : String :=
 327                      It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
 328                        & S (1 .. Last);
 329
 330          begin
 331             Canonical_Case_File_Name (Name);
 332
 333             --  If it matches return the relative path
 334
 335             if GNAT.Regexp.Match (Name, Iterator.Regexp) then
 336                return Name;
 337             end if;
 338          end;
 339       end loop;
 340    end Expansion;
 341
 342    ---------------------
 343    -- Current_Section --
 344    ---------------------
 345
 346    function Current_Section
 347      (Parser : Opt_Parser := Command_Line_Parser) return String
 348    is
 349    begin
 350       if Parser.Current_Section = 1 then
 351          return "";
 352       end if;
 353
 354       for Index in reverse 1 .. Integer'Min (Parser.Current_Argument - 1,
 355                                              Parser.Section'Last)
 356       loop
 357          if Parser.Section (Index) = 0 then
 358             return Argument (Parser, Index);
 359          end if;
 360       end loop;
 361
 362       return "";
 363    end Current_Section;
 364
 365    -----------------
 366    -- Full_Switch --
 367    -----------------
 368
 369    function Full_Switch
 370      (Parser : Opt_Parser := Command_Line_Parser) return String
 371    is
 372    begin
 373       if Parser.The_Switch.Extra = ASCII.NUL then
 374          return Argument (Parser, Parser.The_Switch.Arg_Num)
 375            (Parser.The_Switch.First .. Parser.The_Switch.Last);
 376       else
 377          return Parser.The_Switch.Extra
 378            & Argument (Parser, Parser.The_Switch.Arg_Num)
 379            (Parser.The_Switch.First .. Parser.The_Switch.Last);
 380       end if;
 381    end Full_Switch;
 382
 383    ------------------
 384    -- Get_Argument --
 385    ------------------
 386
 387    function Get_Argument
 388      (Do_Expansion : Boolean    := False;
 389       Parser       : Opt_Parser := Command_Line_Parser) return String
 390    is
 391    begin
 392       if Parser.In_Expansion then
 393          declare
 394             S : constant String := Expansion (Parser.Expansion_It);
 395          begin
 396             if S'Length /= 0 then
 397                return S;
 398             else
 399                Parser.In_Expansion := False;
 400             end if;
 401          end;
 402       end if;
 403
 404       if Parser.Current_Argument > Parser.Arg_Count then
 405
 406          --  If this is the first time this function is called
 407
 408          if Parser.Current_Index = 1 then
 409             Parser.Current_Argument := 1;
 410             while Parser.Current_Argument <= Parser.Arg_Count
 411               and then Parser.Section (Parser.Current_Argument) /=
 412                                                       Parser.Current_Section
 413             loop
 414                Parser.Current_Argument := Parser.Current_Argument + 1;
 415             end loop;
 416
 417          else
 418             return String'(1 .. 0 => ' ');
 419          end if;
 420
 421       elsif Parser.Section (Parser.Current_Argument) = 0 then
 422          while Parser.Current_Argument <= Parser.Arg_Count
 423            and then Parser.Section (Parser.Current_Argument) /=
 424                                                       Parser.Current_Section
 425          loop
 426             Parser.Current_Argument := Parser.Current_Argument + 1;
 427          end loop;
 428       end if;
 429
 430       Parser.Current_Index := Integer'Last;
 431
 432       while Parser.Current_Argument <= Parser.Arg_Count
 433         and then Parser.Is_Switch (Parser.Current_Argument)
 434       loop
 435          Parser.Current_Argument := Parser.Current_Argument + 1;
 436       end loop;
 437
 438       if Parser.Current_Argument > Parser.Arg_Count then
 439          return String'(1 .. 0 => ' ');
 440       elsif Parser.Section (Parser.Current_Argument) = 0 then
 441          return Get_Argument (Do_Expansion);
 442       end if;
 443
 444       Parser.Current_Argument := Parser.Current_Argument + 1;
 445
 446       --  Could it be a file name with wild cards to expand?
 447
 448       if Do_Expansion then
 449          declare
 450             Arg   : constant String :=
 451                       Argument (Parser, Parser.Current_Argument - 1);
 452          begin
 453             for Index in Arg'Range loop
 454                if Arg (Index) = '*'
 455                  or else Arg (Index) = '?'
 456                  or else Arg (Index) = '['
 457                then
 458                   Parser.In_Expansion := True;
 459                   Start_Expansion (Parser.Expansion_It, Arg);
 460                   return Get_Argument (Do_Expansion, Parser);
 461                end if;
 462             end loop;
 463          end;
 464       end if;
 465
 466       return Argument (Parser, Parser.Current_Argument - 1);
 467    end Get_Argument;
 468
 469    ----------------------
 470    -- Decompose_Switch --
 471    ----------------------
 472
 473    procedure Decompose_Switch
 474      (Switch         : String;
 475       Parameter_Type : out Switch_Parameter_Type;
 476       Switch_Last    : out Integer)
 477    is
 478    begin
 479       if Switch = "" then
 480          Parameter_Type := Parameter_None;
 481          Switch_Last := Switch'Last;
 482          return;
 483       end if;
 484
 485       case Switch (Switch'Last) is
 486          when ':'    =>
 487             Parameter_Type := Parameter_With_Optional_Space;
 488             Switch_Last    := Switch'Last - 1;
 489          when '='    =>
 490             Parameter_Type := Parameter_With_Space_Or_Equal;
 491             Switch_Last    := Switch'Last - 1;
 492          when '!'    =>
 493             Parameter_Type := Parameter_No_Space;
 494             Switch_Last    := Switch'Last - 1;
 495          when '?'    =>
 496             Parameter_Type := Parameter_Optional;
 497             Switch_Last    := Switch'Last - 1;
 498          when others =>
 499             Parameter_Type := Parameter_None;
 500             Switch_Last    := Switch'Last;
 501       end case;
 502    end Decompose_Switch;
 503
 504    ----------------------------------
 505    -- Find_Longest_Matching_Switch --
 506    ----------------------------------
 507
 508    procedure Find_Longest_Matching_Switch
 509      (Switches          : String;
 510       Arg               : String;
 511       Index_In_Switches : out Integer;
 512       Switch_Length     : out Integer;
 513       Param             : out Switch_Parameter_Type)
 514    is
 515       Index  : Natural;
 516       Length : Natural := 1;
 517       Last   : Natural;
 518       P      : Switch_Parameter_Type;
 519
 520    begin
 521       Index_In_Switches := 0;
 522       Switch_Length     := 0;
 523
 524       --  Remove all leading spaces first to make sure that Index points
 525       --  at the start of the first switch.
 526
 527       Index := Switches'First;
 528       while Index <= Switches'Last and then Switches (Index) = ' ' loop
 529          Index := Index + 1;
 530       end loop;
 531
 532       while Index <= Switches'Last loop
 533
 534          --  Search the length of the parameter at this position in Switches
 535
 536          Length := Index;
 537          while Length <= Switches'Last
 538            and then Switches (Length) /= ' '
 539          loop
 540             Length := Length + 1;
 541          end loop;
 542
 543          --  Length now marks the separator after the current switch. Last will
 544          --  mark the last character of the name of the switch.
 545
 546          if Length = Index + 1 then
 547             P := Parameter_None;
 548             Last := Index;
 549          else
 550             Decompose_Switch (Switches (Index .. Length - 1), P, Last);
 551          end if;
 552
 553          --  If it is the one we searched, it may be a candidate
 554
 555          if Arg'First + Last - Index <= Arg'Last
 556            and then Switches (Index .. Last) =
 557                       Arg (Arg'First .. Arg'First + Last - Index)
 558            and then Last - Index + 1 > Switch_Length
 559          then
 560             Param             := P;
 561             Index_In_Switches := Index;
 562             Switch_Length     := Last - Index + 1;
 563          end if;
 564
 565          --  Look for the next switch in Switches
 566
 567          while Index <= Switches'Last
 568            and then Switches (Index) /= ' '
 569          loop
 570             Index := Index + 1;
 571          end loop;
 572
 573          Index := Index + 1;
 574       end loop;
 575    end Find_Longest_Matching_Switch;
 576
 577    ------------
 578    -- Getopt --
 579    ------------
 580
 581    function Getopt
 582      (Switches    : String;
 583       Concatenate : Boolean := True;
 584       Parser      : Opt_Parser := Command_Line_Parser) return Character
 585    is
 586       Dummy : Boolean;
 587
 588    begin
 589       <<Restart>>
 590
 591       --  If we have finished parsing the current command line item (there
 592       --  might be multiple switches in a single item), then go to the next
 593       --  element.
 594
 595       if Parser.Current_Argument > Parser.Arg_Count
 596         or else (Parser.Current_Index >
 597                    Argument (Parser, Parser.Current_Argument)'Last
 598                  and then not Goto_Next_Argument_In_Section (Parser))
 599       then
 600          return ASCII.NUL;
 601       end if;
 602
 603       --  By default, the switch will not have a parameter
 604
 605       Parser.The_Parameter :=
 606         (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
 607       Parser.The_Separator := ASCII.NUL;
 608
 609       declare
 610          Arg            : constant String :=
 611                             Argument (Parser, Parser.Current_Argument);
 612          Index_Switches : Natural := 0;
 613          Max_Length     : Natural := 0;
 614          End_Index      : Natural;
 615          Param          : Switch_Parameter_Type;
 616       begin
 617          --  If we are on a new item, test if this might be a switch
 618
 619          if Parser.Current_Index = Arg'First then
 620             if Arg (Arg'First) /= Parser.Switch_Character then
 621
 622                --  If it isn't a switch, return it immediately. We also know it
 623                --  isn't the parameter to a previous switch, since that has
 624                --  already been handled.
 625
 626                if Switches (Switches'First) = '*' then
 627                   Set_Parameter
 628                     (Parser.The_Switch,
 629                      Arg_Num => Parser.Current_Argument,
 630                      First   => Arg'First,
 631                      Last    => Arg'Last);
 632                   Parser.Is_Switch (Parser.Current_Argument) := True;
 633                   Dummy := Goto_Next_Argument_In_Section (Parser);
 634                   return '*';
 635                end if;
 636
 637                if Parser.Stop_At_First then
 638                   Parser.Current_Argument := Positive'Last;
 639                   return ASCII.NUL;
 640
 641                elsif not Goto_Next_Argument_In_Section (Parser) then
 642                   return ASCII.NUL;
 643
 644                else
 645                   --  Recurse to get the next switch on the command line
 646
 647                   goto Restart;
 648                end if;
 649             end if;
 650
 651             --  We are on the first character of a new command line argument,
 652             --  which starts with Switch_Character. Further analysis is needed.
 653
 654             Parser.Current_Index := Parser.Current_Index + 1;
 655             Parser.Is_Switch (Parser.Current_Argument) := True;
 656          end if;
 657
 658          Find_Longest_Matching_Switch
 659            (Switches          => Switches,
 660             Arg               => Arg (Parser.Current_Index .. Arg'Last),
 661             Index_In_Switches => Index_Switches,
 662             Switch_Length     => Max_Length,
 663             Param             => Param);
 664
 665          --  If switch is not accepted, it is either invalid or is returned
 666          --  in the context of '*'.
 667
 668          if Index_Switches = 0 then
 669
 670             --  Find the current switch that we did not recognize. This is in
 671             --  fact difficult because Getopt does not know explicitly about
 672             --  short and long switches. Ideally, we would want the following
 673             --  behavior:
 674
 675             --      * for short switches, with Concatenate:
 676             --        if -a is not recognized, and the command line has -daf
 677             --        we should report the invalid switch as "-a".
 678
 679             --      * for short switches, wihtout Concatenate:
 680             --        we should report the invalid switch as "-daf".
 681
 682             --      * for long switches:
 683             --        if the commadn line is "--long" we should report --long
 684             --        as unrecongized.
 685
 686             --  Unfortunately, the fact that long switches start with a
 687             --  duplicate switch character is just a convention (so we could
 688             --  have a long switch "-long" for instance). We'll still rely on
 689             --  this convention here to try and get as helpful an error message
 690             --  as possible.
 691
 692             --  Long switch case (starting with double switch character)
 693
 694             if Arg (Arg'First + 1) = Parser.Switch_Character then
 695                End_Index := Arg'Last;
 696
 697             --  Short switch case
 698
 699             else
 700                End_Index :=
 701                  (if Concatenate then Parser.Current_Index else Arg'Last);
 702             end if;
 703
 704             if Switches (Switches'First) = '*' then
 705
 706                --  Always prepend the switch character, so that users know
 707                --  that this comes from a switch on the command line. This
 708                --  is especially important when Concatenate is False, since
 709                --  otherwise the current argument first character is lost.
 710
 711                if Parser.Section (Parser.Current_Argument) = 0 then
 712
 713                   --  A section transition should not be returned to the user
 714
 715                   Dummy := Goto_Next_Argument_In_Section (Parser);
 716                   goto Restart;
 717
 718                else
 719                   Set_Parameter
 720                     (Parser.The_Switch,
 721                      Arg_Num => Parser.Current_Argument,
 722                      First   => Parser.Current_Index,
 723                      Last    => Arg'Last,
 724                      Extra   => Parser.Switch_Character);
 725                   Parser.Is_Switch (Parser.Current_Argument) := True;
 726                   Dummy := Goto_Next_Argument_In_Section (Parser);
 727                   return '*';
 728                end if;
 729             end if;
 730
 731             if Parser.Current_Index = Arg'First then
 732                Set_Parameter
 733                  (Parser.The_Switch,
 734                   Arg_Num => Parser.Current_Argument,
 735                   First   => Parser.Current_Index,
 736                   Last    => End_Index);
 737             else
 738                Set_Parameter
 739                  (Parser.The_Switch,
 740                   Arg_Num => Parser.Current_Argument,
 741                   First   => Parser.Current_Index,
 742                   Last    => End_Index,
 743                   Extra   => Parser.Switch_Character);
 744             end if;
 745
 746             Parser.Current_Index := End_Index + 1;
 747
 748             raise Invalid_Switch;
 749          end if;
 750
 751          End_Index := Parser.Current_Index + Max_Length - 1;
 752          Set_Parameter
 753            (Parser.The_Switch,
 754             Arg_Num => Parser.Current_Argument,
 755             First   => Parser.Current_Index,
 756             Last    => End_Index);
 757
 758          case Param is
 759             when Parameter_With_Optional_Space =>
 760                if End_Index < Arg'Last then
 761                   Set_Parameter
 762                     (Parser.The_Parameter,
 763                      Arg_Num => Parser.Current_Argument,
 764                      First   => End_Index + 1,
 765                      Last    => Arg'Last);
 766                   Dummy := Goto_Next_Argument_In_Section (Parser);
 767
 768                elsif Parser.Current_Argument < Parser.Arg_Count
 769                  and then Parser.Section (Parser.Current_Argument + 1) /= 0
 770                then
 771                   Parser.Current_Argument := Parser.Current_Argument + 1;
 772                   Parser.The_Separator := ' ';
 773                   Set_Parameter
 774                     (Parser.The_Parameter,
 775                      Arg_Num => Parser.Current_Argument,
 776                      First => Argument (Parser, Parser.Current_Argument)'First,
 777                      Last  => Argument (Parser, Parser.Current_Argument)'Last);
 778                   Parser.Is_Switch (Parser.Current_Argument) := True;
 779                   Dummy := Goto_Next_Argument_In_Section (Parser);
 780
 781                else
 782                   Parser.Current_Index := End_Index + 1;
 783                   raise Invalid_Parameter;
 784                end if;
 785
 786             when Parameter_With_Space_Or_Equal =>
 787
 788                --  If the switch is of the form <switch>=xxx
 789
 790                if End_Index < Arg'Last then
 791                   if Arg (End_Index + 1) = '='
 792                     and then End_Index + 1 < Arg'Last
 793                   then
 794                      Parser.The_Separator := '=';
 795                      Set_Parameter
 796                        (Parser.The_Parameter,
 797                         Arg_Num => Parser.Current_Argument,
 798                         First   => End_Index + 2,
 799                         Last    => Arg'Last);
 800                      Dummy := Goto_Next_Argument_In_Section (Parser);
 801
 802                   else
 803                      Parser.Current_Index := End_Index + 1;
 804                      raise Invalid_Parameter;
 805                   end if;
 806
 807                --  Case of switch of the form <switch> xxx
 808
 809                elsif Parser.Current_Argument < Parser.Arg_Count
 810                  and then Parser.Section (Parser.Current_Argument + 1) /= 0
 811                then
 812                   Parser.Current_Argument := Parser.Current_Argument + 1;
 813                   Parser.The_Separator := ' ';
 814                   Set_Parameter
 815                     (Parser.The_Parameter,
 816                      Arg_Num => Parser.Current_Argument,
 817                      First => Argument (Parser, Parser.Current_Argument)'First,
 818                      Last  => Argument (Parser, Parser.Current_Argument)'Last);
 819                   Parser.Is_Switch (Parser.Current_Argument) := True;
 820                   Dummy := Goto_Next_Argument_In_Section (Parser);
 821
 822                else
 823                   Parser.Current_Index := End_Index + 1;
 824                   raise Invalid_Parameter;
 825                end if;
 826
 827             when Parameter_No_Space =>
 828                if End_Index < Arg'Last then
 829                   Set_Parameter
 830                     (Parser.The_Parameter,
 831                      Arg_Num => Parser.Current_Argument,
 832                      First   => End_Index + 1,
 833                      Last    => Arg'Last);
 834                   Dummy := Goto_Next_Argument_In_Section (Parser);
 835
 836                else
 837                   Parser.Current_Index := End_Index + 1;
 838                   raise Invalid_Parameter;
 839                end if;
 840
 841             when Parameter_Optional =>
 842                if End_Index < Arg'Last then
 843                   Set_Parameter
 844                     (Parser.The_Parameter,
 845                      Arg_Num => Parser.Current_Argument,
 846                      First   => End_Index + 1,
 847                      Last    => Arg'Last);
 848                end if;
 849
 850                Dummy := Goto_Next_Argument_In_Section (Parser);
 851
 852             when Parameter_None =>
 853                if Concatenate or else End_Index = Arg'Last then
 854                   Parser.Current_Index := End_Index + 1;
 855
 856                else
 857                   --  If Concatenate is False and the full argument is not
 858                   --  recognized as a switch, this is an invalid switch.
 859
 860                   if Switches (Switches'First) = '*' then
 861                      Set_Parameter
 862                        (Parser.The_Switch,
 863                         Arg_Num => Parser.Current_Argument,
 864                         First   => Arg'First,
 865                         Last    => Arg'Last);
 866                      Parser.Is_Switch (Parser.Current_Argument) := True;
 867                      Dummy := Goto_Next_Argument_In_Section (Parser);
 868                      return '*';
 869                   end if;
 870
 871                   Set_Parameter
 872                     (Parser.The_Switch,
 873                      Arg_Num => Parser.Current_Argument,
 874                      First   => Parser.Current_Index,
 875                      Last    => Arg'Last,
 876                      Extra   => Parser.Switch_Character);
 877                   Parser.Current_Index := Arg'Last + 1;
 878                   raise Invalid_Switch;
 879                end if;
 880          end case;
 881
 882          return Switches (Index_Switches);
 883       end;
 884    end Getopt;
 885
 886    -----------------------------------
 887    -- Goto_Next_Argument_In_Section --
 888    -----------------------------------
 889
 890    function Goto_Next_Argument_In_Section
 891      (Parser : Opt_Parser) return Boolean
 892    is
 893    begin
 894       Parser.Current_Argument := Parser.Current_Argument + 1;
 895
 896       if Parser.Current_Argument > Parser.Arg_Count
 897         or else Parser.Section (Parser.Current_Argument) = 0
 898       then
 899          loop
 900             Parser.Current_Argument := Parser.Current_Argument + 1;
 901
 902             if Parser.Current_Argument > Parser.Arg_Count then
 903                Parser.Current_Index := 1;
 904                return False;
 905             end if;
 906
 907             exit when Parser.Section (Parser.Current_Argument) =
 908                                                   Parser.Current_Section;
 909          end loop;
 910       end if;
 911
 912       Parser.Current_Index :=
 913         Argument (Parser, Parser.Current_Argument)'First;
 914
 915       return True;
 916    end Goto_Next_Argument_In_Section;
 917
 918    ------------------
 919    -- Goto_Section --
 920    ------------------
 921
 922    procedure Goto_Section
 923      (Name   : String := "";
 924       Parser : Opt_Parser := Command_Line_Parser)
 925    is
 926       Index : Integer;
 927
 928    begin
 929       Parser.In_Expansion := False;
 930
 931       if Name = "" then
 932          Parser.Current_Argument := 1;
 933          Parser.Current_Index    := 1;
 934          Parser.Current_Section  := 1;
 935          return;
 936       end if;
 937
 938       Index := 1;
 939       while Index <= Parser.Arg_Count loop
 940          if Parser.Section (Index) = 0
 941            and then Argument (Parser, Index) = Parser.Switch_Character & Name
 942          then
 943             Parser.Current_Argument := Index + 1;
 944             Parser.Current_Index    := 1;
 945
 946             if Parser.Current_Argument <= Parser.Arg_Count then
 947                Parser.Current_Section :=
 948                  Parser.Section (Parser.Current_Argument);
 949             end if;
 950
 951             --  Exit from loop if we have the start of another section
 952
 953             if Index = Parser.Section'Last
 954                or else Parser.Section (Index + 1) /= 0
 955             then
 956                return;
 957             end if;
 958          end if;
 959
 960          Index := Index + 1;
 961       end loop;
 962
 963       Parser.Current_Argument := Positive'Last;
 964       Parser.Current_Index := 2;   --  so that Get_Argument returns nothing
 965    end Goto_Section;
 966
 967    ----------------------------
 968    -- Initialize_Option_Scan --
 969    ----------------------------
 970
 971    procedure Initialize_Option_Scan
 972      (Switch_Char              : Character := '-';
 973       Stop_At_First_Non_Switch : Boolean   := False;
 974       Section_Delimiters       : String    := "")
 975    is
 976    begin
 977       Internal_Initialize_Option_Scan
 978         (Parser                   => Command_Line_Parser,
 979          Switch_Char              => Switch_Char,
 980          Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 981          Section_Delimiters       => Section_Delimiters);
 982    end Initialize_Option_Scan;
 983
 984    ----------------------------
 985    -- Initialize_Option_Scan --
 986    ----------------------------
 987
 988    procedure Initialize_Option_Scan
 989      (Parser                   : out Opt_Parser;
 990       Command_Line             : GNAT.OS_Lib.Argument_List_Access;
 991       Switch_Char              : Character := '-';
 992       Stop_At_First_Non_Switch : Boolean := False;
 993       Section_Delimiters       : String := "")
 994    is
 995    begin
 996       Free (Parser);
 997
 998       if Command_Line = null then
 999          Parser := new Opt_Parser_Data (CL.Argument_Count);
1000          Internal_Initialize_Option_Scan
1001            (Parser                   => Parser,
1002             Switch_Char              => Switch_Char,
1003             Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
1004             Section_Delimiters       => Section_Delimiters);
1005       else
1006          Parser := new Opt_Parser_Data (Command_Line'Length);
1007          Parser.Arguments := Command_Line;
1008          Internal_Initialize_Option_Scan
1009            (Parser                   => Parser,
1010             Switch_Char              => Switch_Char,
1011             Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
1012             Section_Delimiters       => Section_Delimiters);
1013       end if;
1014    end Initialize_Option_Scan;
1015
1016    -------------------------------------
1017    -- Internal_Initialize_Option_Scan --
1018    -------------------------------------
1019
1020    procedure Internal_Initialize_Option_Scan
1021      (Parser                   : Opt_Parser;
1022       Switch_Char              : Character;
1023       Stop_At_First_Non_Switch : Boolean;
1024       Section_Delimiters       : String)
1025    is
1026       Section_Num     : Section_Number;
1027       Section_Index   : Integer;
1028       Last            : Integer;
1029       Delimiter_Found : Boolean;
1030
1031       Discard : Boolean;
1032       pragma Warnings (Off, Discard);
1033
1034    begin
1035       Parser.Current_Argument := 0;
1036       Parser.Current_Index    := 0;
1037       Parser.In_Expansion     := False;
1038       Parser.Switch_Character := Switch_Char;
1039       Parser.Stop_At_First    := Stop_At_First_Non_Switch;
1040       Parser.Section          := (others => 1);
1041
1042       --  If we are using sections, we have to preprocess the command line to
1043       --  delimit them. A section can be repeated, so we just give each item
1044       --  on the command line a section number
1045
1046       Section_Num   := 1;
1047       Section_Index := Section_Delimiters'First;
1048       while Section_Index <= Section_Delimiters'Last loop
1049          Last := Section_Index;
1050          while Last <= Section_Delimiters'Last
1051            and then Section_Delimiters (Last) /= ' '
1052          loop
1053             Last := Last + 1;
1054          end loop;
1055
1056          Delimiter_Found := False;
1057          Section_Num := Section_Num + 1;
1058
1059          for Index in 1 .. Parser.Arg_Count loop
1060             if Argument (Parser, Index)(1) = Parser.Switch_Character
1061               and then
1062                 Argument (Parser, Index) = Parser.Switch_Character &
1063                                              Section_Delimiters
1064                                                (Section_Index .. Last - 1)
1065             then
1066                Parser.Section (Index) := 0;
1067                Delimiter_Found := True;
1068
1069             elsif Parser.Section (Index) = 0 then
1070
1071                --  A previous section delimiter
1072
1073                Delimiter_Found := False;
1074
1075             elsif Delimiter_Found then
1076                Parser.Section (Index) := Section_Num;
1077             end if;
1078          end loop;
1079
1080          Section_Index := Last + 1;
1081          while Section_Index <= Section_Delimiters'Last
1082            and then Section_Delimiters (Section_Index) = ' '
1083          loop
1084             Section_Index := Section_Index + 1;
1085          end loop;
1086       end loop;
1087
1088       Discard := Goto_Next_Argument_In_Section (Parser);
1089    end Internal_Initialize_Option_Scan;
1090
1091    ---------------
1092    -- Parameter --
1093    ---------------
1094
1095    function Parameter
1096      (Parser : Opt_Parser := Command_Line_Parser) return String
1097    is
1098    begin
1099       if Parser.The_Parameter.First > Parser.The_Parameter.Last then
1100          return String'(1 .. 0 => ' ');
1101       else
1102          return Argument (Parser, Parser.The_Parameter.Arg_Num)
1103            (Parser.The_Parameter.First .. Parser.The_Parameter.Last);
1104       end if;
1105    end Parameter;
1106
1107    ---------------
1108    -- Separator --
1109    ---------------
1110
1111    function Separator
1112      (Parser : Opt_Parser := Command_Line_Parser) return Character
1113    is
1114    begin
1115       return Parser.The_Separator;
1116    end Separator;
1117
1118    -------------------
1119    -- Set_Parameter --
1120    -------------------
1121
1122    procedure Set_Parameter
1123      (Variable : out Parameter_Type;
1124       Arg_Num  : Positive;
1125       First    : Positive;
1126       Last     : Positive;
1127       Extra    : Character := ASCII.NUL)
1128    is
1129    begin
1130       Variable.Arg_Num := Arg_Num;
1131       Variable.First   := First;
1132       Variable.Last    := Last;
1133       Variable.Extra   := Extra;
1134    end Set_Parameter;
1135
1136    ---------------------
1137    -- Start_Expansion --
1138    ---------------------
1139
1140    procedure Start_Expansion
1141      (Iterator     : out Expansion_Iterator;
1142       Pattern      : String;
1143       Directory    : String := "";
1144       Basic_Regexp : Boolean := True)
1145    is
1146       Directory_Separator : Character;
1147       pragma Import (C, Directory_Separator, "__gnat_dir_separator");
1148
1149       First : Positive := Pattern'First;
1150       Pat   : String := Pattern;
1151
1152    begin
1153       Canonical_Case_File_Name (Pat);
1154       Iterator.Current_Depth := 1;
1155
1156       --  If Directory is unspecified, use the current directory ("./" or ".\")
1157
1158       if Directory = "" then
1159          Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
1160          Iterator.Start := 3;
1161
1162       else
1163          Iterator.Dir_Name (1 .. Directory'Length) := Directory;
1164          Iterator.Start := Directory'Length + 1;
1165          Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length));
1166
1167          --  Make sure that the last character is a directory separator
1168
1169          if Directory (Directory'Last) /= Directory_Separator then
1170             Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
1171             Iterator.Start := Iterator.Start + 1;
1172          end if;
1173       end if;
1174
1175       Iterator.Levels (1).Name_Last := Iterator.Start - 1;
1176
1177       --  Open the initial Directory, at depth 1
1178
1179       GNAT.Directory_Operations.Open
1180         (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
1181
1182       --  If in the current directory and the pattern starts with "./" or ".\",
1183       --  drop the "./" or ".\" from the pattern.
1184
1185       if Directory = "" and then Pat'Length > 2
1186         and then Pat (Pat'First) = '.'
1187         and then Pat (Pat'First + 1) = Directory_Separator
1188       then
1189          First := Pat'First + 2;
1190       end if;
1191
1192       Iterator.Regexp :=
1193         GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True);
1194
1195       Iterator.Maximum_Depth := 1;
1196
1197       --  Maximum_Depth is equal to 1 plus the number of directory separators
1198       --  in the pattern.
1199
1200       for Index in First .. Pat'Last loop
1201          if Pat (Index) = Directory_Separator then
1202             Iterator.Maximum_Depth := Iterator.Maximum_Depth + 1;
1203             exit when Iterator.Maximum_Depth = Max_Depth;
1204          end if;
1205       end loop;
1206    end Start_Expansion;
1207
1208    ----------
1209    -- Free --
1210    ----------
1211
1212    procedure Free (Parser : in out Opt_Parser) is
1213       procedure Unchecked_Free is new
1214         Ada.Unchecked_Deallocation (Opt_Parser_Data, Opt_Parser);
1215    begin
1216       if Parser /= null and then Parser /= Command_Line_Parser then
1217          Free (Parser.Arguments);
1218          Unchecked_Free (Parser);
1219       end if;
1220    end Free;
1221
1222    ------------------
1223    -- Define_Alias --
1224    ------------------
1225
1226    procedure Define_Alias
1227      (Config   : in out Command_Line_Configuration;
1228       Switch   : String;
1229       Expanded : String;
1230       Section  : String := "")
1231    is
1232       Def    : Alias_Definition;
1233
1234    begin
1235       if Config = null then
1236          Config := new Command_Line_Configuration_Record;
1237       end if;
1238
1239       Def.Alias     := new String'(Switch);
1240       Def.Expansion := new String'(Expanded);
1241       Def.Section   := new String'(Section);
1242       Add (Config.Aliases, Def);
1243    end Define_Alias;
1244
1245    -------------------
1246    -- Define_Prefix --
1247    -------------------
1248
1249    procedure Define_Prefix
1250      (Config : in out Command_Line_Configuration;
1251       Prefix : String)
1252    is
1253    begin
1254       if Config = null then
1255          Config := new Command_Line_Configuration_Record;
1256       end if;
1257
1258       Add (Config.Prefixes, new String'(Prefix));
1259    end Define_Prefix;
1260
1261    ---------
1262    -- Add --
1263    ---------
1264
1265    procedure Add
1266      (Config : in out Command_Line_Configuration;
1267       Switch : Switch_Definition)
1268    is
1269       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1270         (Switch_Definitions, Switch_Definitions_List);
1271
1272       Tmp : Switch_Definitions_List;
1273
1274    begin
1275       if Config = null then
1276          Config := new Command_Line_Configuration_Record;
1277       end if;
1278
1279       Tmp := Config.Switches;
1280
1281       if Tmp = null then
1282          Config.Switches := new Switch_Definitions (1 .. 1);
1283       else
1284          Config.Switches := new Switch_Definitions (1 .. Tmp'Length + 1);
1285          Config.Switches (1 .. Tmp'Length) := Tmp.all;
1286          Unchecked_Free (Tmp);
1287       end if;
1288
1289       if Switch.Switch /= null and then Switch.Switch.all = "*" then
1290          Config.Star_Switch := True;
1291       end if;
1292
1293       Config.Switches (Config.Switches'Last) := Switch;
1294    end Add;
1295
1296    ---------
1297    -- Add --
1298    ---------
1299
1300    procedure Add
1301      (Def   : in out Alias_Definitions_List;
1302       Alias : Alias_Definition)
1303    is
1304       procedure Unchecked_Free is new
1305         Ada.Unchecked_Deallocation
1306           (Alias_Definitions, Alias_Definitions_List);
1307
1308       Tmp : Alias_Definitions_List := Def;
1309
1310    begin
1311       if Tmp = null then
1312          Def := new Alias_Definitions (1 .. 1);
1313       else
1314          Def := new Alias_Definitions (1 .. Tmp'Length + 1);
1315          Def (1 .. Tmp'Length) := Tmp.all;
1316          Unchecked_Free (Tmp);
1317       end if;
1318
1319       Def (Def'Last) := Alias;
1320    end Add;
1321
1322    ---------------------------
1323    -- Initialize_Switch_Def --
1324    ---------------------------
1325
1326    procedure Initialize_Switch_Def
1327      (Def         : out Switch_Definition;
1328       Switch      : String := "";
1329       Long_Switch : String := "";
1330       Help        : String := "";
1331       Section     : String := "";
1332       Argument    : String := "ARG")
1333    is
1334       P1, P2       : Switch_Parameter_Type := Parameter_None;
1335       Last1, Last2 : Integer;
1336
1337    begin
1338       if Switch /= "" then
1339          Def.Switch := new String'(Switch);
1340          Decompose_Switch (Switch, P1, Last1);
1341       end if;
1342
1343       if Long_Switch /= "" then
1344          Def.Long_Switch := new String'(Long_Switch);
1345          Decompose_Switch (Long_Switch, P2, Last2);
1346       end if;
1347
1348       if Switch /= "" and then Long_Switch /= "" then
1349          if (P1 = Parameter_None and then P2 /= P1)
1350            or else (P2 = Parameter_None and then P1 /= P2)
1351            or else (P1 = Parameter_Optional and then P2 /= P1)
1352            or else (P2 = Parameter_Optional and then P2 /= P1)
1353          then
1354             raise Invalid_Switch
1355               with "Inconsistent parameter types for "
1356                 & Switch & " and " & Long_Switch;
1357          end if;
1358       end if;
1359
1360       if Section /= "" then
1361          Def.Section := new String'(Section);
1362       end if;
1363
1364       if Argument /= "ARG" then
1365          Def.Argument := new String'(Argument);
1366       end if;
1367
1368       if Help /= "" then
1369          Def.Help := new String'(Help);
1370       end if;
1371    end Initialize_Switch_Def;
1372
1373    -------------------
1374    -- Define_Switch --
1375    -------------------
1376
1377    procedure Define_Switch
1378      (Config      : in out Command_Line_Configuration;
1379       Switch      : String := "";
1380       Long_Switch : String := "";
1381       Help        : String := "";
1382       Section     : String := "";
1383       Argument    : String := "ARG")
1384    is
1385       Def : Switch_Definition;
1386    begin
1387       if Switch /= "" or else Long_Switch /= "" then
1388          Initialize_Switch_Def
1389            (Def, Switch, Long_Switch, Help, Section, Argument);
1390          Add (Config, Def);
1391       end if;
1392    end Define_Switch;
1393
1394    -------------------
1395    -- Define_Switch --
1396    -------------------
1397
1398    procedure Define_Switch
1399      (Config      : in out Command_Line_Configuration;
1400       Output      : access Boolean;
1401       Switch      : String := "";
1402       Long_Switch : String := "";
1403       Help        : String := "";
1404       Section     : String := "";
1405       Value       : Boolean := True)
1406    is
1407       Def : Switch_Definition (Switch_Boolean);
1408    begin
1409       if Switch /= "" or else Long_Switch /= "" then
1410          Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
1411          Def.Boolean_Output := Output.all'Unchecked_Access;
1412          Def.Boolean_Value  := Value;
1413          Add (Config, Def);
1414       end if;
1415    end Define_Switch;
1416
1417    -------------------
1418    -- Define_Switch --
1419    -------------------
1420
1421    procedure Define_Switch
1422      (Config      : in out Command_Line_Configuration;
1423       Output      : access Integer;
1424       Switch      : String := "";
1425       Long_Switch : String := "";
1426       Help        : String := "";
1427       Section     : String := "";
1428       Initial     : Integer := 0;
1429       Default     : Integer := 1;
1430       Argument    : String := "ARG")
1431    is
1432       Def : Switch_Definition (Switch_Integer);
1433    begin
1434       if Switch /= "" or else Long_Switch /= "" then
1435          Initialize_Switch_Def
1436            (Def, Switch, Long_Switch, Help, Section, Argument);
1437          Def.Integer_Output  := Output.all'Unchecked_Access;
1438          Def.Integer_Default := Default;
1439          Def.Integer_Initial := Initial;
1440          Add (Config, Def);
1441       end if;
1442    end Define_Switch;
1443
1444    -------------------
1445    -- Define_Switch --
1446    -------------------
1447
1448    procedure Define_Switch
1449      (Config      : in out Command_Line_Configuration;
1450       Output      : access GNAT.Strings.String_Access;
1451       Switch      : String := "";
1452       Long_Switch : String := "";
1453       Help        : String := "";
1454       Section     : String := "";
1455       Argument    : String := "ARG")
1456    is
1457       Def : Switch_Definition (Switch_String);
1458    begin
1459       if Switch /= "" or else Long_Switch /= "" then
1460          Initialize_Switch_Def
1461            (Def, Switch, Long_Switch, Help, Section, Argument);
1462          Def.String_Output  := Output.all'Unchecked_Access;
1463          Add (Config, Def);
1464       end if;
1465    end Define_Switch;
1466
1467    --------------------
1468    -- Define_Section --
1469    --------------------
1470
1471    procedure Define_Section
1472      (Config : in out Command_Line_Configuration;
1473       Section : String)
1474    is
1475    begin
1476       if Config = null then
1477          Config := new Command_Line_Configuration_Record;
1478       end if;
1479
1480       Add (Config.Sections, new String'(Section));
1481    end Define_Section;
1482
1483    --------------------
1484    -- Foreach_Switch --
1485    --------------------
1486
1487    procedure Foreach_Switch
1488      (Config   : Command_Line_Configuration;
1489       Section  : String)
1490    is
1491    begin
1492       if Config /= null and then Config.Switches /= null then
1493          for J in Config.Switches'Range loop
1494             if (Section = "" and then Config.Switches (J).Section = null)
1495               or else
1496                 (Config.Switches (J).Section /= null
1497                   and then Config.Switches (J).Section.all = Section)
1498             then
1499                exit when Config.Switches (J).Switch /= null
1500                  and then not Callback (Config.Switches (J).Switch.all, J);
1501
1502                exit when Config.Switches (J).Long_Switch /= null
1503                  and then
1504                    not Callback (Config.Switches (J).Long_Switch.all, J);
1505             end if;
1506          end loop;
1507       end if;
1508    end Foreach_Switch;
1509
1510    ------------------
1511    -- Get_Switches --
1512    ------------------
1513
1514    function Get_Switches
1515      (Config      : Command_Line_Configuration;
1516       Switch_Char : Character := '-';
1517       Section     : String := "") return String
1518    is
1519       Ret : Ada.Strings.Unbounded.Unbounded_String;
1520       use Ada.Strings.Unbounded;
1521
1522       function Add_Switch (S : String; Index : Integer) return Boolean;
1523       --  Add a switch to Ret
1524
1525       ----------------
1526       -- Add_Switch --
1527       ----------------
1528
1529       function Add_Switch (S : String; Index : Integer) return Boolean is
1530          pragma Unreferenced (Index);
1531       begin
1532          if S = "*" then
1533             Ret := "*" & Ret;  --  Always first
1534          elsif S (S'First) = Switch_Char then
1535             Append (Ret, " " & S (S'First + 1 .. S'Last));
1536          else
1537             Append (Ret, " " & S);
1538          end if;
1539
1540          return True;
1541       end Add_Switch;
1542
1543       Tmp : Boolean;
1544       pragma Unreferenced (Tmp);
1545
1546       procedure Foreach is new Foreach_Switch (Add_Switch);
1547
1548    --  Start of processing for Get_Switches
1549
1550    begin
1551       if Config = null then
1552          return "";
1553       end if;
1554
1555       Foreach (Config, Section => Section);
1556
1557       --  Add relevant aliases
1558
1559       if Config.Aliases /= null then
1560          for A in Config.Aliases'Range loop
1561             if Config.Aliases (A).Section.all = Section then
1562                Tmp := Add_Switch (Config.Aliases (A).Alias.all, -1);
1563             end if;
1564          end loop;
1565       end if;
1566
1567       return To_String (Ret);
1568    end Get_Switches;
1569
1570    ------------------------
1571    -- Section_Delimiters --
1572    ------------------------
1573
1574    function Section_Delimiters
1575      (Config : Command_Line_Configuration) return String
1576    is
1577       use Ada.Strings.Unbounded;
1578       Result : Unbounded_String;
1579
1580    begin
1581       if Config /= null and then Config.Sections /= null then
1582          for S in Config.Sections'Range loop
1583             Append (Result, " " & Config.Sections (S).all);
1584          end loop;
1585       end if;
1586
1587       return To_String (Result);
1588    end Section_Delimiters;
1589
1590    -----------------------
1591    -- Set_Configuration --
1592    -----------------------
1593
1594    procedure Set_Configuration
1595      (Cmd    : in out Command_Line;
1596       Config : Command_Line_Configuration)
1597    is
1598    begin
1599       Cmd.Config := Config;
1600    end Set_Configuration;
1601
1602    -----------------------
1603    -- Get_Configuration --
1604    -----------------------
1605
1606    function Get_Configuration
1607      (Cmd : Command_Line) return Command_Line_Configuration
1608    is
1609    begin
1610       return Cmd.Config;
1611    end Get_Configuration;
1612
1613    ----------------------
1614    -- Set_Command_Line --
1615    ----------------------
1616
1617    procedure Set_Command_Line
1618      (Cmd                : in out Command_Line;
1619       Switches           : String;
1620       Getopt_Description : String := "";
1621       Switch_Char        : Character := '-')
1622    is
1623       Tmp     : Argument_List_Access;
1624       Parser  : Opt_Parser;
1625       S       : Character;
1626       Section : String_Access := null;
1627
1628       function Real_Full_Switch
1629         (S      : Character;
1630          Parser : Opt_Parser) return String;
1631       --  Ensure that the returned switch value contains the Switch_Char prefix
1632       --  if needed.
1633
1634       ----------------------
1635       -- Real_Full_Switch --
1636       ----------------------
1637
1638       function Real_Full_Switch
1639         (S      : Character;
1640          Parser : Opt_Parser) return String
1641       is
1642       begin
1643          if S = '*' then
1644             return Full_Switch (Parser);
1645          else
1646             return Switch_Char & Full_Switch (Parser);
1647          end if;
1648       end Real_Full_Switch;
1649
1650    --  Start of processing for Set_Command_Line
1651
1652    begin
1653       Free (Cmd.Expanded);
1654       Free (Cmd.Params);
1655
1656       if Switches /= "" then
1657          Tmp := Argument_String_To_List (Switches);
1658          Initialize_Option_Scan (Parser, Tmp, Switch_Char);
1659
1660          loop
1661             begin
1662                if Cmd.Config /= null then
1663
1664                   --  Do not use Getopt_Description in this case. Otherwise,
1665                   --  if we have defined a prefix -gnaty, and two switches
1666                   --  -gnatya and -gnatyL!, we would have a different behavior
1667                   --  depending on the order of switches:
1668
1669                   --      -gnatyL1a   =>  -gnatyL with argument "1a"
1670                   --      -gnatyaL1   =>  -gnatya and -gnatyL with argument "1"
1671
1672                   --  This is because the call to Getopt below knows nothing
1673                   --  about prefixes, and in the first case finds a valid
1674                   --  switch with arguments, so returns it without analyzing
1675                   --  the argument. In the second case, the switch matches "*",
1676                   --  and is then decomposed below.
1677
1678                   --  Note: When a Command_Line object is associated with a
1679                   --  Command_Line_Config (which is mostly the case for tools
1680                   --  that let users choose the command line before spawning
1681                   --  other tools, for instance IDEs), the configuration of
1682                   --  the switches must be taken from the Command_Line_Config.
1683
1684                   S := Getopt (Switches    => "* " & Get_Switches (Cmd.Config),
1685                                Concatenate => False,
1686                                Parser      => Parser);
1687
1688                else
1689                   S := Getopt (Switches    => "* " & Getopt_Description,
1690                                Concatenate => False,
1691                                Parser      => Parser);
1692                end if;
1693
1694                exit when S = ASCII.NUL;
1695
1696                declare
1697                   Sw         : constant String := Real_Full_Switch (S, Parser);
1698                   Is_Section : Boolean         := False;
1699
1700                begin
1701                   if Cmd.Config /= null
1702                     and then Cmd.Config.Sections /= null
1703                   then
1704                      Section_Search :
1705                      for S in Cmd.Config.Sections'Range loop
1706                         if Sw = Cmd.Config.Sections (S).all then
1707                            Section := Cmd.Config.Sections (S);
1708                            Is_Section := True;
1709
1710                            exit Section_Search;
1711                         end if;
1712                      end loop Section_Search;
1713                   end if;
1714
1715                   if not Is_Section then
1716                      if Section = null then
1717                         Add_Switch (Cmd, Sw, Parameter (Parser));
1718                      else
1719                         Add_Switch
1720                           (Cmd, Sw, Parameter (Parser),
1721                            Section => Section.all);
1722                      end if;
1723                   end if;
1724                end;
1725
1726             exception
1727                when Invalid_Parameter =>
1728
1729                   --  Add it with no parameter, if that's the way the user
1730                   --  wants it.
1731
1732                   --  Specify the separator in all cases, as the switch might
1733                   --  need to be unaliased, and the alias might contain
1734                   --  switches with parameters.
1735
1736                   if Section = null then
1737                      Add_Switch
1738                        (Cmd, Switch_Char & Full_Switch (Parser));
1739                   else
1740                      Add_Switch
1741                        (Cmd, Switch_Char & Full_Switch (Parser),
1742                         Section   => Section.all);
1743                   end if;
1744             end;
1745          end loop;
1746
1747          Free (Parser);
1748       end if;
1749    end Set_Command_Line;
1750
1751    ----------------
1752    -- Looking_At --
1753    ----------------
1754
1755    function Looking_At
1756      (Type_Str  : String;
1757       Index     : Natural;
1758       Substring : String) return Boolean
1759    is
1760    begin
1761       return Index + Substring'Length - 1 <= Type_Str'Last
1762         and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
1763    end Looking_At;
1764
1765    ------------------------
1766    -- Can_Have_Parameter --
1767    ------------------------
1768
1769    function Can_Have_Parameter (S : String) return Boolean is
1770    begin
1771       if S'Length <= 1 then
1772          return False;
1773       end if;
1774
1775       case S (S'Last) is
1776          when '!' | ':' | '?' | '=' =>
1777             return True;
1778          when others =>
1779             return False;
1780       end case;
1781    end Can_Have_Parameter;
1782
1783    -----------------------
1784    -- Require_Parameter --
1785    -----------------------
1786
1787    function Require_Parameter (S : String) return Boolean is
1788    begin
1789       if S'Length <= 1 then
1790          return False;
1791       end if;
1792
1793       case S (S'Last) is
1794          when '!' | ':' | '=' =>
1795             return True;
1796          when others =>
1797             return False;
1798       end case;
1799    end Require_Parameter;
1800
1801    -------------------
1802    -- Actual_Switch --
1803    -------------------
1804
1805    function Actual_Switch (S : String) return String is
1806    begin
1807       if S'Length <= 1 then
1808          return S;
1809       end if;
1810
1811       case S (S'Last) is
1812          when '!' | ':' | '?' | '=' =>
1813             return S (S'First .. S'Last - 1);
1814          when others =>
1815             return S;
1816       end case;
1817    end Actual_Switch;
1818
1819    ----------------------------
1820    -- For_Each_Simple_Switch --
1821    ----------------------------
1822
1823    procedure For_Each_Simple_Switch
1824      (Config    : Command_Line_Configuration;
1825       Section   : String;
1826       Switch    : String;
1827       Parameter : String := "";
1828       Unalias   : Boolean := True)
1829    is
1830       function Group_Analysis
1831         (Prefix : String;
1832          Group  : String) return Boolean;
1833       --  Perform the analysis of a group of switches
1834
1835       Found_In_Config : Boolean := False;
1836       function Is_In_Config
1837         (Config_Switch : String; Index : Integer) return Boolean;
1838       --  If Switch is the same as Config_Switch, run the callback and sets
1839       --  Found_In_Config to True.
1840
1841       function Starts_With
1842         (Config_Switch : String; Index : Integer) return Boolean;
1843       --  if Switch starts with Config_Switch, sets Found_In_Config to True.
1844       --  The return value is for the Foreach_Switch iterator.
1845
1846       --------------------
1847       -- Group_Analysis --
1848       --------------------
1849
1850       function Group_Analysis
1851         (Prefix : String;
1852          Group  : String) return Boolean
1853       is
1854          Idx   : Natural;
1855          Found : Boolean;
1856
1857          function Analyze_Simple_Switch
1858            (Switch : String; Index : Integer) return Boolean;
1859          --  "Switches" is one of the switch definitions passed to the
1860          --  configuration, not one of the switches found on the command line.
1861
1862          ---------------------------
1863          -- Analyze_Simple_Switch --
1864          ---------------------------
1865
1866          function Analyze_Simple_Switch
1867            (Switch : String; Index : Integer) return Boolean
1868          is
1869             pragma Unreferenced (Index);
1870
1871             Full : constant String := Prefix & Group (Idx .. Group'Last);
1872
1873             Sw : constant String := Actual_Switch (Switch);
1874             --  Switches definition minus argument definition
1875
1876             Last  : Natural;
1877             Param : Natural;
1878
1879          begin
1880             --  Verify that sw starts with Prefix
1881
1882             if Looking_At (Sw, Sw'First, Prefix)
1883
1884               --  Verify that the group starts with sw
1885
1886               and then Looking_At (Full, Full'First, Sw)
1887             then
1888                Last  := Idx + Sw'Length - Prefix'Length - 1;
1889                Param := Last + 1;
1890
1891                if Can_Have_Parameter (Switch) then
1892
1893                   --  Include potential parameter to the recursive call. Only
1894                   --  numbers are allowed.
1895
1896                   while Last < Group'Last
1897                     and then Group (Last + 1) in '0' .. '9'
1898                   loop
1899                      Last := Last + 1;
1900                   end loop;
1901                end if;
1902
1903                if not Require_Parameter (Switch) or else Last >= Param then
1904                   if Idx = Group'First
1905                     and then Last = Group'Last
1906                     and then Last < Param
1907                   then
1908                      --  The group only concerns a single switch. Do not
1909                      --  perform recursive call.
1910
1911                      --  Note that we still perform a recursive call if
1912                      --  a parameter is detected in the switch, as this
1913                      --  is a way to correctly identify such a parameter
1914                      --  in aliases.
1915
1916                      return False;
1917                   end if;
1918
1919                   Found := True;
1920
1921                   --  Recursive call, using the detected parameter if any
1922
1923                   if Last >= Param then
1924                      For_Each_Simple_Switch
1925                        (Config,
1926                         Section,
1927                         Prefix & Group (Idx .. Param - 1),
1928                         Group (Param .. Last));
1929
1930                   else
1931                      For_Each_Simple_Switch
1932                        (Config, Section, Prefix & Group (Idx .. Last), "");
1933                   end if;
1934
1935                   Idx := Last + 1;
1936                   return False;
1937                end if;
1938             end if;
1939
1940             return True;
1941          end Analyze_Simple_Switch;
1942
1943          procedure Foreach is new Foreach_Switch (Analyze_Simple_Switch);
1944
1945       --  Start of processing for Group_Analysis
1946
1947       begin
1948          Idx := Group'First;
1949          while Idx <= Group'Last loop
1950             Found := False;
1951             Foreach (Config, Section);
1952
1953             if not Found then
1954                For_Each_Simple_Switch
1955                  (Config, Section, Prefix & Group (Idx), "");
1956                Idx := Idx + 1;
1957             end if;
1958          end loop;
1959
1960          return True;
1961       end Group_Analysis;
1962
1963       ------------------
1964       -- Is_In_Config --
1965       ------------------
1966
1967       function Is_In_Config
1968         (Config_Switch : String; Index : Integer) return Boolean
1969       is
1970          Last : Natural;
1971          P    : Switch_Parameter_Type;
1972
1973       begin
1974          Decompose_Switch (Config_Switch, P, Last);
1975
1976          if Config_Switch (Config_Switch'First .. Last) = Switch then
1977             case P is
1978                when Parameter_None =>
1979                   if Parameter = "" then
1980                      Callback (Switch, "", "", Index => Index);
1981                      Found_In_Config := True;
1982                      return False;
1983                   end if;
1984
1985                when Parameter_With_Optional_Space =>
1986                   Callback (Switch, " ", Parameter, Index => Index);
1987                   Found_In_Config := True;
1988                   return False;
1989
1990                when Parameter_With_Space_Or_Equal =>
1991                   Callback (Switch, "=", Parameter, Index => Index);
1992                   Found_In_Config := True;
1993                   return False;
1994
1995                when Parameter_No_Space =>
1996                   Callback (Switch, "", Parameter, Index);
1997                   Found_In_Config := True;
1998                   return False;
1999
2000                when Parameter_Optional =>
2001                   Callback (Switch, "", Parameter, Index);
2002                   Found_In_Config := True;
2003                   return False;
2004             end case;
2005          end if;
2006
2007          return True;
2008       end Is_In_Config;
2009
2010       -----------------
2011       -- Starts_With --
2012       -----------------
2013
2014       function Starts_With
2015         (Config_Switch : String; Index : Integer) return Boolean
2016       is
2017          Last  : Natural;
2018          Param : Natural;
2019          P     : Switch_Parameter_Type;
2020
2021       begin
2022          --  This function is called when we believe the parameter was
2023          --  specified as part of the switch, instead of separately. Thus we
2024          --  look in the config to find all possible switches.
2025
2026          Decompose_Switch (Config_Switch, P, Last);
2027
2028          if Looking_At
2029               (Switch, Switch'First,
2030                Config_Switch (Config_Switch'First .. Last))
2031          then
2032             --  Set first char of Param, and last char of Switch
2033
2034             Param := Switch'First + Last;
2035             Last  := Switch'First + Last - Config_Switch'First;
2036
2037             case P is
2038
2039                --  None is already handled in Is_In_Config
2040
2041                when Parameter_None =>
2042                   null;
2043
2044                when Parameter_With_Space_Or_Equal =>
2045                   if Param <= Switch'Last
2046                     and then
2047                       (Switch (Param) = ' ' or else Switch (Param) = '=')
2048                   then
2049                      Callback (Switch (Switch'First .. Last),
2050                                "=", Switch (Param + 1 .. Switch'Last), Index);
2051                      Found_In_Config := True;
2052                      return False;
2053                   end if;
2054
2055                when Parameter_With_Optional_Space =>
2056                   if Param <= Switch'Last and then Switch (Param) = ' '  then
2057                      Param := Param + 1;
2058                   end if;
2059
2060                   Callback (Switch (Switch'First .. Last),
2061                             " ", Switch (Param .. Switch'Last), Index);
2062                   Found_In_Config := True;
2063                   return False;
2064
2065                when Parameter_No_Space | Parameter_Optional =>
2066                   Callback (Switch (Switch'First .. Last),
2067                             "", Switch (Param .. Switch'Last), Index);
2068                   Found_In_Config := True;
2069                   return False;
2070             end case;
2071          end if;
2072          return True;
2073       end Starts_With;
2074
2075       procedure Foreach_In_Config is new Foreach_Switch (Is_In_Config);
2076       procedure Foreach_Starts_With is new Foreach_Switch (Starts_With);
2077
2078    --  Start of processing for For_Each_Simple_Switch
2079
2080    begin
2081       --  First determine if the switch corresponds to one belonging to the
2082       --  configuration. If so, run callback and exit.
2083
2084       --  ??? Is this necessary. On simple tests, we seem to have the same
2085       --  results with or without this call.
2086
2087       Foreach_In_Config (Config, Section);
2088
2089       if Found_In_Config then
2090          return;
2091       end if;
2092
2093       --  If adding a switch that can in fact be expanded through aliases,
2094       --  add separately each of its expansions.
2095
2096       --  This takes care of expansions like "-T" -> "-gnatwrs", where the
2097       --  alias and its expansion do not have the same prefix. Given the order
2098       --  in which we do things here, the expansion of the alias will itself
2099       --  be checked for a common prefix and split into simple switches.
2100
2101       if Unalias
2102         and then Config /= null
2103         and then Config.Aliases /= null
2104       then
2105          for A in Config.Aliases'Range loop
2106             if Config.Aliases (A).Section.all = Section
2107               and then Config.Aliases (A).Alias.all = Switch
2108               and then Parameter = ""
2109             then
2110                For_Each_Simple_Switch
2111                  (Config, Section, Config.Aliases (A).Expansion.all, "");
2112                return;
2113             end if;
2114          end loop;
2115       end if;
2116
2117       --  If adding a switch grouping several switches, add each of the simple
2118       --  switches instead.
2119
2120       if Config /= null and then Config.Prefixes /= null then
2121          for P in Config.Prefixes'Range loop
2122             if Switch'Length > Config.Prefixes (P)'Length + 1
2123               and then
2124                 Looking_At (Switch, Switch'First, Config.Prefixes (P).all)
2125             then
2126                --  Alias expansion will be done recursively
2127
2128                if Config.Switches = null then
2129                   for S in Switch'First + Config.Prefixes (P)'Length
2130                             .. Switch'Last
2131                   loop
2132                      For_Each_Simple_Switch
2133                        (Config, Section,
2134                         Config.Prefixes (P).all & Switch (S), "");
2135                   end loop;
2136
2137                   return;
2138
2139                elsif Group_Analysis
2140                  (Config.Prefixes (P).all,
2141                   Switch
2142                     (Switch'First + Config.Prefixes (P)'Length .. Switch'Last))
2143                then
2144                   --  Recursive calls already done on each switch of the group:
2145                   --  Return without executing Callback.
2146
2147                   return;
2148                end if;
2149             end if;
2150          end loop;
2151       end if;
2152
2153       --  Test if added switch is a known switch with parameter attached
2154       --  instead of being specified separately
2155
2156       if Parameter = ""
2157         and then Config /= null
2158         and then Config.Switches /= null
2159       then
2160          Found_In_Config := False;
2161          Foreach_Starts_With (Config, Section);
2162
2163          if Found_In_Config then
2164             return;
2165          end if;
2166       end if;
2167
2168       --  The switch is invalid in the config, but we still want to report it.
2169       --  The config could, for instance, include "*" to specify it accepts
2170       --  all switches.
2171
2172       Callback (Switch, " ", Parameter, Index => -1);
2173    end For_Each_Simple_Switch;
2174
2175    ----------------
2176    -- Add_Switch --
2177    ----------------
2178
2179    procedure Add_Switch
2180      (Cmd        : in out Command_Line;
2181       Switch     : String;
2182       Parameter  : String    := "";
2183       Separator  : Character := ASCII.NUL;
2184       Section    : String    := "";
2185       Add_Before : Boolean   := False)
2186    is
2187       Success : Boolean;
2188       pragma Unreferenced (Success);
2189    begin
2190       Add_Switch (Cmd, Switch, Parameter, Separator,
2191                   Section, Add_Before, Success);
2192    end Add_Switch;
2193
2194    ----------------
2195    -- Add_Switch --
2196    ----------------
2197
2198    procedure Add_Switch
2199      (Cmd        : in out Command_Line;
2200       Switch     : String;
2201       Parameter  : String := "";
2202       Separator  : Character := ASCII.NUL;
2203       Section    : String := "";
2204       Add_Before : Boolean := False;
2205       Success    : out Boolean)
2206    is
2207       procedure Add_Simple_Switch
2208         (Simple : String;
2209          Sepa   : String;
2210          Param  : String;
2211          Index  : Integer);
2212       --  Add a new switch that has had all its aliases expanded, and switches
2213       --  ungrouped. We know there are no more aliases in Switches.
2214
2215       -----------------------
2216       -- Add_Simple_Switch --
2217       -----------------------
2218
2219       procedure Add_Simple_Switch
2220         (Simple : String;
2221          Sepa   : String;
2222          Param  : String;
2223          Index  : Integer)
2224       is
2225          Sep : Character;
2226
2227       begin
2228          if Index = -1
2229            and then Cmd.Config /= null
2230            and then not Cmd.Config.Star_Switch
2231          then
2232             raise Invalid_Switch
2233               with "Invalid switch " & Simple;
2234          end if;
2235
2236          if Separator /= ASCII.NUL then
2237             Sep := Separator;
2238
2239          elsif Sepa = "" then
2240             Sep := ASCII.NUL;
2241          else
2242             Sep := Sepa (Sepa'First);
2243          end if;
2244
2245          if Cmd.Expanded = null then
2246             Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
2247
2248             if Param /= "" then
2249                Cmd.Params :=
2250                  new Argument_List'(1 .. 1 => new String'(Sep & Param));
2251             else
2252                Cmd.Params := new Argument_List'(1 .. 1 => null);
2253             end if;
2254
2255             if Section = "" then
2256                Cmd.Sections := new Argument_List'(1 .. 1 => null);
2257             else
2258                Cmd.Sections :=
2259                  new Argument_List'(1 .. 1 => new String'(Section));
2260             end if;
2261
2262          else
2263             --  Do we already have this switch?
2264
2265             for C in Cmd.Expanded'Range loop
2266                if Cmd.Expanded (C).all = Simple
2267                  and then
2268                    ((Cmd.Params (C) = null and then Param = "")
2269                      or else
2270                        (Cmd.Params (C) /= null
2271                          and then Cmd.Params (C).all = Sep & Param))
2272                  and then
2273                    ((Cmd.Sections (C) = null and then Section = "")
2274                      or else
2275                        (Cmd.Sections (C) /= null
2276                          and then Cmd.Sections (C).all = Section))
2277                then
2278                   return;
2279                end if;
2280             end loop;
2281
2282             --  Inserting at least one switch
2283
2284             Success := True;
2285             Add (Cmd.Expanded, new String'(Simple), Add_Before);
2286
2287             if Param /= "" then
2288                Add
2289                  (Cmd.Params,
2290                   new String'(Sep & Param),
2291                   Add_Before);
2292             else
2293                Add
2294                  (Cmd.Params,
2295                   null,
2296                   Add_Before);
2297             end if;
2298
2299             if Section = "" then
2300                Add
2301                  (Cmd.Sections,
2302                   null,
2303                   Add_Before);
2304             else
2305                Add
2306                  (Cmd.Sections,
2307                   new String'(Section),
2308                   Add_Before);
2309             end if;
2310          end if;
2311       end Add_Simple_Switch;
2312
2313       procedure Add_Simple_Switches is
2314         new For_Each_Simple_Switch (Add_Simple_Switch);
2315
2316       --  Local Variables
2317
2318       Section_Valid : Boolean := False;
2319
2320    --  Start of processing for Add_Switch
2321
2322    begin
2323       if Section /= "" and then Cmd.Config /= null then
2324          for S in Cmd.Config.Sections'Range loop
2325             if Section = Cmd.Config.Sections (S).all then
2326                Section_Valid := True;
2327                exit;
2328             end if;
2329          end loop;
2330
2331          if not Section_Valid then
2332             raise Invalid_Section;
2333          end if;
2334       end if;
2335
2336       Success := False;
2337       Add_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
2338       Free (Cmd.Coalesce);
2339    end Add_Switch;
2340
2341    ------------
2342    -- Remove --
2343    ------------
2344
2345    procedure Remove (Line : in out Argument_List_Access; Index : Integer) is
2346       Tmp : Argument_List_Access := Line;
2347
2348    begin
2349       Line := new Argument_List (Tmp'First .. Tmp'Last - 1);
2350
2351       if Index /= Tmp'First then
2352          Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1);
2353       end if;
2354
2355       Free (Tmp (Index));
2356
2357       if Index /= Tmp'Last then
2358          Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last);
2359       end if;
2360
2361       Unchecked_Free (Tmp);
2362    end Remove;
2363
2364    ---------
2365    -- Add --
2366    ---------
2367
2368    procedure Add
2369      (Line   : in out Argument_List_Access;
2370       Str    : String_Access;
2371       Before : Boolean := False)
2372    is
2373       Tmp : Argument_List_Access := Line;
2374
2375    begin
2376       if Tmp /= null then
2377          Line := new Argument_List (Tmp'First .. Tmp'Last + 1);
2378
2379          if Before then
2380             Line (Tmp'First)                     := Str;
2381             Line (Tmp'First + 1 .. Tmp'Last + 1) := Tmp.all;
2382          else
2383             Line (Tmp'Range)    := Tmp.all;
2384             Line (Tmp'Last + 1) := Str;
2385          end if;
2386
2387          Unchecked_Free (Tmp);
2388
2389       else
2390          Line := new Argument_List'(1 .. 1 => Str);
2391       end if;
2392    end Add;
2393
2394    -------------------
2395    -- Remove_Switch --
2396    -------------------
2397
2398    procedure Remove_Switch
2399      (Cmd           : in out Command_Line;
2400       Switch        : String;
2401       Remove_All    : Boolean := False;
2402       Has_Parameter : Boolean := False;
2403       Section       : String := "")
2404    is
2405       Success : Boolean;
2406       pragma Unreferenced (Success);
2407    begin
2408       Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success);
2409    end Remove_Switch;
2410
2411    -------------------
2412    -- Remove_Switch --
2413    -------------------
2414
2415    procedure Remove_Switch
2416      (Cmd           : in out Command_Line;
2417       Switch        : String;
2418       Remove_All    : Boolean := False;
2419       Has_Parameter : Boolean := False;
2420       Section       : String  := "";
2421       Success       : out Boolean)
2422    is
2423       procedure Remove_Simple_Switch
2424         (Simple, Separator, Param : String; Index : Integer);
2425       --  Removes a simple switch, with no aliasing or grouping
2426
2427       --------------------------
2428       -- Remove_Simple_Switch --
2429       --------------------------
2430
2431       procedure Remove_Simple_Switch
2432         (Simple, Separator, Param : String; Index : Integer)
2433       is
2434          C : Integer;
2435          pragma Unreferenced (Param, Separator, Index);
2436
2437       begin
2438          if Cmd.Expanded /= null then
2439             C := Cmd.Expanded'First;
2440             while C <= Cmd.Expanded'Last loop
2441                if Cmd.Expanded (C).all = Simple
2442                  and then
2443                    (Remove_All
2444                      or else (Cmd.Sections (C) = null
2445                                and then Section = "")
2446                      or else (Cmd.Sections (C) /= null
2447                                and then Section = Cmd.Sections (C).all))
2448                  and then (not Has_Parameter or else Cmd.Params (C) /= null)
2449                then
2450                   Remove (Cmd.Expanded, C);
2451                   Remove (Cmd.Params, C);
2452                   Remove (Cmd.Sections, C);
2453                   Success := True;
2454
2455                   if not Remove_All then
2456                      return;
2457                   end if;
2458
2459                else
2460                   C := C + 1;
2461                end if;
2462             end loop;
2463          end if;
2464       end Remove_Simple_Switch;
2465
2466       procedure Remove_Simple_Switches is
2467         new For_Each_Simple_Switch (Remove_Simple_Switch);
2468
2469    --  Start of processing for Remove_Switch
2470
2471    begin
2472       Success := False;
2473       Remove_Simple_Switches
2474         (Cmd.Config, Section, Switch, "", Unalias => not Has_Parameter);
2475       Free (Cmd.Coalesce);
2476    end Remove_Switch;
2477
2478    -------------------
2479    -- Remove_Switch --
2480    -------------------
2481
2482    procedure Remove_Switch
2483      (Cmd       : in out Command_Line;
2484       Switch    : String;
2485       Parameter : String;
2486       Section   : String  := "")
2487    is
2488       procedure Remove_Simple_Switch
2489         (Simple, Separator, Param : String; Index : Integer);
2490       --  Removes a simple switch, with no aliasing or grouping
2491
2492       --------------------------
2493       -- Remove_Simple_Switch --
2494       --------------------------
2495
2496       procedure Remove_Simple_Switch
2497         (Simple, Separator, Param : String; Index : Integer)
2498       is
2499          pragma Unreferenced (Separator, Index);
2500          C : Integer;
2501
2502       begin
2503          if Cmd.Expanded /= null then
2504             C := Cmd.Expanded'First;
2505             while C <= Cmd.Expanded'Last loop
2506                if Cmd.Expanded (C).all = Simple
2507                  and then
2508                    ((Cmd.Sections (C) = null
2509                       and then Section = "")
2510                     or else
2511                       (Cmd.Sections (C) /= null
2512                         and then Section = Cmd.Sections (C).all))
2513                  and then
2514                    ((Cmd.Params (C) = null and then Param = "")
2515                       or else
2516                         (Cmd.Params (C) /= null
2517
2518                           --  Ignore the separator stored in Parameter
2519
2520                           and then
2521                              Cmd.Params (C) (Cmd.Params (C)'First + 1
2522                                              .. Cmd.Params (C)'Last) = Param))
2523                then
2524                   Remove (Cmd.Expanded, C);
2525                   Remove (Cmd.Params, C);
2526                   Remove (Cmd.Sections, C);
2527
2528                   --  The switch is necessarily unique by construction of
2529                   --  Add_Switch.
2530
2531                   return;
2532
2533                else
2534                   C := C + 1;
2535                end if;
2536             end loop;
2537          end if;
2538       end Remove_Simple_Switch;
2539
2540       procedure Remove_Simple_Switches is
2541         new For_Each_Simple_Switch (Remove_Simple_Switch);
2542
2543    --  Start of processing for Remove_Switch
2544
2545    begin
2546       Remove_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
2547       Free (Cmd.Coalesce);
2548    end Remove_Switch;
2549
2550    --------------------
2551    -- Group_Switches --
2552    --------------------
2553
2554    procedure Group_Switches
2555      (Cmd      : Command_Line;
2556       Result   : Argument_List_Access;
2557       Sections : Argument_List_Access;
2558       Params   : Argument_List_Access)
2559    is
2560       function Compatible_Parameter (Param : String_Access) return Boolean;
2561       --  True when the parameter can be part of a group
2562
2563       --------------------------
2564       -- Compatible_Parameter --
2565       --------------------------
2566
2567       function Compatible_Parameter (Param : String_Access) return Boolean is
2568       begin
2569          --  No parameter OK
2570
2571          if Param = null then
2572             return True;
2573
2574          --  We need parameters without separators
2575
2576          elsif Param (Param'First) /= ASCII.NUL then
2577             return False;
2578
2579          --  Parameters must be all digits
2580
2581          else
2582             for J in Param'First + 1 .. Param'Last loop
2583                if Param (J) not in '0' .. '9' then
2584                   return False;
2585                end if;
2586             end loop;
2587
2588             return True;
2589          end if;
2590       end Compatible_Parameter;
2591
2592       --  Local declarations
2593
2594       Group : Ada.Strings.Unbounded.Unbounded_String;
2595       First : Natural;
2596       use type Ada.Strings.Unbounded.Unbounded_String;
2597
2598    --  Start of processing for Group_Switches
2599
2600    begin
2601       if Cmd.Config = null or else Cmd.Config.Prefixes = null then
2602          return;
2603       end if;
2604
2605       for P in Cmd.Config.Prefixes'Range loop
2606          Group   := Ada.Strings.Unbounded.Null_Unbounded_String;
2607          First   := 0;
2608
2609          for C in Result'Range loop
2610             if Result (C) /= null
2611               and then Compatible_Parameter (Params (C))
2612               and then Looking_At
2613                          (Result (C).all,
2614                           Result (C)'First,
2615                           Cmd.Config.Prefixes (P).all)
2616             then
2617                --  If we are still in the same section, group the switches
2618
2619                if First = 0
2620                  or else
2621                    (Sections (C) = null
2622                      and then Sections (First) = null)
2623                  or else
2624                    (Sections (C) /= null
2625                      and then Sections (First) /= null
2626                      and then Sections (C).all = Sections (First).all)
2627                then
2628                   Group :=
2629                     Group &
2630                       Result (C)
2631                         (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2632                          Result (C)'Last);
2633
2634                   if Params (C) /= null then
2635                      Group :=
2636                        Group &
2637                          Params (C) (Params (C)'First + 1 .. Params (C)'Last);
2638                      Free (Params (C));
2639                   end if;
2640
2641                   if First = 0 then
2642                      First := C;
2643                   end if;
2644
2645                   Free (Result (C));
2646
2647                --  We changed section: we put the grouped switches to the first
2648                --  place, on continue with the new section.
2649
2650                else
2651                   Result (First) :=
2652                     new String'
2653                       (Cmd.Config.Prefixes (P).all &
2654                        Ada.Strings.Unbounded.To_String (Group));
2655                   Group :=
2656                     Ada.Strings.Unbounded.To_Unbounded_String
2657                       (Result (C)
2658                          (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2659                           Result (C)'Last));
2660                   First := C;
2661                end if;
2662             end if;
2663          end loop;
2664
2665          if First > 0 then
2666             Result (First) :=
2667               new String'
2668                 (Cmd.Config.Prefixes (P).all &
2669                  Ada.Strings.Unbounded.To_String (Group));
2670          end if;
2671       end loop;
2672    end Group_Switches;
2673
2674    --------------------
2675    -- Alias_Switches --
2676    --------------------
2677
2678    procedure Alias_Switches
2679      (Cmd    : Command_Line;
2680       Result : Argument_List_Access;
2681       Params : Argument_List_Access)
2682    is
2683       Found : Boolean;
2684       First : Natural;
2685
2686       procedure Check_Cb (Switch, Separator, Param : String; Index : Integer);
2687       --  Checks whether the command line contains [Switch]. Sets the global
2688       --  variable [Found] appropriately. This is called for each simple switch
2689       --  that make up an alias, to know whether the alias should be applied.
2690
2691       procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer);
2692       --  Remove the simple switch [Switch] from the command line, since it is
2693       --  part of a simpler alias
2694
2695       --------------
2696       -- Check_Cb --
2697       --------------
2698
2699       procedure Check_Cb
2700         (Switch, Separator, Param : String; Index : Integer)
2701       is
2702          pragma Unreferenced (Separator, Index);
2703
2704       begin
2705          if Found then
2706             for E in Result'Range loop
2707                if Result (E) /= null
2708                  and then
2709                    (Params (E) = null
2710                      or else Params (E) (Params (E)'First + 1 ..
2711                                          Params (E)'Last) = Param)
2712                  and then Result (E).all = Switch
2713                then
2714                   return;
2715                end if;
2716             end loop;
2717
2718             Found := False;
2719          end if;
2720       end Check_Cb;
2721
2722       ---------------
2723       -- Remove_Cb --
2724       ---------------
2725
2726       procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer)
2727       is
2728          pragma Unreferenced (Separator, Index);
2729
2730       begin
2731          for E in Result'Range loop
2732             if Result (E) /= null
2733                  and then
2734                    (Params (E) = null
2735                      or else Params (E) (Params (E)'First + 1
2736                                              .. Params (E)'Last) = Param)
2737               and then Result (E).all = Switch
2738             then
2739                if First > E then
2740                   First := E;
2741                end if;
2742
2743                Free (Result (E));
2744                Free (Params (E));
2745                return;
2746             end if;
2747          end loop;
2748       end Remove_Cb;
2749
2750       procedure Check_All is new For_Each_Simple_Switch (Check_Cb);
2751       procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb);
2752
2753    --  Start of processing for Alias_Switches
2754
2755    begin
2756       if Cmd.Config = null or else Cmd.Config.Aliases = null then
2757          return;
2758       end if;
2759
2760       for A in Cmd.Config.Aliases'Range loop
2761
2762          --  Compute the various simple switches that make up the alias. We
2763          --  split the expansion into as many simple switches as possible, and
2764          --  then check whether the expanded command line has all of them.
2765
2766          Found := True;
2767          Check_All (Cmd.Config,
2768                     Switch  => Cmd.Config.Aliases (A).Expansion.all,
2769                     Section => Cmd.Config.Aliases (A).Section.all);
2770
2771          if Found then
2772             First := Integer'Last;
2773             Remove_All (Cmd.Config,
2774                         Switch  => Cmd.Config.Aliases (A).Expansion.all,
2775                         Section => Cmd.Config.Aliases (A).Section.all);
2776             Result (First) := new String'(Cmd.Config.Aliases (A).Alias.all);
2777          end if;
2778       end loop;
2779    end Alias_Switches;
2780
2781    -------------------
2782    -- Sort_Sections --
2783    -------------------
2784
2785    procedure Sort_Sections
2786      (Line     : GNAT.OS_Lib.Argument_List_Access;
2787       Sections : GNAT.OS_Lib.Argument_List_Access;
2788       Params   : GNAT.OS_Lib.Argument_List_Access)
2789    is
2790       Sections_List : Argument_List_Access :=
2791                         new Argument_List'(1 .. 1 => null);
2792       Found         : Boolean;
2793       Old_Line      : constant Argument_List := Line.all;
2794       Old_Sections  : constant Argument_List := Sections.all;
2795       Old_Params    : constant Argument_List := Params.all;
2796       Index         : Natural;
2797
2798    begin
2799       if Line = null then
2800          return;
2801       end if;
2802
2803       --  First construct a list of all sections
2804
2805       for E in Line'Range loop
2806          if Sections (E) /= null then
2807             Found := False;
2808             for S in Sections_List'Range loop
2809                if (Sections_List (S) = null and then Sections (E) = null)
2810                  or else
2811                    (Sections_List (S) /= null
2812                      and then Sections (E) /= null
2813                      and then Sections_List (S).all = Sections (E).all)
2814                then
2815                   Found := True;
2816                   exit;
2817                end if;
2818             end loop;
2819
2820             if not Found then
2821                Add (Sections_List, Sections (E));
2822             end if;
2823          end if;
2824       end loop;
2825
2826       Index := Line'First;
2827
2828       for S in Sections_List'Range loop
2829          for E in Old_Line'Range loop
2830             if (Sections_List (S) = null and then Old_Sections (E) = null)
2831               or else
2832                 (Sections_List (S) /= null
2833                   and then Old_Sections (E) /= null
2834                   and then Sections_List (S).all = Old_Sections (E).all)
2835             then
2836                Line (Index) := Old_Line (E);
2837                Sections (Index) := Old_Sections (E);
2838                Params (Index) := Old_Params (E);
2839                Index := Index + 1;
2840             end if;
2841          end loop;
2842       end loop;
2843
2844       Unchecked_Free (Sections_List);
2845    end Sort_Sections;
2846
2847    -----------
2848    -- Start --
2849    -----------
2850
2851    procedure Start
2852      (Cmd      : in out Command_Line;
2853       Iter     : in out Command_Line_Iterator;
2854       Expanded : Boolean := False)
2855    is
2856    begin
2857       if Cmd.Expanded = null then
2858          Iter.List := null;
2859          return;
2860       end if;
2861
2862       --  Reorder the expanded line so that sections are grouped
2863
2864       Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params);
2865
2866       --  Coalesce the switches as much as possible
2867
2868       if not Expanded
2869         and then Cmd.Coalesce = null
2870       then
2871          Cmd.Coalesce := new Argument_List (Cmd.Expanded'Range);
2872          for E in Cmd.Expanded'Range loop
2873             Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all);
2874          end loop;
2875
2876          Free (Cmd.Coalesce_Sections);
2877          Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
2878          for E in Cmd.Sections'Range loop
2879             Cmd.Coalesce_Sections (E) :=
2880               (if Cmd.Sections (E) = null then null
2881                else new String'(Cmd.Sections (E).all));
2882          end loop;
2883
2884          Free (Cmd.Coalesce_Params);
2885          Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range);
2886          for E in Cmd.Params'Range loop
2887             Cmd.Coalesce_Params (E) :=
2888               (if Cmd.Params (E) = null then null
2889                else new String'(Cmd.Params (E).all));
2890          end loop;
2891
2892          --  Not a clone, since we will not modify the parameters anyway
2893
2894          Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params);
2895          Group_Switches
2896            (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params);
2897       end if;
2898
2899       if Expanded then
2900          Iter.List     := Cmd.Expanded;
2901          Iter.Params   := Cmd.Params;
2902          Iter.Sections := Cmd.Sections;
2903       else
2904          Iter.List     := Cmd.Coalesce;
2905          Iter.Params   := Cmd.Coalesce_Params;
2906          Iter.Sections := Cmd.Coalesce_Sections;
2907       end if;
2908
2909       if Iter.List = null then
2910          Iter.Current := Integer'Last;
2911       else
2912          Iter.Current := Iter.List'First - 1;
2913          Next (Iter);
2914       end if;
2915    end Start;
2916
2917    --------------------
2918    -- Current_Switch --
2919    --------------------
2920
2921    function Current_Switch (Iter : Command_Line_Iterator) return String is
2922    begin
2923       return Iter.List (Iter.Current).all;
2924    end Current_Switch;
2925
2926    --------------------
2927    -- Is_New_Section --
2928    --------------------
2929
2930    function Is_New_Section    (Iter : Command_Line_Iterator) return Boolean is
2931       Section : constant String := Current_Section (Iter);
2932
2933    begin
2934       if Iter.Sections = null then
2935          return False;
2936
2937       elsif Iter.Current = Iter.Sections'First
2938         or else Iter.Sections (Iter.Current - 1) = null
2939       then
2940          return Section /= "";
2941
2942       else
2943          return Section /= Iter.Sections (Iter.Current - 1).all;
2944       end if;
2945    end Is_New_Section;
2946
2947    ---------------------
2948    -- Current_Section --
2949    ---------------------
2950
2951    function Current_Section (Iter : Command_Line_Iterator) return String is
2952    begin
2953       if Iter.Sections = null
2954         or else Iter.Current > Iter.Sections'Last
2955         or else Iter.Sections (Iter.Current) = null
2956       then
2957          return "";
2958       end if;
2959
2960       return Iter.Sections (Iter.Current).all;
2961    end Current_Section;
2962
2963    -----------------------
2964    -- Current_Separator --
2965    -----------------------
2966
2967    function Current_Separator (Iter : Command_Line_Iterator) return String is
2968    begin
2969       if Iter.Params = null
2970         or else Iter.Current > Iter.Params'Last
2971         or else Iter.Params (Iter.Current) = null
2972       then
2973          return "";
2974
2975       else
2976          declare
2977             Sep : constant Character :=
2978               Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First);
2979          begin
2980             if Sep = ASCII.NUL then
2981                return "";
2982             else
2983                return "" & Sep;
2984             end if;
2985          end;
2986       end if;
2987    end Current_Separator;
2988
2989    -----------------------
2990    -- Current_Parameter --
2991    -----------------------
2992
2993    function Current_Parameter (Iter : Command_Line_Iterator) return String is
2994    begin
2995       if Iter.Params = null
2996         or else Iter.Current > Iter.Params'Last
2997         or else Iter.Params (Iter.Current) = null
2998       then
2999          return "";
3000
3001       else
3002          --  Return result, skipping separator
3003
3004          declare
3005             P : constant String := Iter.Params (Iter.Current).all;
3006          begin
3007             return P (P'First + 1 .. P'Last);
3008          end;
3009       end if;
3010    end Current_Parameter;
3011
3012    --------------
3013    -- Has_More --
3014    --------------
3015
3016    function Has_More (Iter : Command_Line_Iterator) return Boolean is
3017    begin
3018       return Iter.List /= null and then Iter.Current <= Iter.List'Last;
3019    end Has_More;
3020
3021    ----------
3022    -- Next --
3023    ----------
3024
3025    procedure Next (Iter : in out Command_Line_Iterator) is
3026    begin
3027       Iter.Current := Iter.Current + 1;
3028       while Iter.Current <= Iter.List'Last
3029         and then Iter.List (Iter.Current) = null
3030       loop
3031          Iter.Current := Iter.Current + 1;
3032       end loop;
3033    end Next;
3034
3035    ----------
3036    -- Free --
3037    ----------
3038
3039    procedure Free (Config : in out Command_Line_Configuration) is
3040       procedure Unchecked_Free is new
3041         Ada.Unchecked_Deallocation
3042           (Switch_Definitions, Switch_Definitions_List);
3043
3044       procedure Unchecked_Free is new
3045         Ada.Unchecked_Deallocation
3046           (Alias_Definitions, Alias_Definitions_List);
3047
3048    begin
3049       if Config /= null then
3050          Free (Config.Prefixes);
3051          Free (Config.Sections);
3052          Free (Config.Usage);
3053          Free (Config.Help);
3054          Free (Config.Help_Msg);
3055
3056          if Config.Aliases /= null then
3057             for A in Config.Aliases'Range loop
3058                Free (Config.Aliases (A).Alias);
3059                Free (Config.Aliases (A).Expansion);
3060                Free (Config.Aliases (A).Section);
3061             end loop;
3062
3063             Unchecked_Free (Config.Aliases);
3064          end if;
3065
3066          if Config.Switches /= null then
3067             for S in Config.Switches'Range loop
3068                Free (Config.Switches (S).Switch);
3069                Free (Config.Switches (S).Long_Switch);
3070                Free (Config.Switches (S).Help);
3071                Free (Config.Switches (S).Section);
3072             end loop;
3073
3074             Unchecked_Free (Config.Switches);
3075          end if;
3076
3077          Unchecked_Free (Config);
3078       end if;
3079    end Free;
3080
3081    ----------
3082    -- Free --
3083    ----------
3084
3085    procedure Free (Cmd : in out Command_Line) is
3086    begin
3087       Free (Cmd.Expanded);
3088       Free (Cmd.Coalesce);
3089       Free (Cmd.Coalesce_Sections);
3090       Free (Cmd.Coalesce_Params);
3091       Free (Cmd.Params);
3092       Free (Cmd.Sections);
3093    end Free;
3094
3095    ---------------
3096    -- Set_Usage --
3097    ---------------
3098
3099    procedure Set_Usage
3100      (Config   : in out Command_Line_Configuration;
3101       Usage    : String := "[switches] [arguments]";
3102       Help     : String := "";
3103       Help_Msg : String := "")
3104    is
3105    begin
3106       if Config = null then
3107          Config := new Command_Line_Configuration_Record;
3108       end if;
3109
3110       Free (Config.Usage);
3111       Free (Config.Help);
3112       Free (Config.Help_Msg);
3113
3114       Config.Usage    := new String'(Usage);
3115       Config.Help     := new String'(Help);
3116       Config.Help_Msg := new String'(Help_Msg);
3117    end Set_Usage;
3118
3119    ------------------
3120    -- Display_Help --
3121    ------------------
3122
3123    procedure Display_Help (Config : Command_Line_Configuration) is
3124       function Switch_Name
3125         (Def     : Switch_Definition;
3126          Section : String) return String;
3127       --  Return the "-short, --long=ARG" string for Def.
3128       --  Returns "" if the switch is not in the section.
3129
3130       function Param_Name
3131         (P    : Switch_Parameter_Type;
3132          Name : String := "ARG") return String;
3133       --  Return the display for a switch parameter
3134
3135       procedure Display_Section_Help (Section : String);
3136       --  Display the help for a specific section ("" is the default section)
3137
3138       --------------------------
3139       -- Display_Section_Help --
3140       --------------------------
3141
3142       procedure Display_Section_Help (Section : String) is
3143          Max_Len : Natural := 0;
3144
3145       begin
3146          --  ??? Special display for "*"
3147
3148          New_Line;
3149
3150          if Section /= "" then
3151             Put_Line ("Switches after " & Section);
3152          end if;
3153
3154          --  Compute size of the switches column
3155
3156          for S in Config.Switches'Range loop
3157             Max_Len := Natural'Max
3158               (Max_Len, Switch_Name (Config.Switches (S), Section)'Length);
3159          end loop;
3160
3161          if Config.Aliases /= null then
3162             for A in Config.Aliases'Range loop
3163                if Config.Aliases (A).Section.all = Section then
3164                   Max_Len := Natural'Max
3165                     (Max_Len, Config.Aliases (A).Alias'Length);
3166                end if;
3167             end loop;
3168          end if;
3169
3170          --  Display the switches
3171
3172          for S in Config.Switches'Range loop
3173             declare
3174                N : constant String :=
3175                      Switch_Name (Config.Switches (S), Section);
3176
3177             begin
3178                if N /= "" then
3179                   Put (" ");
3180                   Put (N);
3181                   Put ((1 .. Max_Len - N'Length + 1 => ' '));
3182
3183                   if Config.Switches (S).Help /= null then
3184                      Put (Config.Switches (S).Help.all);
3185                   end if;
3186
3187                   New_Line;
3188                end if;
3189             end;
3190          end loop;
3191
3192          --  Display the aliases
3193
3194          if Config.Aliases /= null then
3195             for A in Config.Aliases'Range loop
3196                if Config.Aliases (A).Section.all = Section then
3197                   Put (" ");
3198                   Put (Config.Aliases (A).Alias.all);
3199                   Put ((1 .. Max_Len - Config.Aliases (A).Alias'Length + 1
3200                        => ' '));
3201                   Put ("Equivalent to " & Config.Aliases (A).Expansion.all);
3202                   New_Line;
3203                end if;
3204             end loop;
3205          end if;
3206       end Display_Section_Help;
3207
3208       ----------------
3209       -- Param_Name --
3210       ----------------
3211
3212       function Param_Name
3213         (P    : Switch_Parameter_Type;
3214          Name : String := "ARG") return String
3215       is
3216       begin
3217          case P is
3218             when Parameter_None =>
3219                return "";
3220
3221             when Parameter_With_Optional_Space =>
3222                return " " & To_Upper (Name);
3223
3224             when Parameter_With_Space_Or_Equal =>
3225                return "=" & To_Upper (Name);
3226
3227             when Parameter_No_Space =>
3228                return To_Upper (Name);
3229
3230             when Parameter_Optional =>
3231                return '[' & To_Upper (Name) & ']';
3232          end case;
3233       end Param_Name;
3234
3235       -----------------
3236       -- Switch_Name --
3237       -----------------
3238
3239       function Switch_Name
3240         (Def     : Switch_Definition;
3241          Section : String) return String
3242       is
3243          use Ada.Strings.Unbounded;
3244          Result       : Unbounded_String;
3245          P1, P2       : Switch_Parameter_Type;
3246          Last1, Last2 : Integer := 0;
3247
3248       begin
3249          if (Section = "" and then Def.Section = null)
3250            or else (Def.Section /= null and then Def.Section.all = Section)
3251          then
3252             if Def.Switch /= null and then Def.Switch.all = "*" then
3253                return "[any switch]";
3254             end if;
3255
3256             if Def.Switch /= null then
3257                Decompose_Switch (Def.Switch.all, P1, Last1);
3258                Append (Result, Def.Switch (Def.Switch'First .. Last1));
3259
3260                if Def.Long_Switch /= null then
3261                   Decompose_Switch (Def.Long_Switch.all, P2, Last2);
3262                   Append (Result, ", "
3263                           & Def.Long_Switch (Def.Long_Switch'First .. Last2));
3264
3265                   if Def.Argument = null then
3266                      Append (Result, Param_Name (P2, "ARG"));
3267                   else
3268                      Append (Result, Param_Name (P2, Def.Argument.all));
3269                   end if;
3270
3271                else
3272                   if Def.Argument = null then
3273                      Append (Result, Param_Name (P1, "ARG"));
3274                   else
3275                      Append (Result, Param_Name (P1, Def.Argument.all));
3276                   end if;
3277                end if;
3278
3279             --  Def.Switch is null (Long_Switch must be non-null)
3280
3281             else
3282                Decompose_Switch (Def.Long_Switch.all, P2, Last2);
3283                Append (Result,
3284                        Def.Long_Switch (Def.Long_Switch'First .. Last2));
3285
3286                if Def.Argument = null then
3287                   Append (Result, Param_Name (P2, "ARG"));
3288                else
3289                   Append (Result, Param_Name (P2, Def.Argument.all));
3290                end if;
3291             end if;
3292          end if;
3293
3294          return To_String (Result);
3295       end Switch_Name;
3296
3297    --  Start of processing for Display_Help
3298
3299    begin
3300       if Config = null then
3301          return;
3302       end if;
3303
3304       if Config.Help /= null and then Config.Help.all /= "" then
3305          Put_Line (Config.Help.all);
3306       end if;
3307
3308       if Config.Usage /= null then
3309          Put_Line ("Usage: "
3310                    & Base_Name
3311                      (Ada.Command_Line.Command_Name) & " " & Config.Usage.all);
3312       else
3313          Put_Line ("Usage: " & Base_Name (Ada.Command_Line.Command_Name)
3314                    & " [switches] [arguments]");
3315       end if;
3316
3317       if Config.Help_Msg /= null and then Config.Help_Msg.all /= "" then
3318          Put_Line (Config.Help_Msg.all);
3319
3320       else
3321          Display_Section_Help ("");
3322
3323          if Config.Sections /= null and then Config.Switches /= null then
3324             for S in Config.Sections'Range loop
3325                Display_Section_Help (Config.Sections (S).all);
3326             end loop;
3327          end if;
3328       end if;
3329    end Display_Help;
3330
3331    ------------
3332    -- Getopt --
3333    ------------
3334
3335    procedure Getopt
3336      (Config      : Command_Line_Configuration;
3337       Callback    : Switch_Handler := null;
3338       Parser      : Opt_Parser := Command_Line_Parser;
3339       Concatenate : Boolean := True)
3340    is
3341       Getopt_Switches : String_Access;
3342       C               : Character := ASCII.NUL;
3343
3344       Empty_Name      : aliased constant String := "";
3345       Current_Section : Integer := -1;
3346       Section_Name    : not null access constant String := Empty_Name'Access;
3347
3348       procedure Simple_Callback
3349         (Simple_Switch : String;
3350          Separator     : String;
3351          Parameter     : String;
3352          Index         : Integer);
3353       --  Needs comments ???
3354
3355       procedure Do_Callback (Switch, Parameter : String; Index : Integer);
3356
3357       -----------------
3358       -- Do_Callback --
3359       -----------------
3360
3361       procedure Do_Callback (Switch, Parameter : String; Index : Integer) is
3362       begin
3363          --  Do automatic handling when possible
3364
3365          if Index /= -1 then
3366             case Config.Switches (Index).Typ is
3367                when Switch_Untyped =>
3368                   null;   --  no automatic handling
3369
3370                when Switch_Boolean =>
3371                   Config.Switches (Index).Boolean_Output.all :=
3372                     Config.Switches (Index).Boolean_Value;
3373                   return;
3374
3375                when Switch_Integer =>
3376                   begin
3377                      if Parameter = "" then
3378                         Config.Switches (Index).Integer_Output.all :=
3379                           Config.Switches (Index).Integer_Default;
3380                      else
3381                         Config.Switches (Index).Integer_Output.all :=
3382                           Integer'Value (Parameter);
3383                      end if;
3384
3385                   exception
3386                      when Constraint_Error =>
3387                         raise Invalid_Parameter
3388                           with "Expected integer parameter for '"
3389                             & Switch & "'";
3390                   end;
3391
3392                   return;
3393
3394                when Switch_String =>
3395                   Free (Config.Switches (Index).String_Output.all);
3396                   Config.Switches (Index).String_Output.all :=
3397                     new String'(Parameter);
3398                   return;
3399
3400             end case;
3401          end if;
3402
3403          --  Otherwise calls the user callback if one was defined
3404
3405          if Callback /= null then
3406             Callback (Switch    => Switch,
3407                       Parameter => Parameter,
3408                       Section   => Section_Name.all);
3409          end if;
3410       end Do_Callback;
3411
3412       procedure For_Each_Simple
3413         is new For_Each_Simple_Switch (Simple_Callback);
3414
3415       ---------------------
3416       -- Simple_Callback --
3417       ---------------------
3418
3419       procedure Simple_Callback
3420         (Simple_Switch : String;
3421          Separator     : String;
3422          Parameter     : String;
3423          Index         : Integer)
3424       is
3425          pragma Unreferenced (Separator);
3426       begin
3427          Do_Callback (Switch    => Simple_Switch,
3428                       Parameter => Parameter,
3429                       Index     => Index);
3430       end Simple_Callback;
3431
3432    --  Start of processing for Getopt
3433
3434    begin
3435       --  Initialize sections
3436
3437       if Config.Sections = null then
3438          Config.Sections := new Argument_List'(1 .. 0 => null);
3439       end if;
3440
3441       Internal_Initialize_Option_Scan
3442         (Parser                   => Parser,
3443          Switch_Char              => Parser.Switch_Character,
3444          Stop_At_First_Non_Switch => Parser.Stop_At_First,
3445          Section_Delimiters       => Section_Delimiters (Config));
3446
3447       Getopt_Switches := new String'
3448         (Get_Switches (Config, Parser.Switch_Character, Section_Name.all)
3449          & " h -help");
3450
3451       --  Initialize output values for automatically handled switches
3452
3453       for S in Config.Switches'Range loop
3454          case Config.Switches (S).Typ is
3455             when Switch_Untyped =>
3456                null;   --  Nothing to do
3457
3458             when Switch_Boolean =>
3459                Config.Switches (S).Boolean_Output.all :=
3460                  not Config.Switches (S).Boolean_Value;
3461
3462             when Switch_Integer =>
3463                Config.Switches (S).Integer_Output.all :=
3464                  Config.Switches (S).Integer_Initial;
3465
3466             when Switch_String =>
3467                if Config.Switches (S).String_Output.all = null then
3468                   Config.Switches (S).String_Output.all := new String'("");
3469                end if;
3470          end case;
3471       end loop;
3472
3473       --  For all sections, and all switches within those sections
3474
3475       loop
3476          C := Getopt (Switches    => Getopt_Switches.all,
3477                       Concatenate => Concatenate,
3478                       Parser      => Parser);
3479
3480          if C = '*' then
3481             --  Full_Switch already includes the leading '-'
3482
3483             Do_Callback (Switch    => Full_Switch (Parser),
3484                          Parameter => Parameter (Parser),
3485                          Index     => -1);
3486
3487          elsif C /= ASCII.NUL then
3488             if Full_Switch (Parser) = "h"
3489                  or else
3490                Full_Switch (Parser) = "-help"
3491             then
3492                Display_Help (Config);
3493                raise Exit_From_Command_Line;
3494             end if;
3495
3496             --  Do switch expansion if needed
3497
3498             For_Each_Simple
3499               (Config,
3500                Section   => Section_Name.all,
3501                Switch    => Parser.Switch_Character & Full_Switch (Parser),
3502                Parameter => Parameter (Parser));
3503
3504          else
3505             if Current_Section = -1 then
3506                Current_Section := Config.Sections'First;
3507             else
3508                Current_Section := Current_Section + 1;
3509             end if;
3510
3511             exit when Current_Section > Config.Sections'Last;
3512
3513             Section_Name := Config.Sections (Current_Section);
3514             Goto_Section (Section_Name.all, Parser);
3515
3516             Free (Getopt_Switches);
3517             Getopt_Switches := new String'
3518               (Get_Switches
3519                  (Config, Parser.Switch_Character, Section_Name.all));
3520          end if;
3521       end loop;
3522
3523       Free (Getopt_Switches);
3524
3525    exception
3526       when Invalid_Switch =>
3527          Free (Getopt_Switches);
3528
3529          --  Message inspired by "ls" on Unix
3530
3531          Put_Line (Standard_Error,
3532                    Base_Name (Ada.Command_Line.Command_Name)
3533                    & ": unrecognized option '"
3534                    & Full_Switch (Parser)
3535                    & "'");
3536          Try_Help;
3537
3538          raise;
3539
3540       when others =>
3541          Free (Getopt_Switches);
3542          raise;
3543    end Getopt;
3544
3545    -----------
3546    -- Build --
3547    -----------
3548
3549    procedure Build
3550      (Line        : in out Command_Line;
3551       Args        : out GNAT.OS_Lib.Argument_List_Access;
3552       Expanded    : Boolean := False;
3553       Switch_Char : Character := '-')
3554    is
3555       Iter  : Command_Line_Iterator;
3556       Count : Natural := 0;
3557
3558    begin
3559       Start (Line, Iter, Expanded => Expanded);
3560       while Has_More (Iter) loop
3561          if Is_New_Section (Iter) then
3562             Count := Count + 1;
3563          end if;
3564
3565          Count := Count + 1;
3566          Next (Iter);
3567       end loop;
3568
3569       Args := new Argument_List (1 .. Count);
3570       Count := Args'First;
3571
3572       Start (Line, Iter, Expanded => Expanded);
3573       while Has_More (Iter) loop
3574          if Is_New_Section (Iter) then
3575             Args (Count) := new String'(Switch_Char & Current_Section (Iter));
3576             Count := Count + 1;
3577          end if;
3578
3579          Args (Count) := new String'(Current_Switch (Iter)
3580                                      & Current_Separator (Iter)
3581                                      & Current_Parameter (Iter));
3582          Count := Count + 1;
3583          Next (Iter);
3584       end loop;
3585    end Build;
3586
3587    --------------
3588    -- Try_Help --
3589    --------------
3590
3591    --  Note: Any change to the message displayed should also be done in
3592    --  gnatbind.adb that does not use this interface.
3593
3594    procedure Try_Help is
3595    begin
3596       Put_Line
3597         (Standard_Error,
3598          "try """ & Base_Name (Ada.Command_Line.Command_Name)
3599          & " --help"" for more information.");
3600    end Try_Help;
3601
3602 end GNAT.Command_Line;