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-2004 Free Software Foundation, Inc.          --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 with Ada.Command_Line;
  35 with GNAT.OS_Lib; use GNAT.OS_Lib;
  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 record
  45       Arg_Num : Positive;
  46       First   : Positive;
  47       Last    : Positive;
  48    end record;
  49    The_Parameter : Parameter_Type;
  50    The_Switch    : Parameter_Type;
  51    --  This type and this variable are provided to store the current switch
  52    --  and parameter
  53
  54    type Is_Switch_Type is array (1 .. CL.Argument_Count) of Boolean;
  55    pragma Pack (Is_Switch_Type);
  56
  57    Is_Switch : Is_Switch_Type := (others => False);
  58    --  Indicates wich arguments on the command line are considered not be
  59    --  switches or parameters to switches (this leaves e.g. the filenames...)
  60
  61    type Section_Type is array (1 .. CL.Argument_Count + 1) of Section_Number;
  62    pragma Pack (Section_Type);
  63    Section : Section_Type := (others => 1);
  64    --  Contains the number of the section associated with the current
  65    --  switch.  If this number is 0, then it is a section delimiter, which
  66    --  is never returns by GetOpt.
  67    --  The last element of this array is set to 0 to avoid the need to test for
  68    --  if we have reached the end of the command line in loops.
  69
  70    Current_Argument : Natural := 1;
  71    --  Number of the current argument parsed on the command line
  72
  73    Current_Index : Natural := 1;
  74    --  Index in the current argument of the character to be processed
  75
  76    Current_Section : Section_Number := 1;
  77
  78    Expansion_It : aliased Expansion_Iterator;
  79    --  When Get_Argument is expanding a file name, this is the iterator used
  80
  81    In_Expansion : Boolean := False;
  82    --  True if we are expanding a file
  83
  84    Switch_Character : Character := '-';
  85    --  The character at the beginning of the command line arguments,
  86    --  indicating the beginning of a switch
  87
  88    Stop_At_First : Boolean := False;
  89    --  If it is True then Getopt stops at the first non-switch argument
  90
  91    procedure Set_Parameter
  92      (Variable : out Parameter_Type;
  93       Arg_Num  : Positive;
  94       First    : Positive;
  95       Last     : Positive);
  96    pragma Inline (Set_Parameter);
  97    --  Set the parameter that will be returned by Parameter below
  98
  99    function Goto_Next_Argument_In_Section return Boolean;
 100    --  Go to the next argument on the command line. If we are at the end
 101    --  of the current section, we want to make sure there is no other
 102    --  identical section on the command line (there might be multiple
 103    --  instances of -largs). Returns True iff there is another argument.
 104
 105    function Get_File_Names_Case_Sensitive return Integer;
 106    pragma Import (C, Get_File_Names_Case_Sensitive,
 107                   "__gnat_get_file_names_case_sensitive");
 108    File_Names_Case_Sensitive : constant Boolean :=
 109                                  Get_File_Names_Case_Sensitive /= 0;
 110
 111    procedure Canonical_Case_File_Name (S : in out String);
 112    --  Given a file name, converts it to canonical case form. For systems
 113    --  where file names are case sensitive, this procedure has no effect.
 114    --  If file names are not case sensitive (i.e. for example if you have
 115    --  the file "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then
 116    --  this call converts the given string to canonical all lower case form,
 117    --  so that two file names compare equal if they refer to the same file.
 118
 119    ------------------------------
 120    -- Canonical_Case_File_Name --
 121    ------------------------------
 122
 123    procedure Canonical_Case_File_Name (S : in out String) is
 124    begin
 125       if not File_Names_Case_Sensitive then
 126          for J in S'Range loop
 127             if S (J) in 'A' .. 'Z' then
 128                S (J) := Character'Val (
 129                           Character'Pos (S (J)) +
 130                           Character'Pos ('a')   -
 131                           Character'Pos ('A'));
 132             end if;
 133          end loop;
 134       end if;
 135    end Canonical_Case_File_Name;
 136
 137    ---------------
 138    -- Expansion --
 139    ---------------
 140
 141    function Expansion (Iterator : Expansion_Iterator) return String is
 142       use GNAT.Directory_Operations;
 143       type Pointer is access all Expansion_Iterator;
 144
 145       S    : String (1 .. 1024);
 146       Last : Natural;
 147       It   : constant Pointer := Iterator'Unrestricted_Access;
 148
 149       Current : Depth := It.Current_Depth;
 150       NL      : Positive;
 151
 152    begin
 153       --  It is assumed that a directory is opened at the current level;
 154       --  otherwise, GNAT.Directory_Operations.Directory_Error will be raised
 155       --  at the first call to Read.
 156
 157       loop
 158          Read (It.Levels (Current).Dir, S, Last);
 159
 160          --  If we have exhausted the directory, close it and go back one level
 161
 162          if Last = 0 then
 163             Close (It.Levels (Current).Dir);
 164
 165             --  If we are at level 1, we are finished; return an empty string.
 166
 167             if Current = 1 then
 168                return String'(1 .. 0 => ' ');
 169             else
 170                --  Otherwise, continue with the directory at the previous level
 171
 172                Current := Current - 1;
 173                It.Current_Depth := Current;
 174             end if;
 175
 176          --  If this is a directory, that is neither "." or "..", attempt to
 177          --  go to the next level.
 178
 179          elsif Is_Directory
 180            (It.Dir_Name (1 .. It.Levels (Current).Name_Last) & S (1 .. Last))
 181            and then S (1 .. Last) /= "."
 182            and then S (1 .. Last) /= ".."
 183          then
 184             --  We can go to the next level only if we have not reached the
 185             --  maximum depth,
 186
 187             if Current < It.Maximum_Depth then
 188                NL := It.Levels (Current).Name_Last;
 189
 190                --  And if relative path of this new directory is not too long
 191
 192                if NL + Last + 1 < Max_Path_Length then
 193                   Current := Current + 1;
 194                   It.Current_Depth := Current;
 195                   It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last);
 196                   NL := NL + Last + 1;
 197                   It.Dir_Name (NL) := Directory_Separator;
 198                   It.Levels (Current).Name_Last := NL;
 199                   Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
 200
 201                   --  Open the new directory, and read from it
 202
 203                   GNAT.Directory_Operations.Open
 204                     (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
 205                end if;
 206             end if;
 207
 208          --  If not a directory, check the relative path against the pattern
 209
 210          else
 211             declare
 212                Name : String :=
 213                  It.Dir_Name (It.Start .. It.Levels (Current).Name_Last) &
 214                  S (1 .. Last);
 215             begin
 216                Canonical_Case_File_Name (Name);
 217
 218                --  If it matches, return the relative path
 219
 220                if GNAT.Regexp.Match (Name, Iterator.Regexp) then
 221                   return Name;
 222                end if;
 223             end;
 224          end if;
 225
 226       end loop;
 227
 228       return String'(1 .. 0 => ' ');
 229    end Expansion;
 230
 231    -----------------
 232    -- Full_Switch --
 233    -----------------
 234
 235    function Full_Switch return String is
 236    begin
 237       return CL.Argument (The_Switch.Arg_Num)
 238         (The_Switch.First .. The_Switch.Last);
 239    end Full_Switch;
 240
 241    ------------------
 242    -- Get_Argument --
 243    ------------------
 244
 245    function Get_Argument (Do_Expansion : Boolean := False) return String is
 246       Total : constant Natural := CL.Argument_Count;
 247
 248    begin
 249       if In_Expansion then
 250          declare
 251             S : constant String := Expansion (Expansion_It);
 252
 253          begin
 254             if S'Length /= 0 then
 255                return S;
 256             else
 257                In_Expansion := False;
 258             end if;
 259          end;
 260       end if;
 261
 262       if Current_Argument > Total then
 263
 264          --  If this is the first time this function is called
 265
 266          if Current_Index = 1 then
 267             Current_Argument := 1;
 268             while Current_Argument <= CL.Argument_Count
 269               and then Section (Current_Argument) /= Current_Section
 270             loop
 271                Current_Argument := Current_Argument + 1;
 272             end loop;
 273          else
 274             return String'(1 .. 0 => ' ');
 275          end if;
 276
 277       elsif Section (Current_Argument) = 0 then
 278          while Current_Argument <= CL.Argument_Count
 279            and then Section (Current_Argument) /= Current_Section
 280          loop
 281             Current_Argument := Current_Argument + 1;
 282          end loop;
 283       end if;
 284
 285       Current_Index := 2;
 286
 287       while Current_Argument <= Total
 288         and then Is_Switch (Current_Argument)
 289       loop
 290          Current_Argument := Current_Argument + 1;
 291       end loop;
 292
 293       if Current_Argument > Total then
 294          return String'(1 .. 0 => ' ');
 295       end if;
 296
 297       if Section (Current_Argument) = 0 then
 298          return Get_Argument (Do_Expansion);
 299       end if;
 300
 301       Current_Argument := Current_Argument + 1;
 302
 303       --  Could it be a file name with wild cards to expand?
 304
 305       if Do_Expansion then
 306          declare
 307             Arg       : String renames CL.Argument (Current_Argument - 1);
 308             Index     : Positive := Arg'First;
 309
 310          begin
 311             while Index <= Arg'Last loop
 312
 313                if Arg (Index) = '*'
 314                  or else Arg (Index) = '?'
 315                  or else Arg (Index) = '['
 316                then
 317                   In_Expansion := True;
 318                   Start_Expansion (Expansion_It, Arg);
 319                   return Get_Argument (Do_Expansion);
 320                end if;
 321
 322                Index := Index + 1;
 323             end loop;
 324          end;
 325       end if;
 326
 327       return CL.Argument (Current_Argument - 1);
 328    end Get_Argument;
 329
 330    ------------
 331    -- Getopt --
 332    ------------
 333
 334    function Getopt
 335      (Switches    : String;
 336       Concatenate : Boolean := True) return Character
 337    is
 338       Dummy : Boolean;
 339       pragma Unreferenced (Dummy);
 340
 341    begin
 342       --  If we have finished parsing the current command line item (there
 343       --  might be multiple switches in a single item), then go to the next
 344       --  element
 345
 346       if Current_Argument > CL.Argument_Count
 347         or else (Current_Index > CL.Argument (Current_Argument)'Last
 348                    and then not Goto_Next_Argument_In_Section)
 349       then
 350          return ASCII.NUL;
 351       end if;
 352
 353       --  If we are on a new item, test if this might be a switch
 354
 355       if Current_Index = 1 then
 356          if CL.Argument (Current_Argument)(1) /= Switch_Character then
 357             if Switches (Switches'First) = '*' then
 358                Set_Parameter (The_Switch,
 359                               Arg_Num => Current_Argument,
 360                               First   => 1,
 361                               Last    => CL.Argument (Current_Argument)'Last);
 362                Is_Switch (Current_Argument) := True;
 363                Dummy := Goto_Next_Argument_In_Section;
 364                return '*';
 365             end if;
 366
 367             if Stop_At_First then
 368                Current_Argument := Positive'Last;
 369                return ASCII.NUL;
 370
 371             elsif not Goto_Next_Argument_In_Section then
 372                return ASCII.NUL;
 373
 374             else
 375                return Getopt (Switches);
 376             end if;
 377          end if;
 378
 379          Current_Index := 2;
 380          Is_Switch (Current_Argument) := True;
 381       end if;
 382
 383       declare
 384          Arg            : String renames CL.Argument (Current_Argument);
 385          Index_Switches : Natural := 0;
 386          Max_Length     : Natural := 0;
 387          Index          : Natural := Switches'First;
 388          Length         : Natural := 1;
 389          End_Index      : Natural;
 390
 391       begin
 392          while Index <= Switches'Last loop
 393
 394             --  Search the length of the parameter at this position in Switches
 395
 396             Length := Index;
 397             while Length <= Switches'Last
 398               and then Switches (Length) /= ' '
 399             loop
 400                Length := Length + 1;
 401             end loop;
 402
 403             if (Switches (Length - 1) = ':'  or else
 404                 Switches (Length - 1) = '='  or else
 405                 Switches (Length - 1) = '?'  or else
 406                 Switches (Length - 1) = '!')
 407               and then Length > Index + 1
 408             then
 409                Length := Length - 1;
 410             end if;
 411
 412             --  If it is the one we searched, it may be a candidate
 413
 414             if Current_Index + Length - 1 - Index <= Arg'Last
 415               and then
 416                 Switches (Index .. Length - 1) =
 417                   Arg (Current_Index .. Current_Index + Length - 1 - Index)
 418               and then Length - Index > Max_Length
 419             then
 420                Index_Switches := Index;
 421                Max_Length     := Length - Index;
 422             end if;
 423
 424             --  Look for the next switch in Switches
 425
 426             while Index <= Switches'Last
 427               and then Switches (Index) /= ' ' loop
 428                Index := Index + 1;
 429             end loop;
 430
 431             Index := Index + 1;
 432          end loop;
 433
 434          End_Index := Current_Index + Max_Length - 1;
 435
 436          --  If switch is not accepted, skip it, unless we had '*' in Switches
 437
 438          if Index_Switches = 0 then
 439             if Switches (Switches'First) = '*' then
 440                Set_Parameter (The_Switch,
 441                               Arg_Num => Current_Argument,
 442                               First   => 1,
 443                               Last    => CL.Argument (Current_Argument)'Last);
 444                Is_Switch (Current_Argument) := True;
 445                Dummy := Goto_Next_Argument_In_Section;
 446                return '*';
 447             end if;
 448
 449             --  Depending on the value of Concatenate, the full switch is
 450             --  a single character (True) or the rest of the argument (False).
 451
 452             if Concatenate then
 453                End_Index := Current_Index;
 454             else
 455                End_Index := Arg'Last;
 456             end if;
 457
 458             Set_Parameter (The_Switch,
 459                            Arg_Num => Current_Argument,
 460                            First   => Current_Index,
 461                            Last    => End_Index);
 462             Current_Index := End_Index + 1;
 463             raise Invalid_Switch;
 464          end if;
 465
 466          Set_Parameter (The_Switch,
 467                         Arg_Num => Current_Argument,
 468                         First   => Current_Index,
 469                         Last    => End_Index);
 470
 471          --  Case of switch needs an argument
 472
 473          if Index_Switches + Max_Length <= Switches'Last then
 474
 475             case Switches (Index_Switches + Max_Length) is
 476
 477                when ':' =>
 478
 479                   if End_Index < Arg'Last then
 480                      Set_Parameter (The_Parameter,
 481                                     Arg_Num => Current_Argument,
 482                                     First   => End_Index + 1,
 483                                     Last    => Arg'Last);
 484                      Dummy := Goto_Next_Argument_In_Section;
 485
 486                   elsif Section (Current_Argument + 1) /= 0 then
 487                      Set_Parameter
 488                        (The_Parameter,
 489                         Arg_Num => Current_Argument + 1,
 490                         First   => 1,
 491                         Last    => CL.Argument (Current_Argument + 1)'Last);
 492                      Current_Argument := Current_Argument + 1;
 493                      Is_Switch (Current_Argument) := True;
 494                      Dummy := Goto_Next_Argument_In_Section;
 495
 496                   else
 497                      Current_Index := End_Index + 1;
 498                      raise Invalid_Parameter;
 499                   end if;
 500
 501                when '=' =>
 502
 503                   --  If the switch is of the form <switch>=xxx
 504
 505                   if End_Index < Arg'Last then
 506
 507                      if Arg (End_Index + 1) = '='
 508                        and then End_Index + 1 < Arg'Last
 509                      then
 510                         Set_Parameter (The_Parameter,
 511                                        Arg_Num => Current_Argument,
 512                                        First   => End_Index + 2,
 513                                        Last    => Arg'Last);
 514                         Dummy := Goto_Next_Argument_In_Section;
 515
 516                      else
 517                         Current_Index := End_Index + 1;
 518                         raise Invalid_Parameter;
 519                      end if;
 520
 521                   --  If the switch is of the form <switch> xxx
 522
 523                   elsif Section (Current_Argument + 1) /= 0 then
 524                      Set_Parameter
 525                        (The_Parameter,
 526                         Arg_Num => Current_Argument + 1,
 527                         First   => 1,
 528                         Last    => CL.Argument (Current_Argument + 1)'Last);
 529                      Current_Argument := Current_Argument + 1;
 530                      Is_Switch (Current_Argument) := True;
 531                      Dummy := Goto_Next_Argument_In_Section;
 532
 533                   else
 534                      Current_Index := End_Index + 1;
 535                      raise Invalid_Parameter;
 536                   end if;
 537
 538                when '!' =>
 539
 540                   if End_Index < Arg'Last then
 541                      Set_Parameter (The_Parameter,
 542                                     Arg_Num => Current_Argument,
 543                                     First   => End_Index + 1,
 544                                     Last    => Arg'Last);
 545                      Dummy := Goto_Next_Argument_In_Section;
 546
 547                   else
 548                      Current_Index := End_Index + 1;
 549                      raise Invalid_Parameter;
 550                   end if;
 551
 552                when '?' =>
 553
 554                   if End_Index < Arg'Last then
 555                      Set_Parameter (The_Parameter,
 556                                     Arg_Num => Current_Argument,
 557                                     First   => End_Index + 1,
 558                                     Last    => Arg'Last);
 559
 560                   else
 561                      Set_Parameter (The_Parameter,
 562                                     Arg_Num => Current_Argument,
 563                                     First   => 2,
 564                                     Last    => 1);
 565                   end if;
 566                   Dummy := Goto_Next_Argument_In_Section;
 567
 568                when others =>
 569                   if Concatenate or else End_Index = Arg'Last then
 570                      Current_Index := End_Index + 1;
 571
 572                   else
 573                      --  If Concatenate is False and the full argument is not
 574                      --  recognized as a switch, this is an invalid switch.
 575
 576                      Set_Parameter (The_Switch,
 577                                     Arg_Num => Current_Argument,
 578                                     First   => Current_Index,
 579                                     Last    => Arg'Last);
 580                      Current_Index := Arg'Last + 1;
 581                      raise Invalid_Switch;
 582                   end if;
 583             end case;
 584
 585          elsif Concatenate or else End_Index = Arg'Last then
 586             Current_Index := End_Index + 1;
 587
 588          else
 589             --  If Concatenate is False and the full argument is not
 590             --  recognized as a switch, this is an invalid switch.
 591
 592             Set_Parameter (The_Switch,
 593                            Arg_Num => Current_Argument,
 594                            First   => Current_Index,
 595                            Last    => Arg'Last);
 596             Current_Index := Arg'Last + 1;
 597             raise Invalid_Switch;
 598          end if;
 599
 600          return Switches (Index_Switches);
 601       end;
 602    end Getopt;
 603
 604    -----------------------------------
 605    -- Goto_Next_Argument_In_Section --
 606    -----------------------------------
 607
 608    function Goto_Next_Argument_In_Section return Boolean is
 609    begin
 610       Current_Index := 1;
 611       Current_Argument := Current_Argument + 1;
 612
 613       if Section (Current_Argument) = 0 then
 614          loop
 615             if Current_Argument > CL.Argument_Count then
 616                return False;
 617             end if;
 618
 619             Current_Argument := Current_Argument + 1;
 620             exit when Section (Current_Argument) = Current_Section;
 621          end loop;
 622       end if;
 623       return True;
 624    end Goto_Next_Argument_In_Section;
 625
 626    ------------------
 627    -- Goto_Section --
 628    ------------------
 629
 630    procedure Goto_Section (Name : String := "") is
 631       Index : Integer := 1;
 632
 633    begin
 634       In_Expansion := False;
 635
 636       if Name = "" then
 637          Current_Argument := 1;
 638          Current_Index    := 1;
 639          Current_Section  := 1;
 640          return;
 641       end if;
 642
 643       while Index <= CL.Argument_Count loop
 644
 645          if Section (Index) = 0
 646            and then CL.Argument (Index) = Switch_Character & Name
 647          then
 648             Current_Argument := Index + 1;
 649             Current_Index    := 1;
 650
 651             if Current_Argument <= CL.Argument_Count then
 652                Current_Section := Section (Current_Argument);
 653             end if;
 654             return;
 655          end if;
 656
 657          Index := Index + 1;
 658       end loop;
 659
 660       Current_Argument := Positive'Last;
 661       Current_Index := 2;   --  so that Get_Argument returns nothing
 662    end Goto_Section;
 663
 664    ----------------------------
 665    -- Initialize_Option_Scan --
 666    ----------------------------
 667
 668    procedure Initialize_Option_Scan
 669      (Switch_Char              : Character := '-';
 670       Stop_At_First_Non_Switch : Boolean := False;
 671       Section_Delimiters       : String := "")
 672    is
 673       Section_Num     : Section_Number := 1;
 674       Section_Index   : Integer        := Section_Delimiters'First;
 675       Last            : Integer;
 676       Delimiter_Found : Boolean;
 677
 678    begin
 679       Current_Argument := 0;
 680       Current_Index := 0;
 681       In_Expansion := False;
 682       Switch_Character := Switch_Char;
 683       Stop_At_First := Stop_At_First_Non_Switch;
 684
 685       --  If we are using sections, we have to preprocess the command line
 686       --  to delimit them. A section can be repeated, so we just give each
 687       --  item on the command line a section number
 688
 689       while Section_Index <= Section_Delimiters'Last loop
 690
 691          Last := Section_Index;
 692          while Last <= Section_Delimiters'Last
 693            and then Section_Delimiters (Last) /= ' '
 694          loop
 695             Last := Last + 1;
 696          end loop;
 697
 698          Delimiter_Found := False;
 699          Section_Num := Section_Num + 1;
 700
 701          for Index in 1 .. CL.Argument_Count loop
 702             if CL.Argument (Index)(1) = Switch_Character
 703               and then
 704                 CL.Argument (Index) = Switch_Character &
 705                                         Section_Delimiters
 706                                           (Section_Index .. Last - 1)
 707             then
 708                Section (Index) := 0;
 709                Delimiter_Found := True;
 710
 711             elsif Section (Index) = 0 then
 712                Delimiter_Found := False;
 713
 714             elsif Delimiter_Found then
 715                Section (Index) := Section_Num;
 716             end if;
 717          end loop;
 718
 719          Section_Index := Last + 1;
 720          while Section_Index <= Section_Delimiters'Last
 721            and then Section_Delimiters (Section_Index) = ' '
 722          loop
 723             Section_Index := Section_Index + 1;
 724          end loop;
 725       end loop;
 726
 727       Delimiter_Found := Goto_Next_Argument_In_Section;
 728    end Initialize_Option_Scan;
 729
 730    ---------------
 731    -- Parameter --
 732    ---------------
 733
 734    function Parameter return String is
 735    begin
 736       if The_Parameter.First > The_Parameter.Last then
 737          return String'(1 .. 0 => ' ');
 738       else
 739          return CL.Argument (The_Parameter.Arg_Num)
 740            (The_Parameter.First .. The_Parameter.Last);
 741       end if;
 742    end Parameter;
 743
 744    -------------------
 745    -- Set_Parameter --
 746    -------------------
 747
 748    procedure Set_Parameter
 749      (Variable : out Parameter_Type;
 750       Arg_Num  : Positive;
 751       First    : Positive;
 752       Last     : Positive)
 753    is
 754    begin
 755       Variable.Arg_Num := Arg_Num;
 756       Variable.First   := First;
 757       Variable.Last    := Last;
 758    end Set_Parameter;
 759
 760    ---------------------
 761    -- Start_Expansion --
 762    ---------------------
 763
 764    procedure Start_Expansion
 765      (Iterator     : out Expansion_Iterator;
 766       Pattern      : String;
 767       Directory    : String := "";
 768       Basic_Regexp : Boolean := True)
 769    is
 770       Directory_Separator : Character;
 771       pragma Import (C, Directory_Separator, "__gnat_dir_separator");
 772       First : Positive := Pattern'First;
 773
 774       Pat : String := Pattern;
 775
 776    begin
 777       Canonical_Case_File_Name (Pat);
 778       Iterator.Current_Depth := 1;
 779
 780       --  If Directory is unspecified, use the current directory ("./" or ".\")
 781
 782       if Directory = "" then
 783          Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
 784          Iterator.Start := 3;
 785
 786       else
 787          Iterator.Dir_Name (1 .. Directory'Length) := Directory;
 788          Iterator.Start := Directory'Length + 1;
 789          Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length));
 790
 791          --  Make sure that the last character is a directory separator
 792
 793          if Directory (Directory'Last) /= Directory_Separator then
 794             Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
 795             Iterator.Start := Iterator.Start + 1;
 796          end if;
 797       end if;
 798
 799       Iterator.Levels (1).Name_Last := Iterator.Start - 1;
 800
 801       --  Open the initial Directory, at depth 1
 802
 803       GNAT.Directory_Operations.Open
 804         (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
 805
 806       --  If in the current directory and the pattern starts with "./" or ".\",
 807       --  drop the "./" or ".\" from the pattern.
 808
 809       if Directory = "" and then Pat'Length > 2
 810         and then Pat (Pat'First) = '.'
 811         and then Pat (Pat'First + 1) = Directory_Separator
 812       then
 813          First := Pat'First + 2;
 814       end if;
 815
 816       Iterator.Regexp :=
 817         GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True);
 818
 819       Iterator.Maximum_Depth := 1;
 820
 821       --  Maximum_Depth is equal to 1 plus the number of directory separators
 822       --  in the pattern.
 823
 824       for Index in First .. Pat'Last loop
 825          if Pat (Index) = Directory_Separator then
 826             Iterator.Maximum_Depth := Iterator.Maximum_Depth + 1;
 827             exit when Iterator.Maximum_Depth = Max_Depth;
 828          end if;
 829       end loop;
 830
 831    end Start_Expansion;
 832
 833 begin
 834    Section (CL.Argument_Count + 1) := 0;
 835 end GNAT.Command_Line;