GCC v8.2
[gcc.git] / gcc / ada / libgnat / 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-2018, 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 3,  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.                                     --
17 --                                                                          --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception,   --
20 -- version 3.1, as published by the Free Software Foundation.               --
21 --                                                                          --
22 -- You should have received a copy of the GNU General Public License and    --
23 -- a copy of the GCC Runtime Library Exception along with this program;     --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25 -- <http://www.gnu.org/licenses/>.                                          --
26 --                                                                          --
27 -- GNAT was originally developed  by the GNAT team at  New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
29 --                                                                          --
30 ------------------------------------------------------------------------------
31
32 with Ada.Characters.Handling;
33 with Ada.Strings.Fixed;
34 with Ada.Strings.Maps;
35 with GNAT.OS_Lib;
36 with GNAT.Regexp;
37
38 package body GNAT.Directory_Operations.Iteration is
39
40    use Ada;
41
42    ----------
43    -- Find --
44    ----------
45
46    procedure Find
47      (Root_Directory : Dir_Name_Str;
48       File_Pattern   : String)
49    is
50       File_Regexp : constant Regexp.Regexp := Regexp.Compile (File_Pattern);
51       Index       : Natural := 0;
52       Quit        : Boolean;
53
54       procedure Read_Directory (Directory : Dir_Name_Str);
55       --  Open Directory and read all entries. This routine is called
56       --  recursively for each sub-directories.
57
58       function Make_Pathname (Dir, File : String) return String;
59       --  Returns the pathname for File by adding Dir as prefix
60
61       -------------------
62       -- Make_Pathname --
63       -------------------
64
65       function Make_Pathname (Dir, File : String) return String is
66       begin
67          if Dir (Dir'Last) = '/' or else Dir (Dir'Last) = '\' then
68             return Dir & File;
69          else
70             return Dir & Dir_Separator & File;
71          end if;
72       end Make_Pathname;
73
74       --------------------
75       -- Read_Directory --
76       --------------------
77
78       procedure Read_Directory (Directory : Dir_Name_Str) is
79          Buffer : String (1 .. 2_048);
80          Last   : Natural;
81
82          Dir : Dir_Type;
83          pragma Warnings (Off, Dir);
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 match
144       --  File_Pattern and Suffix_Pattern is empty; otherwise go down one more
145       --  directory level by calling Next_Level routine below.
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
323          Dir : Dir_Type;
324          pragma Warnings (Off, Dir);
325
326          Buffer : String (1 .. 2_048);
327          Last   : Natural;
328
329       begin
330          if OS_Lib.Is_Directory (Directory & Dir_Separator) then
331             Open (Dir, Directory & Dir_Separator);
332
333             Dir_Iterator : loop
334                Read (Dir, Buffer, Last);
335                exit Dir_Iterator when Last = 0;
336
337                declare
338                   Dir_Entry : constant String := Buffer (1 .. Last);
339                   Pathname  : constant String :=
340                                 Directory & Dir_Separator & Dir_Entry;
341                begin
342                   --  Handle "." and ".." only if explicit use in the
343                   --  File_Pattern.
344
345                   if not
346                     ((Dir_Entry = "." and then File_Pattern /= ".")
347                        or else
348                      (Dir_Entry = ".." and then File_Pattern /= ".."))
349                   then
350                      if Regexp.Match (Dir_Entry, File_Regexp) then
351                         if Suffix_Pattern = "" then
352
353                            --  No more matching needed, call user's callback
354
355                            Index := Index + 1;
356
357                            begin
358                               Action (Pathname, Index, Quit);
359                            exception
360                               when others =>
361                                  Close (Dir);
362                                  raise;
363                            end;
364
365                         else
366                            --  Down one level
367
368                            Next_Level
369                              (Directory & Dir_Separator & Dir_Entry,
370                               Suffix_Pattern);
371                         end if;
372                      end if;
373                   end if;
374                end;
375
376                --  Exit if Quit set by call to Action, either at this level
377                --  or at some lower recursive call to Next_Level.
378
379                exit Dir_Iterator when Quit;
380             end loop Dir_Iterator;
381
382             Close (Dir);
383          end if;
384       end Read;
385
386    --  Start of processing for Wildcard_Iterator
387
388    begin
389       if Path = "" then
390          return;
391       end if;
392
393       Next_Level ("", Path);
394    end Wildcard_Iterator;
395
396 end GNAT.Directory_Operations.Iteration;