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 --                            $Revision: 1.21 $
  10 --                                                                          --
  11 --          Copyright (C) 1999-2001 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- As a special exception,  if other files  instantiate  generics from this --
  25 -- unit, or you link  this unit with other files  to produce an executable, --
  26 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  27 -- covered  by the  GNU  General  Public  License.  This exception does not --
  28 -- however invalidate  any other reasons why  the executable file  might be --
  29 -- covered by the  GNU Public License.                                      --
  30 --                                                                          --
  31 -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com).   --
  32 --                                                                          --
  33 ------------------------------------------------------------------------------
  34
  35 with Ada.Command_Line;
  36
  37 package body GNAT.Command_Line is
  38
  39    package CL renames Ada.Command_Line;
  40
  41    type Section_Number is new Natural range 0 .. 65534;
  42    for Section_Number'Size use 16;
  43
  44    type Parameter_Type is
  45       record
  46          Arg_Num : Positive;
  47          First   : Positive;
  48          Last    : Positive;
  49       end record;
  50    The_Parameter : Parameter_Type;
  51    The_Switch    : Parameter_Type;
  52    --  This type and this variable are provided to store the current switch
  53    --  and parameter
  54
  55    type Is_Switch_Type is array (1 .. CL.Argument_Count) of Boolean;
  56    pragma Pack (Is_Switch_Type);
  57
  58    Is_Switch : Is_Switch_Type := (others => False);
  59    --  Indicates wich arguments on the command line are considered not be
  60    --  switches or parameters to switches (this leaves e.g. the filenames...)
  61
  62    type Section_Type is array (1 .. CL.Argument_Count + 1) of Section_Number;
  63    pragma Pack (Section_Type);
  64    Section : Section_Type := (others => 1);
  65    --  Contains the number of the section associated with the current
  66    --  switch.  If this number is 0, then it is a section delimiter, which
  67    --  is never returns by GetOpt.
  68    --  The last element of this array is set to 0 to avoid the need to test for
  69    --  if we have reached the end of the command line in loops.
  70
  71    Current_Argument : Natural := 1;
  72    --  Number of the current argument parsed on the command line
  73
  74    Current_Index : Natural := 1;
  75    --  Index in the current argument of the character to be processed
  76
  77    Current_Section : Section_Number := 1;
  78
  79    Expansion_It : aliased Expansion_Iterator;
  80    --  When Get_Argument is expanding a file name, this is the iterator used
  81
  82    In_Expansion : Boolean := False;
  83    --  True if we are expanding a file
  84
  85    Switch_Character : Character := '-';
  86    --  The character at the beginning of the command line arguments,
  87    --  indicating the beginning of a switch
  88
  89    Stop_At_First : Boolean := False;
  90    --  If it is True then Getopt stops at the first non-switch argument
  91
  92    procedure Set_Parameter
  93      (Variable : out Parameter_Type;
  94       Arg_Num  : Positive;
  95       First    : Positive;
  96       Last     : Positive);
  97    pragma Inline (Set_Parameter);
  98    --  Set the parameter that will be returned by Parameter below
  99
 100    function Goto_Next_Argument_In_Section return Boolean;
 101    --  Go to the next argument on the command line. If we are at the end
 102    --  of the current section, we want to make sure there is no other
 103    --  identical section on the command line (there might be multiple
 104    --  instances of -largs).
 105    --  Return True if there as another argument, False otherwise
 106
 107    ---------------
 108    -- Expansion --
 109    ---------------
 110
 111    function Expansion (Iterator : Expansion_Iterator) return String is
 112       use GNAT.Directory_Operations;
 113       type Pointer is access all Expansion_Iterator;
 114
 115       S    : String (1 .. 1024);
 116       Last : Natural;
 117       It   : Pointer := Iterator'Unrestricted_Access;
 118
 119    begin
 120       loop
 121          Read (It.Dir, S, Last);
 122
 123          if Last = 0 then
 124             Close (It.Dir);
 125             return String'(1 .. 0 => ' ');
 126          end if;
 127
 128          if GNAT.Regexp.Match (S (1 .. Last), Iterator.Regexp) then
 129             return S (1 .. Last);
 130          end if;
 131
 132       end loop;
 133
 134       return String'(1 .. 0 => ' ');
 135    end Expansion;
 136
 137    -----------------
 138    -- Full_Switch --
 139    -----------------
 140
 141    function Full_Switch return String is
 142    begin
 143       return CL.Argument (The_Switch.Arg_Num)
 144         (The_Switch.First .. The_Switch.Last);
 145    end Full_Switch;
 146
 147    ------------------
 148    -- Get_Argument --
 149    ------------------
 150
 151    function Get_Argument (Do_Expansion : Boolean := False) return String is
 152       Total : constant Natural := CL.Argument_Count;
 153
 154    begin
 155       if In_Expansion then
 156          declare
 157             S : String := Expansion (Expansion_It);
 158          begin
 159             if S'Length /= 0 then
 160                return S;
 161             else
 162                In_Expansion := False;
 163             end if;
 164
 165          end;
 166       end if;
 167
 168       if Current_Argument > Total then
 169
 170          --  If this is the first time this function is called
 171
 172          if Current_Index = 1 then
 173             Current_Argument := 1;
 174             while Current_Argument <= CL.Argument_Count
 175               and then Section (Current_Argument) /= Current_Section
 176             loop
 177                Current_Argument := Current_Argument + 1;
 178             end loop;
 179          else
 180             return String'(1 .. 0 => ' ');
 181          end if;
 182
 183       elsif Section (Current_Argument) = 0 then
 184          while Current_Argument <= CL.Argument_Count
 185            and then Section (Current_Argument) /= Current_Section
 186          loop
 187             Current_Argument := Current_Argument + 1;
 188          end loop;
 189       end if;
 190
 191       Current_Index := 2;
 192
 193       while Current_Argument <= Total
 194         and then Is_Switch (Current_Argument)
 195       loop
 196          Current_Argument := Current_Argument + 1;
 197       end loop;
 198
 199       if Current_Argument > Total then
 200          return String'(1 .. 0 => ' ');
 201       end if;
 202
 203       if Section (Current_Argument) = 0 then
 204          return Get_Argument (Do_Expansion);
 205       end if;
 206
 207       Current_Argument := Current_Argument + 1;
 208
 209       --  Could it be a file name with wild cards to expand ?
 210
 211       if Do_Expansion then
 212          declare
 213             Arg       : String renames CL.Argument (Current_Argument - 1);
 214             Index     : Positive := Arg'First;
 215
 216          begin
 217             while Index <= Arg'Last loop
 218
 219                if Arg (Index) = '*'
 220                  or else Arg (Index) = '?'
 221                  or else Arg (Index) = '['
 222                then
 223                   In_Expansion := True;
 224                   Start_Expansion (Expansion_It, Arg);
 225                   return Get_Argument (Do_Expansion);
 226                end if;
 227
 228                Index := Index + 1;
 229             end loop;
 230          end;
 231       end if;
 232
 233       return CL.Argument (Current_Argument - 1);
 234    end Get_Argument;
 235
 236    ------------
 237    -- Getopt --
 238    ------------
 239
 240    function Getopt (Switches : String) return Character is
 241       Dummy          : Boolean;
 242
 243    begin
 244       --  If we have finished to parse the current command line item (there
 245       --  might be multiple switches in a single item), then go to the next
 246       --  element
 247
 248       if Current_Argument > CL.Argument_Count
 249         or else (Current_Index > CL.Argument (Current_Argument)'Last
 250                  and then not Goto_Next_Argument_In_Section)
 251       then
 252          return ASCII.NUL;
 253       end if;
 254
 255       --  If we are on a new item, test if this might be a switch
 256
 257       if Current_Index = 1 then
 258          if CL.Argument (Current_Argument)(1) /= Switch_Character then
 259             if Switches (Switches'First) = '*' then
 260                Set_Parameter (The_Switch,
 261                               Arg_Num => Current_Argument,
 262                               First   => 1,
 263                               Last    => CL.Argument (Current_Argument)'Last);
 264                Is_Switch (Current_Argument) := True;
 265                Dummy := Goto_Next_Argument_In_Section;
 266                return '*';
 267             end if;
 268
 269             if Stop_At_First then
 270                Current_Argument := Positive'Last;
 271                return ASCII.NUL;
 272
 273             elsif not Goto_Next_Argument_In_Section then
 274                return ASCII.NUL;
 275
 276             else
 277                return Getopt (Switches);
 278             end if;
 279          end if;
 280
 281          Current_Index := 2;
 282          Is_Switch (Current_Argument) := True;
 283       end if;
 284
 285       declare
 286          Arg            : String renames CL.Argument (Current_Argument);
 287          Index_Switches : Natural := 0;
 288          Max_Length     : Natural := 0;
 289          Index          : Natural := Switches'First;
 290          Length         : Natural := 1;
 291          End_Index      : Natural;
 292
 293       begin
 294          while Index <= Switches'Last loop
 295
 296             --  Search the length of the parameter at this position in Switches
 297
 298             Length := Index;
 299             while Length <= Switches'Last
 300               and then Switches (Length) /= ' '
 301             loop
 302                Length := Length + 1;
 303             end loop;
 304
 305             if (Switches (Length - 1) = ':'
 306                 or else Switches (Length - 1) = '?'
 307                 or else Switches (Length - 1) = '!')
 308               and then Length > Index + 1
 309             then
 310                Length := Length - 1;
 311             end if;
 312
 313             --  If it is the one we searched, it may be a candidate
 314
 315             if Current_Index + Length - 1 - Index <= Arg'Last
 316               and then
 317               Switches (Index .. Length - 1) =
 318               Arg (Current_Index .. Current_Index + Length - 1 - Index)
 319               and then Length - Index > Max_Length
 320             then
 321                Index_Switches := Index;
 322                Max_Length     := Length - Index;
 323             end if;
 324
 325             --  Look for the next switch in Switches
 326             while Index <= Switches'Last
 327               and then Switches (Index) /= ' ' loop
 328                Index := Index + 1;
 329             end loop;
 330             Index := Index + 1;
 331
 332          end loop;
 333
 334          End_Index := Current_Index + Max_Length - 1;
 335
 336          --  If the switch is not accepted, skip it, unless we had a '*' in
 337          --  Switches
 338
 339          if Index_Switches = 0 then
 340             if Switches (Switches'First) = '*' then
 341                Set_Parameter (The_Switch,
 342                               Arg_Num => Current_Argument,
 343                               First   => 1,
 344                               Last    => CL.Argument (Current_Argument)'Last);
 345                Is_Switch (Current_Argument) := True;
 346                Dummy := Goto_Next_Argument_In_Section;
 347                return '*';
 348             end if;
 349
 350             Set_Parameter (The_Switch,
 351                            Arg_Num => Current_Argument,
 352                            First   => Current_Index,
 353                            Last    => Current_Index);
 354             Current_Index := Current_Index + 1;
 355             raise Invalid_Switch;
 356          end if;
 357
 358          Set_Parameter (The_Switch,
 359                         Arg_Num => Current_Argument,
 360                         First   => Current_Index,
 361                         Last    => End_Index);
 362
 363          --  If switch needs an argument
 364
 365          if Index_Switches + Max_Length <= Switches'Last then
 366
 367             case Switches (Index_Switches + Max_Length) is
 368
 369                when ':' =>
 370
 371                   if End_Index < Arg'Last then
 372                      Set_Parameter (The_Parameter,
 373                                     Arg_Num => Current_Argument,
 374                                     First   => End_Index + 1,
 375                                     Last    => Arg'Last);
 376                      Dummy := Goto_Next_Argument_In_Section;
 377
 378                   elsif Section (Current_Argument + 1) /= 0 then
 379                      Set_Parameter
 380                        (The_Parameter,
 381                         Arg_Num => Current_Argument + 1,
 382                         First   => 1,
 383                         Last    => CL.Argument (Current_Argument + 1)'Last);
 384                      Current_Argument := Current_Argument + 1;
 385                      Is_Switch (Current_Argument) := True;
 386                      Dummy := Goto_Next_Argument_In_Section;
 387
 388                   else
 389                      Current_Index := End_Index + 1;
 390                      raise Invalid_Parameter;
 391                   end if;
 392
 393                when '!' =>
 394
 395                   if End_Index < Arg'Last then
 396                      Set_Parameter (The_Parameter,
 397                                     Arg_Num => Current_Argument,
 398                                     First   => End_Index + 1,
 399                                     Last    => Arg'Last);
 400                      Dummy := Goto_Next_Argument_In_Section;
 401
 402                   else
 403                      Current_Index := End_Index + 1;
 404                      raise Invalid_Parameter;
 405                   end if;
 406
 407                when '?' =>
 408
 409                   if End_Index < Arg'Last then
 410                      Set_Parameter (The_Parameter,
 411                                     Arg_Num => Current_Argument,
 412                                     First   => End_Index + 1,
 413                                     Last    => Arg'Last);
 414
 415                   else
 416                      Set_Parameter (The_Parameter,
 417                                     Arg_Num => Current_Argument,
 418                                     First   => 2,
 419                                     Last    => 1);
 420                   end if;
 421                   Dummy := Goto_Next_Argument_In_Section;
 422
 423                when others =>
 424
 425                   Current_Index := End_Index + 1;
 426
 427             end case;
 428          else
 429             Current_Index := End_Index + 1;
 430          end if;
 431
 432          return Switches (Index_Switches);
 433       end;
 434    end Getopt;
 435
 436    -----------------------------------
 437    -- Goto_Next_Argument_In_Section --
 438    -----------------------------------
 439
 440    function Goto_Next_Argument_In_Section return Boolean is
 441    begin
 442       Current_Index := 1;
 443       Current_Argument := Current_Argument + 1;
 444
 445       if Section (Current_Argument) = 0 then
 446          loop
 447             if Current_Argument > CL.Argument_Count then
 448                return False;
 449             end if;
 450             Current_Argument := Current_Argument + 1;
 451             exit when Section (Current_Argument) = Current_Section;
 452          end loop;
 453       end if;
 454       return True;
 455    end Goto_Next_Argument_In_Section;
 456
 457    ------------------
 458    -- Goto_Section --
 459    ------------------
 460
 461    procedure Goto_Section (Name : String := "") is
 462       Index : Integer := 1;
 463
 464    begin
 465       In_Expansion := False;
 466
 467       if Name = "" then
 468          Current_Argument := 1;
 469          Current_Index    := 1;
 470          Current_Section  := 1;
 471          return;
 472       end if;
 473
 474       while Index <= CL.Argument_Count loop
 475
 476          if Section (Index) = 0
 477            and then CL.Argument (Index) = Switch_Character & Name
 478          then
 479             Current_Argument := Index + 1;
 480             Current_Index    := 1;
 481             if Current_Argument <= CL.Argument_Count then
 482                Current_Section := Section (Current_Argument);
 483             end if;
 484             return;
 485          end if;
 486
 487          Index := Index + 1;
 488       end loop;
 489       Current_Argument := Positive'Last;
 490       Current_Index := 2;   --  so that Get_Argument returns nothing
 491    end Goto_Section;
 492
 493    ----------------------------
 494    -- Initialize_Option_Scan --
 495    ----------------------------
 496
 497    procedure Initialize_Option_Scan
 498      (Switch_Char              : Character := '-';
 499       Stop_At_First_Non_Switch : Boolean := False;
 500       Section_Delimiters       : String := "")
 501    is
 502       Section_Num     : Section_Number := 1;
 503       Section_Index   : Integer        := Section_Delimiters'First;
 504       Last            : Integer;
 505       Delimiter_Found : Boolean;
 506
 507    begin
 508       Current_Argument := 0;
 509       Current_Index := 0;
 510       In_Expansion := False;
 511       Switch_Character := Switch_Char;
 512       Stop_At_First := Stop_At_First_Non_Switch;
 513
 514       --  If we are using sections, we have to preprocess the command line
 515       --  to delimit them. A section can be repeated, so we just give each
 516       --  item on the command line a section number
 517
 518       while Section_Index <= Section_Delimiters'Last loop
 519
 520          Last := Section_Index;
 521          while Last <= Section_Delimiters'Last
 522            and then Section_Delimiters (Last) /= ' '
 523          loop
 524             Last := Last + 1;
 525          end loop;
 526
 527          Delimiter_Found := False;
 528          Section_Num := Section_Num + 1;
 529
 530          for Index in 1 .. CL.Argument_Count loop
 531             if CL.Argument (Index)(1) = Switch_Character
 532               and then CL.Argument (Index) = Switch_Character
 533               & Section_Delimiters (Section_Index .. Last - 1)
 534             then
 535                Section (Index) := 0;
 536                Delimiter_Found := True;
 537
 538             elsif Section (Index) = 0 then
 539                Delimiter_Found := False;
 540
 541             elsif Delimiter_Found then
 542                Section (Index) := Section_Num;
 543             end if;
 544          end loop;
 545
 546          Section_Index := Last + 1;
 547          while Section_Index <= Section_Delimiters'Last
 548            and then Section_Delimiters (Section_Index) = ' '
 549          loop
 550             Section_Index := Section_Index + 1;
 551          end loop;
 552       end loop;
 553
 554       Delimiter_Found := Goto_Next_Argument_In_Section;
 555    end Initialize_Option_Scan;
 556
 557    ---------------
 558    -- Parameter --
 559    ---------------
 560
 561    function Parameter return String is
 562    begin
 563       if The_Parameter.First > The_Parameter.Last then
 564          return String'(1 .. 0 => ' ');
 565       else
 566          return CL.Argument (The_Parameter.Arg_Num)
 567            (The_Parameter.First .. The_Parameter.Last);
 568       end if;
 569    end Parameter;
 570
 571    -------------------
 572    -- Set_Parameter --
 573    -------------------
 574
 575    procedure Set_Parameter
 576      (Variable : out Parameter_Type;
 577       Arg_Num  : Positive;
 578       First    : Positive;
 579       Last     : Positive) is
 580    begin
 581       Variable.Arg_Num := Arg_Num;
 582       Variable.First   := First;
 583       Variable.Last    := Last;
 584    end Set_Parameter;
 585
 586    ---------------------
 587    -- Start_Expansion --
 588    ---------------------
 589
 590    procedure Start_Expansion
 591      (Iterator     : out Expansion_Iterator;
 592       Pattern      : String;
 593       Directory    : String := "";
 594       Basic_Regexp : Boolean := True)
 595    is
 596       Directory_Separator : Character;
 597       pragma Import (C, Directory_Separator, "__gnat_dir_separator");
 598
 599    begin
 600       if Directory = "" then
 601          GNAT.Directory_Operations.Open
 602            (Iterator.Dir, "." & Directory_Separator);
 603       else
 604          GNAT.Directory_Operations.Open (Iterator.Dir, Directory);
 605       end if;
 606
 607       Iterator.Regexp := GNAT.Regexp.Compile (Pattern, Basic_Regexp, True);
 608    end Start_Expansion;
 609
 610 begin
 611    Section (CL.Argument_Count + 1) := 0;
 612 end GNAT.Command_Line;