OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [ada/] [g-diopit.adb] - Blame information for rev 281

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.