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