old-autovect-branch/gcc/ada/g-diopit.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 . I T E R A T I O N   --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2001-2005, AdaCore                     --
  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,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, 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.Characters.Handling;
  35 with Ada.Strings.Fixed;
  36 with Ada.Strings.Maps;
  37 with GNAT.OS_Lib;
  38 with GNAT.Regexp;
  39
  40 package body GNAT.Directory_Operations.Iteration is
  41
  42    use Ada;
  43
  44    ----------
  45    -- Find --
  46    ----------
  47
  48    procedure Find
  49      (Root_Directory : Dir_Name_Str;
  50       File_Pattern   : String)
  51    is
  52       File_Regexp : constant Regexp.Regexp := Regexp.Compile (File_Pattern);
  53       Index       : Natural := 0;
  54       Quit        : Boolean;
  55
  56       procedure Read_Directory (Directory : Dir_Name_Str);
  57       --  Open Directory and read all entries. This routine is called
  58       --  recursively for each sub-directories.
  59
  60       function Make_Pathname (Dir, File : String) return String;
  61       --  Returns the pathname for File by adding Dir as prefix
  62
  63       -------------------
  64       -- Make_Pathname --
  65       -------------------
  66
  67       function Make_Pathname (Dir, File : String) return String is
  68       begin
  69          if Dir (Dir'Last) = '/' or else Dir (Dir'Last) = '\' then
  70             return Dir & File;
  71          else
  72             return Dir & Dir_Separator & File;
  73          end if;
  74       end Make_Pathname;
  75
  76       --------------------
  77       -- Read_Directory --
  78       --------------------
  79
  80       procedure Read_Directory (Directory : Dir_Name_Str) is
  81          Dir    : Dir_Type;
  82          Buffer : String (1 .. 2_048);
  83          Last   : Natural;
  84
  85       begin
  86          Open (Dir, Directory);
  87
  88          loop
  89             Read (Dir, Buffer, Last);
  90             exit when Last = 0;
  91
  92             declare
  93                Dir_Entry : constant String := Buffer (1 .. Last);
  94                Pathname  : constant String :=
  95                              Make_Pathname (Directory, Dir_Entry);
  96
  97             begin
  98                if Regexp.Match (Dir_Entry, File_Regexp) then
  99                   Index := Index + 1;
 100
 101                   begin
 102                      Action (Pathname, Index, Quit);
 103                   exception
 104                      when others =>
 105                         Close (Dir);
 106                         raise;
 107                   end;
 108
 109                   exit when Quit;
 110                end if;
 111
 112                --  Recursively call for sub-directories, except for . and ..
 113
 114                if not (Dir_Entry = "." or else Dir_Entry = "..")
 115                  and then OS_Lib.Is_Directory (Pathname)
 116                then
 117                   Read_Directory (Pathname);
 118                   exit when Quit;
 119                end if;
 120             end;
 121          end loop;
 122
 123          Close (Dir);
 124       end Read_Directory;
 125
 126    begin
 127       Quit := False;
 128       Read_Directory (Root_Directory);
 129    end Find;
 130
 131    -----------------------
 132    -- Wildcard_Iterator --
 133    -----------------------
 134
 135    procedure Wildcard_Iterator (Path : Path_Name) is
 136
 137       Index : Natural := 0;
 138
 139       procedure Read
 140         (Directory      : String;
 141          File_Pattern   : String;
 142          Suffix_Pattern : String);
 143       --  Read entries in Directory and call user's callback if the entry
 144       --  match File_Pattern and Suffix_Pattern is empty otherwise it will go
 145       --  down one more directory level by calling Next_Level routine above.
 146
 147       procedure Next_Level
 148         (Current_Path : String;
 149          Suffix_Path  : String);
 150       --  Extract next File_Pattern from Suffix_Path and call Read routine
 151       --  above.
 152
 153       ----------------
 154       -- Next_Level --
 155       ----------------
 156
 157       procedure Next_Level
 158         (Current_Path : String;
 159          Suffix_Path  : String)
 160       is
 161          DS : Natural;
 162          SP : String renames Suffix_Path;
 163
 164       begin
 165          if SP'Length > 2
 166            and then SP (SP'First) = '.'
 167            and then Strings.Maps.Is_In (SP (SP'First + 1), Dir_Seps)
 168          then
 169             --  Starting with "./"
 170
 171             DS := Strings.Fixed.Index
 172               (SP (SP'First + 2 .. SP'Last),
 173                Dir_Seps);
 174
 175             if DS = 0 then
 176
 177                --  We have "./"
 178
 179                Read (Current_Path & ".", "*", "");
 180
 181             else
 182                --  We have "./dir"
 183
 184                Read (Current_Path & ".",
 185                      SP (SP'First + 2 .. DS - 1),
 186                      SP (DS .. SP'Last));
 187             end if;
 188
 189          elsif SP'Length > 3
 190            and then SP (SP'First .. SP'First + 1) = ".."
 191            and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
 192          then
 193             --  Starting with "../"
 194
 195             DS := Strings.Fixed.Index
 196                     (SP (SP'First + 3 .. SP'Last), Dir_Seps);
 197
 198             if DS = 0 then
 199
 200                --  We have "../"
 201
 202                Read (Current_Path & "..", "*", "");
 203
 204             else
 205                --  We have "../dir"
 206
 207                Read (Current_Path & "..",
 208                      SP (SP'First + 3 .. DS - 1),
 209                      SP (DS .. SP'Last));
 210             end if;
 211
 212          elsif Current_Path = ""
 213            and then SP'Length > 1
 214            and then Characters.Handling.Is_Letter (SP (SP'First))
 215            and then SP (SP'First + 1) = ':'
 216          then
 217             --  Starting with "<drive>:"
 218
 219             if SP'Length > 2
 220               and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
 221             then
 222                --  Starting with "<drive>:\"
 223
 224                DS :=  Strings.Fixed.Index
 225                         (SP (SP'First + 3 .. SP'Last), Dir_Seps);
 226
 227                if DS = 0 then
 228
 229                   --  We have "<drive>:\dir"
 230
 231                   Read (SP (SP'First .. SP'First + 2),
 232                         SP (SP'First + 3 .. SP'Last),
 233                         "");
 234
 235                else
 236                   --  We have "<drive>:\dir\kkk"
 237
 238                   Read (SP (SP'First .. SP'First + 2),
 239                         SP (SP'First + 3 .. DS - 1),
 240                         SP (DS .. SP'Last));
 241                end if;
 242
 243             else
 244                --  Starting with "<drive>:" and the drive letter not followed
 245                --  by a directory separator. The proper semantic on Windows is
 246                --  to read the content of the current selected directory on
 247                --  this drive. For example, if drive C current selected
 248                --  directory is c:\temp the suffix pattern "c:m*" is
 249                --  equivalent to c:\temp\m*.
 250
 251                DS :=  Strings.Fixed.Index
 252                         (SP (SP'First + 2 .. SP'Last), Dir_Seps);
 253
 254                if DS = 0 then
 255
 256                   --  We have "<drive>:dir"
 257
 258                   Read (SP, "", "");
 259
 260                else
 261                   --  We have "<drive>:dir/kkk"
 262
 263                   Read (SP (SP'First .. DS - 1), "", SP (DS .. SP'Last));
 264                end if;
 265             end if;
 266
 267          elsif Strings.Maps.Is_In (SP (SP'First), Dir_Seps) then
 268
 269             --  Starting with a /
 270
 271             DS := Strings.Fixed.Index
 272                     (SP (SP'First + 1 .. SP'Last), Dir_Seps);
 273
 274             if DS = 0 then
 275
 276                --  We have "/dir"
 277
 278                Read (Current_Path, SP (SP'First + 1 .. SP'Last), "");
 279             else
 280                --  We have "/dir/kkk"
 281
 282                Read (Current_Path,
 283                      SP (SP'First + 1 .. DS - 1),
 284                      SP (DS .. SP'Last));
 285             end if;
 286
 287          else
 288             --  Starting with a name
 289
 290             DS := Strings.Fixed.Index (SP, Dir_Seps);
 291
 292             if DS = 0 then
 293
 294                --  We have "dir"
 295
 296                Read (Current_Path & '.', SP, "");
 297             else
 298                --  We have "dir/kkk"
 299
 300                Read (Current_Path & '.',
 301                      SP (SP'First .. DS - 1),
 302                      SP (DS .. SP'Last));
 303             end if;
 304
 305          end if;
 306       end Next_Level;
 307
 308       ----------
 309       -- Read --
 310       ----------
 311
 312       Quit : Boolean := False;
 313       --  Global state to be able to exit all recursive calls
 314
 315       procedure Read
 316         (Directory      : String;
 317          File_Pattern   : String;
 318          Suffix_Pattern : String)
 319       is
 320          File_Regexp : constant Regexp.Regexp :=
 321                          Regexp.Compile (File_Pattern, Glob => True);
 322          Dir    : Dir_Type;
 323          Buffer : String (1 .. 2_048);
 324          Last   : Natural;
 325
 326       begin
 327          if OS_Lib.Is_Directory (Directory & Dir_Separator) then
 328             Open (Dir, Directory & Dir_Separator);
 329
 330             Dir_Iterator : loop
 331                Read (Dir, Buffer, Last);
 332                exit Dir_Iterator when Last = 0;
 333
 334                declare
 335                   Dir_Entry : constant String := Buffer (1 .. Last);
 336                   Pathname  : constant String :=
 337                                 Directory & Dir_Separator & Dir_Entry;
 338                begin
 339                   --  Handle "." and ".." only if explicit use in the
 340                   --  File_Pattern.
 341
 342                   if not
 343                     ((Dir_Entry = "." and then File_Pattern /= ".")
 344                        or else
 345                      (Dir_Entry = ".." and then File_Pattern /= ".."))
 346                   then
 347                      if Regexp.Match (Dir_Entry, File_Regexp) then
 348                         if Suffix_Pattern = "" then
 349
 350                            --  No more matching needed, call user's callback
 351
 352                            Index := Index + 1;
 353
 354                            begin
 355                               Action (Pathname, Index, Quit);
 356                            exception
 357                               when others =>
 358                                  Close (Dir);
 359                                  raise;
 360                            end;
 361
 362                         else
 363                            --  Down one level
 364
 365                            Next_Level
 366                              (Directory & Dir_Separator & Dir_Entry,
 367                               Suffix_Pattern);
 368                         end if;
 369                      end if;
 370                   end if;
 371                end;
 372
 373                --  Exit if Quit set by call to Action, either at this level
 374                --  or at at some lower recursive call to Next_Level.
 375
 376                exit Dir_Iterator when Quit;
 377             end loop Dir_Iterator;
 378
 379             Close (Dir);
 380          end if;
 381       end Read;
 382
 383    --  Start of processing for Wildcard_Iterator
 384
 385    begin
 386       if Path = "" then
 387          return;
 388       end if;
 389
 390       Next_Level ("", Path);
 391    end Wildcard_Iterator;
 392
 393 end GNAT.Directory_Operations.Iteration;