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