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