gcc/ada/g-dirope.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --            G N A T . D I R E C T O R Y _ O P E R A T I O N S             --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision: 1.2 $
  10 --                                                                          --
  11 --            Copyright (C) 1998-2001 Ada Core Technologies, 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.Characters.Handling;
  36 with Ada.Strings.Fixed;
  37 with Ada.Strings.Unbounded;
  38 with Ada.Strings.Maps;
  39 with Unchecked_Deallocation;
  40 with Unchecked_Conversion;
  41 with System;  use System;
  42
  43 with GNAT.Regexp;
  44 with GNAT.OS_Lib;
  45
  46 package body GNAT.Directory_Operations is
  47
  48    use Ada;
  49
  50    type Dir_Type_Value is new System.Address;
  51    --  This is the low-level address directory structure as returned by the C
  52    --  opendir routine.
  53
  54    Dir_Seps : constant Strings.Maps.Character_Set :=
  55                 Strings.Maps.To_Set ("/\");
  56    --  UNIX and DOS style directory separators.
  57
  58    procedure Free is new
  59      Unchecked_Deallocation (Dir_Type_Value, Dir_Type);
  60
  61    ---------------
  62    -- Base_Name --
  63    ---------------
  64
  65    function Base_Name
  66      (Path   : Path_Name;
  67       Suffix : String    := "")
  68       return   String
  69    is
  70       function Get_File_Names_Case_Sensitive return Integer;
  71       pragma Import
  72         (C, Get_File_Names_Case_Sensitive,
  73          "__gnat_get_file_names_case_sensitive");
  74
  75       Case_Sensitive_File_Name : constant Boolean :=
  76                                    Get_File_Names_Case_Sensitive = 1;
  77
  78       function Basename
  79         (Path   : Path_Name;
  80          Suffix : String    := "")
  81          return String;
  82       --  This function does the job. The only difference between Basename
  83       --  and Base_Name (the parent function) is that the former is case
  84       --  sensitive, while the latter is not. Path and Suffix are adjusted
  85       --  appropriately before calling Basename under platforms where the
  86       --  file system is not case sensitive.
  87
  88       --------------
  89       -- Basename --
  90       --------------
  91
  92       function Basename
  93         (Path   : Path_Name;
  94          Suffix : String    := "")
  95          return   String
  96       is
  97          Cut_Start : Natural :=
  98                        Strings.Fixed.Index
  99                          (Path, Dir_Seps, Going => Strings.Backward);
 100          Cut_End : Natural;
 101
 102       begin
 103          --  Cut_Start point to the first basename character
 104
 105          if Cut_Start = 0 then
 106             Cut_Start := Path'First;
 107
 108          else
 109             Cut_Start := Cut_Start + 1;
 110          end if;
 111
 112          --  Cut_End point to the last basename character.
 113
 114          Cut_End := Path'Last;
 115
 116          --  If basename ends with Suffix, adjust Cut_End.
 117
 118          if Suffix /= ""
 119            and then Path (Path'Last - Suffix'Length + 1 .. Cut_End) = Suffix
 120          then
 121             Cut_End := Path'Last - Suffix'Length;
 122          end if;
 123
 124          Check_For_Standard_Dirs : declare
 125             Offset : constant Integer := Path'First - Base_Name.Path'First;
 126             BN     : constant String  :=
 127                        Base_Name.Path (Cut_Start - Offset .. Cut_End - Offset);
 128             --  Here we use Base_Name.Path to keep the original casing
 129
 130          begin
 131             if BN = "." or else BN = ".." then
 132                return "";
 133
 134             elsif BN'Length > 2
 135               and then Characters.Handling.Is_Letter (BN (BN'First))
 136               and then BN (BN'First + 1) = ':'
 137             then
 138                --  We have a DOS drive letter prefix, remove it
 139
 140                return BN (BN'First + 2 .. BN'Last);
 141
 142             else
 143                return BN;
 144             end if;
 145          end Check_For_Standard_Dirs;
 146       end Basename;
 147
 148    --  Start processing for Base_Name
 149
 150    begin
 151       if Case_Sensitive_File_Name then
 152          return Basename (Path, Suffix);
 153
 154       else
 155          return Basename
 156            (Characters.Handling.To_Lower (Path),
 157             Characters.Handling.To_Lower (Suffix));
 158       end if;
 159    end Base_Name;
 160
 161    ----------------
 162    -- Change_Dir --
 163    ----------------
 164
 165    procedure Change_Dir (Dir_Name : Dir_Name_Str) is
 166       C_Dir_Name : String := Dir_Name & ASCII.NUL;
 167
 168       function chdir (Dir_Name : String) return Integer;
 169       pragma Import (C, chdir, "chdir");
 170
 171    begin
 172       if chdir (C_Dir_Name) /= 0 then
 173          raise Directory_Error;
 174       end if;
 175    end Change_Dir;
 176
 177    -----------
 178    -- Close --
 179    -----------
 180
 181    procedure Close (Dir : in out Dir_Type) is
 182
 183       function closedir (Directory : System.Address) return Integer;
 184       pragma Import (C, closedir, "closedir");
 185
 186       Discard : Integer;
 187
 188    begin
 189       if not Is_Open (Dir) then
 190          raise Directory_Error;
 191       end if;
 192
 193       Discard := closedir (System.Address (Dir.all));
 194       Free (Dir);
 195    end Close;
 196
 197    --------------
 198    -- Dir_Name --
 199    --------------
 200
 201    function Dir_Name (Path : Path_Name) return Dir_Name_Str is
 202       Last_DS : constant Natural :=
 203                   Strings.Fixed.Index
 204                     (Path, Dir_Seps, Going => Strings.Backward);
 205
 206    begin
 207       if Last_DS = 0 then
 208
 209          --  There is no directory separator, returns current working directory
 210
 211          return "." & Dir_Separator;
 212
 213       else
 214          return Path (Path'First .. Last_DS);
 215       end if;
 216    end Dir_Name;
 217
 218    -----------------
 219    -- Expand_Path --
 220    -----------------
 221
 222    function Expand_Path (Path : Path_Name) return String is
 223       use Ada.Strings.Unbounded;
 224
 225       procedure Read (K : in out Positive);
 226       --  Update Result while reading current Path starting at position K. If
 227       --  a variable is found, call Var below.
 228
 229       procedure Var (K : in out Positive);
 230       --  Translate variable name starting at position K with the associated
 231       --  environment value.
 232
 233       procedure Free is
 234          new Unchecked_Deallocation (String, OS_Lib.String_Access);
 235
 236       Result : Unbounded_String;
 237
 238       ----------
 239       -- Read --
 240       ----------
 241
 242       procedure Read (K : in out Positive) is
 243       begin
 244          For_All_Characters : loop
 245             if Path (K) = '$' then
 246
 247                --  Could be a variable
 248
 249                if K < Path'Last then
 250
 251                   if Path (K + 1) = '$' then
 252
 253                      --  Not a variable after all, this is a double $, just
 254                      --  insert one in the result string.
 255
 256                      Append (Result, '$');
 257                      K := K + 1;
 258
 259                   else
 260                      --  Let's parse the variable
 261
 262                      K := K + 1;
 263                      Var (K);
 264                   end if;
 265
 266                else
 267                   --  We have an ending $ sign
 268
 269                   Append (Result, '$');
 270                end if;
 271
 272             else
 273                --  This is a standard character, just add it to the result
 274
 275                Append (Result, Path (K));
 276             end if;
 277
 278             --  Skip to next character
 279
 280             K := K + 1;
 281
 282             exit For_All_Characters when K > Path'Last;
 283          end loop For_All_Characters;
 284       end Read;
 285
 286       ---------
 287       -- Var --
 288       ---------
 289
 290       procedure Var (K : in out Positive) is
 291          E : Positive;
 292
 293       begin
 294          if Path (K) = '{' then
 295
 296             --  Look for closing } (curly bracket).
 297
 298             E := K;
 299
 300             loop
 301                E := E + 1;
 302                exit when Path (E) = '}' or else E = Path'Last;
 303             end loop;
 304
 305             if Path (E) = '}' then
 306
 307                --  OK found, translate with environment value
 308
 309                declare
 310                   Env : OS_Lib.String_Access :=
 311                           OS_Lib.Getenv (Path (K + 1 .. E - 1));
 312
 313                begin
 314                   Append (Result, Env.all);
 315                   Free (Env);
 316                end;
 317
 318             else
 319                --  No closing curly bracket, not a variable after all or a
 320                --  syntax error, ignore it, insert string as-is.
 321
 322                Append (Result, '$' & Path (K .. E));
 323             end if;
 324
 325          else
 326             --  The variable name is everything from current position to first
 327             --  non letter/digit character.
 328
 329             E := K;
 330
 331             --  Check that first chartacter is a letter
 332
 333             if Characters.Handling.Is_Letter (Path (E)) then
 334                E := E + 1;
 335
 336                Var_Name : loop
 337                   exit Var_Name when E = Path'Last;
 338
 339                   if Characters.Handling.Is_Letter (Path (E))
 340                     or else Characters.Handling.Is_Digit (Path (E))
 341                   then
 342                      E := E + 1;
 343                   else
 344                      E := E - 1;
 345                      exit Var_Name;
 346                   end if;
 347                end loop Var_Name;
 348
 349                declare
 350                   Env : OS_Lib.String_Access := OS_Lib.Getenv (Path (K .. E));
 351
 352                begin
 353                   Append (Result, Env.all);
 354                   Free (Env);
 355                end;
 356
 357             else
 358                --  This is not a variable after all
 359
 360                Append (Result, '$' & Path (E));
 361             end if;
 362
 363          end if;
 364
 365          K := E;
 366       end Var;
 367
 368    --  Start of processing for Expand_Path
 369
 370    begin
 371       declare
 372          K : Positive := Path'First;
 373
 374       begin
 375          Read (K);
 376          return To_String (Result);
 377       end;
 378    end Expand_Path;
 379
 380    --------------------
 381    -- File_Extension --
 382    --------------------
 383
 384    function File_Extension (Path : Path_Name) return String is
 385       First : Natural :=
 386                 Strings.Fixed.Index
 387                   (Path, Dir_Seps, Going => Strings.Backward);
 388
 389       Dot : Natural;
 390
 391    begin
 392       if First = 0 then
 393          First := Path'First;
 394       end if;
 395
 396       Dot := Strings.Fixed.Index (Path (First .. Path'Last),
 397                                   ".",
 398                                   Going => Strings.Backward);
 399
 400       if Dot = 0 or else Dot = Path'Last then
 401          return "";
 402       else
 403          return Path (Dot .. Path'Last);
 404       end if;
 405    end File_Extension;
 406
 407    ---------------
 408    -- File_Name --
 409    ---------------
 410
 411    function File_Name (Path : Path_Name) return String is
 412    begin
 413       return Base_Name (Path);
 414    end File_Name;
 415
 416    ----------
 417    -- Find --
 418    ----------
 419
 420    procedure Find
 421      (Root_Directory : Dir_Name_Str;
 422       File_Pattern   : String)
 423    is
 424       File_Regexp : constant Regexp.Regexp := Regexp.Compile (File_Pattern);
 425       Index       : Natural := 0;
 426
 427       procedure Read_Directory (Directory : Dir_Name_Str);
 428       --  Open Directory and read all entries. This routine is called
 429       --  recursively for each sub-directories.
 430
 431       function Make_Pathname (Dir, File : String) return String;
 432       --  Returns the pathname for File by adding Dir as prefix.
 433
 434       -------------------
 435       -- Make_Pathname --
 436       -------------------
 437
 438       function Make_Pathname (Dir, File : String) return String is
 439       begin
 440          if Dir (Dir'Last) = '/' or else Dir (Dir'Last) = '\' then
 441             return Dir & File;
 442          else
 443             return Dir & Dir_Separator & File;
 444          end if;
 445       end Make_Pathname;
 446
 447       --------------------
 448       -- Read_Directory --
 449       --------------------
 450
 451       procedure Read_Directory (Directory : Dir_Name_Str) is
 452          Dir    : Dir_Type;
 453          Buffer : String (1 .. 2_048);
 454          Last   : Natural;
 455          Quit   : Boolean;
 456
 457       begin
 458          Open (Dir, Directory);
 459
 460          loop
 461             Read (Dir, Buffer, Last);
 462             exit when Last = 0;
 463
 464             declare
 465                Dir_Entry : constant String := Buffer (1 .. Last);
 466                Pathname  : constant String
 467                  := Make_Pathname (Directory, Dir_Entry);
 468             begin
 469                if Regexp.Match (Dir_Entry, File_Regexp) then
 470                   Quit  := False;
 471                   Index := Index + 1;
 472
 473                   begin
 474                      Action (Pathname, Index, Quit);
 475                   exception
 476                      when others =>
 477                         Close (Dir);
 478                         raise;
 479                   end;
 480
 481                   exit when Quit;
 482                end if;
 483
 484                --  Recursively call for sub-directories, except for . and ..
 485
 486                if not (Dir_Entry = "." or else Dir_Entry = "..")
 487                  and then OS_Lib.Is_Directory (Pathname)
 488                then
 489                   Read_Directory (Pathname);
 490                end if;
 491             end;
 492          end loop;
 493
 494          Close (Dir);
 495       end Read_Directory;
 496
 497    begin
 498       Read_Directory (Root_Directory);
 499    end Find;
 500
 501    ---------------------
 502    -- Get_Current_Dir --
 503    ---------------------
 504
 505    Max_Path : Integer;
 506    pragma Import (C, Max_Path, "max_path_len");
 507
 508    function Get_Current_Dir return Dir_Name_Str is
 509       Current_Dir : String (1 .. Max_Path + 1);
 510       Last        : Natural;
 511
 512    begin
 513       Get_Current_Dir (Current_Dir, Last);
 514       return Current_Dir (1 .. Last);
 515    end Get_Current_Dir;
 516
 517    procedure Get_Current_Dir (Dir : out Dir_Name_Str; Last : out Natural) is
 518       Path_Len : Natural := Max_Path;
 519       Buffer   : String (Dir'First .. Dir'First + Max_Path + 1);
 520
 521       procedure Local_Get_Current_Dir
 522         (Dir    : System.Address;
 523          Length : System.Address);
 524       pragma Import (C, Local_Get_Current_Dir, "__gnat_get_current_dir");
 525
 526    begin
 527       Local_Get_Current_Dir (Buffer'Address, Path_Len'Address);
 528
 529       if Dir'Length > Path_Len then
 530          Last := Dir'First + Path_Len - 1;
 531       else
 532          Last := Dir'Last;
 533       end if;
 534
 535       Dir (Buffer'First .. Last) := Buffer (Buffer'First .. Last);
 536    end Get_Current_Dir;
 537
 538    -------------
 539    -- Is_Open --
 540    -------------
 541
 542    function Is_Open (Dir : Dir_Type) return Boolean is
 543    begin
 544       return Dir /= Null_Dir
 545         and then System.Address (Dir.all) /= System.Null_Address;
 546    end Is_Open;
 547
 548    --------------
 549    -- Make_Dir --
 550    --------------
 551
 552    procedure Make_Dir (Dir_Name : Dir_Name_Str) is
 553       C_Dir_Name : String := Dir_Name & ASCII.NUL;
 554
 555       function mkdir (Dir_Name : String) return Integer;
 556       pragma Import (C, mkdir, "__gnat_mkdir");
 557
 558    begin
 559       if mkdir (C_Dir_Name) /= 0 then
 560          raise Directory_Error;
 561       end if;
 562    end Make_Dir;
 563
 564    ------------------------
 565    -- Normalize_Pathname --
 566    ------------------------
 567
 568    function Normalize_Pathname
 569      (Path  : Path_Name;
 570       Style : Path_Style := System_Default)
 571       return  String
 572    is
 573       N_Path      : String := Path;
 574       K           : Positive := N_Path'First;
 575       Prev_Dirsep : Boolean := False;
 576
 577    begin
 578       for J in Path'Range loop
 579
 580          if Strings.Maps.Is_In (Path (J), Dir_Seps) then
 581             if not Prev_Dirsep then
 582
 583                case Style is
 584                   when UNIX           => N_Path (K) := '/';
 585                   when DOS            => N_Path (K) := '\';
 586                   when System_Default => N_Path (K) := Dir_Separator;
 587                end case;
 588
 589                K := K + 1;
 590             end if;
 591
 592             Prev_Dirsep := True;
 593
 594          else
 595             N_Path (K) := Path (J);
 596             K := K + 1;
 597             Prev_Dirsep := False;
 598          end if;
 599       end loop;
 600
 601       return N_Path (N_Path'First .. K - 1);
 602    end Normalize_Pathname;
 603
 604    ----------
 605    -- Open --
 606    ----------
 607
 608    procedure Open
 609      (Dir      : out Dir_Type;
 610       Dir_Name : Dir_Name_Str)
 611    is
 612       C_File_Name : String := Dir_Name & ASCII.NUL;
 613
 614       function opendir
 615         (File_Name : String)
 616          return      Dir_Type_Value;
 617       pragma Import (C, opendir, "opendir");
 618
 619    begin
 620       Dir := new Dir_Type_Value'(opendir (C_File_Name));
 621
 622       if not Is_Open (Dir) then
 623          Free (Dir);
 624          Dir := Null_Dir;
 625          raise Directory_Error;
 626       end if;
 627    end Open;
 628
 629    ----------
 630    -- Read --
 631    ----------
 632
 633    procedure Read
 634      (Dir  : in out Dir_Type;
 635       Str  : out String;
 636       Last : out Natural)
 637    is
 638       Filename_Addr : Address;
 639       Filename_Len  : Integer;
 640
 641       Buffer : array (0 .. 1024) of Character;
 642       --  1024 is the value of FILENAME_MAX in stdio.h
 643
 644       function readdir_gnat
 645         (Directory : System.Address;
 646          Buffer    : System.Address)
 647          return      System.Address;
 648       pragma Import (C, readdir_gnat, "__gnat_readdir");
 649
 650       function strlen (S : Address) return Integer;
 651       pragma Import (C, strlen, "strlen");
 652
 653    begin
 654       if not Is_Open (Dir) then
 655          raise Directory_Error;
 656       end if;
 657
 658       Filename_Addr :=
 659         readdir_gnat (System.Address (Dir.all), Buffer'Address);
 660
 661       if Filename_Addr = System.Null_Address then
 662          Last := 0;
 663          return;
 664       end if;
 665
 666       Filename_Len  := strlen (Filename_Addr);
 667
 668       if Str'Length > Filename_Len then
 669          Last := Str'First + Filename_Len - 1;
 670       else
 671          Last := Str'Last;
 672       end if;
 673
 674       declare
 675          subtype Path_String is String (1 .. Filename_Len);
 676          type    Path_String_Access is access Path_String;
 677
 678          function Address_To_Access is new
 679            Unchecked_Conversion
 680              (Source => Address,
 681               Target => Path_String_Access);
 682
 683          Path_Access : Path_String_Access := Address_To_Access (Filename_Addr);
 684
 685       begin
 686          for J in Str'First .. Last loop
 687             Str (J) := Path_Access (J - Str'First + 1);
 688          end loop;
 689       end;
 690    end Read;
 691
 692    -------------------------
 693    -- Read_Is_Thread_Sage --
 694    -------------------------
 695
 696    function Read_Is_Thread_Safe return Boolean is
 697
 698       function readdir_is_thread_safe return Integer;
 699       pragma Import
 700         (C, readdir_is_thread_safe, "__gnat_readdir_is_thread_safe");
 701
 702    begin
 703       return (readdir_is_thread_safe /= 0);
 704    end Read_Is_Thread_Safe;
 705
 706    ----------------
 707    -- Remove_Dir --
 708    ----------------
 709
 710    procedure Remove_Dir (Dir_Name : Dir_Name_Str) is
 711       C_Dir_Name : String := Dir_Name & ASCII.NUL;
 712
 713       procedure rmdir (Dir_Name : String);
 714       pragma Import (C, rmdir, "rmdir");
 715
 716    begin
 717       rmdir (C_Dir_Name);
 718    end Remove_Dir;
 719
 720    -----------------------
 721    -- Wildcard_Iterator --
 722    -----------------------
 723
 724    procedure Wildcard_Iterator (Path : Path_Name) is
 725
 726       Index : Natural := 0;
 727
 728       procedure Read
 729         (Directory      : String;
 730          File_Pattern   : String;
 731          Suffix_Pattern : String);
 732       --  Read entries in Directory and call user's callback if the entry
 733       --  match File_Pattern and Suffix_Pattern is empty otherwise it will go
 734       --  down one more directory level by calling Next_Level routine above.
 735
 736       procedure Next_Level
 737         (Current_Path : String;
 738          Suffix_Path  : String);
 739       --  Extract next File_Pattern from Suffix_Path and call Read routine
 740       --  above.
 741
 742       ----------------
 743       -- Next_Level --
 744       ----------------
 745
 746       procedure Next_Level
 747         (Current_Path : String;
 748          Suffix_Path  : String)
 749       is
 750          DS : Natural;
 751          SP : String renames Suffix_Path;
 752
 753       begin
 754          if SP'Length > 2
 755            and then SP (SP'First) = '.'
 756            and then Strings.Maps.Is_In (SP (SP'First + 1), Dir_Seps)
 757          then
 758             --  Starting with "./"
 759
 760             DS := Strings.Fixed.Index
 761               (SP (SP'First + 2 .. SP'Last),
 762                Dir_Seps);
 763
 764             if DS = 0 then
 765
 766                --  We have "./"
 767
 768                Read (Current_Path & ".", "*", "");
 769
 770             else
 771                --  We have "./dir"
 772
 773                Read (Current_Path & ".",
 774                      SP (SP'First + 2 .. DS - 1),
 775                      SP (DS .. SP'Last));
 776             end if;
 777
 778          elsif SP'Length > 3
 779            and then SP (SP'First .. SP'First + 1) = ".."
 780            and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
 781          then
 782             --  Starting with "../"
 783
 784             DS := Strings.Fixed.Index
 785               (SP (SP'First + 3 .. SP'Last),
 786                Dir_Seps);
 787
 788             if DS = 0 then
 789
 790                --  We have "../"
 791
 792                Read (Current_Path & "..", "*", "");
 793
 794             else
 795                --  We have "../dir"
 796
 797                Read (Current_Path & "..",
 798                      SP (SP'First + 4 .. DS - 1),
 799                      SP (DS .. SP'Last));
 800             end if;
 801
 802          elsif Current_Path = ""
 803            and then SP'Length > 1
 804            and then Characters.Handling.Is_Letter (SP (SP'First))
 805            and then SP (SP'First + 1) = ':'
 806          then
 807             --  Starting with "<drive>:"
 808
 809             if SP'Length > 2
 810               and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
 811             then
 812                --  Starting with "<drive>:\"
 813
 814                DS :=  Strings.Fixed.Index
 815                         (SP (SP'First + 3 .. SP'Last), Dir_Seps);
 816
 817                if DS = 0 then
 818
 819                   --  Se have "<drive>:\dir"
 820
 821                   Read (SP (SP'First .. SP'First + 1),
 822                         SP (SP'First + 3 .. SP'Last),
 823                         "");
 824
 825                else
 826                   --  We have "<drive>:\dir\kkk"
 827
 828                   Read (SP (SP'First .. SP'First + 1),
 829                         SP (SP'First + 3 .. DS - 1),
 830                         SP (DS .. SP'Last));
 831                end if;
 832
 833             else
 834                --  Starting with "<drive>:"
 835
 836                DS :=  Strings.Fixed.Index
 837                         (SP (SP'First + 2 .. SP'Last), Dir_Seps);
 838
 839                if DS = 0 then
 840
 841                   --  We have "<drive>:dir"
 842
 843                   Read (SP (SP'First .. SP'First + 1),
 844                         SP (SP'First + 2 .. SP'Last),
 845                         "");
 846
 847                else
 848                   --  We have "<drive>:dir/kkk"
 849
 850                   Read (SP (SP'First .. SP'First + 1),
 851                         SP (SP'First + 2 .. DS - 1),
 852                         SP (DS .. SP'Last));
 853                end if;
 854
 855             end if;
 856
 857          elsif Strings.Maps.Is_In (SP (SP'First), Dir_Seps) then
 858
 859             --  Starting with a /
 860
 861             DS := Strings.Fixed.Index
 862               (SP (SP'First + 1 .. SP'Last),
 863                Dir_Seps);
 864
 865             if DS = 0 then
 866
 867                --  We have "/dir"
 868
 869                Read (Current_Path,
 870                      SP (SP'First + 1 .. SP'Last),
 871                      "");
 872             else
 873                --  We have "/dir/kkk"
 874
 875                Read (Current_Path,
 876                      SP (SP'First + 1 .. DS - 1),
 877                      SP (DS .. SP'Last));
 878             end if;
 879
 880          else
 881             --  Starting with a name
 882
 883             DS := Strings.Fixed.Index (SP, Dir_Seps);
 884
 885             if DS = 0 then
 886
 887                --  We have "dir"
 888
 889                Read (Current_Path & '.',
 890                      SP,
 891                      "");
 892             else
 893                --  We have "dir/kkk"
 894
 895                Read (Current_Path & '.',
 896                      SP (SP'First .. DS - 1),
 897                      SP (DS .. SP'Last));
 898             end if;
 899
 900          end if;
 901       end Next_Level;
 902
 903       ----------
 904       -- Read --
 905       ----------
 906
 907       Quit : Boolean := False;
 908       --  Global state to be able to exit all recursive calls.
 909
 910       procedure Read
 911         (Directory      : String;
 912          File_Pattern   : String;
 913          Suffix_Pattern : String)
 914       is
 915          File_Regexp : constant Regexp.Regexp :=
 916                          Regexp.Compile (File_Pattern, Glob => True);
 917          Dir    : Dir_Type;
 918          Buffer : String (1 .. 2_048);
 919          Last   : Natural;
 920
 921       begin
 922          if OS_Lib.Is_Directory (Directory) then
 923             Open (Dir, Directory);
 924
 925             Dir_Iterator : loop
 926                Read (Dir, Buffer, Last);
 927                exit Dir_Iterator when Last = 0;
 928
 929                declare
 930                   Dir_Entry : constant String := Buffer (1 .. Last);
 931                   Pathname  : constant String :=
 932                                 Directory & Dir_Separator & Dir_Entry;
 933                begin
 934                   --  Handle "." and ".." only if explicit use in the
 935                   --  File_Pattern.
 936
 937                   if not
 938                     ((Dir_Entry = "." and then File_Pattern /= ".")
 939                        or else
 940                      (Dir_Entry = ".." and then File_Pattern /= ".."))
 941                   then
 942                      if Regexp.Match (Dir_Entry, File_Regexp) then
 943
 944                         if Suffix_Pattern = "" then
 945
 946                            --  No more matching needed, call user's callback
 947
 948                            Index := Index + 1;
 949
 950                            begin
 951                               Action (Pathname, Index, Quit);
 952
 953                            exception
 954                               when others =>
 955                                  Close (Dir);
 956                                  raise;
 957                            end;
 958
 959                            exit Dir_Iterator when Quit;
 960
 961                         else
 962                            --  Down one level
 963
 964                            Next_Level
 965                              (Directory & Dir_Separator & Dir_Entry,
 966                               Suffix_Pattern);
 967                         end if;
 968                      end if;
 969                   end if;
 970                end;
 971
 972                exit Dir_Iterator when Quit;
 973
 974             end loop Dir_Iterator;
 975
 976             Close (Dir);
 977          end if;
 978       end Read;
 979
 980    begin
 981       Next_Level ("", Path);
 982    end Wildcard_Iterator;
 983
 984 end GNAT.Directory_Operations;