URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [g-diopit.adb] - Blame information for rev 311

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


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--  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   --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2001-2008, AdaCore                     --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
-- Boston, MA 02110-1301, USA.                                              --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
with Ada.Characters.Handling;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with GNAT.OS_Lib;
with GNAT.Regexp;
 
package body GNAT.Directory_Operations.Iteration is
 
   use Ada;
 
   ----------
   -- Find --
   ----------
 
   procedure Find
     (Root_Directory : Dir_Name_Str;
      File_Pattern   : String)
   is
      File_Regexp : constant Regexp.Regexp := Regexp.Compile (File_Pattern);
      Index       : Natural := 0;
      Quit        : Boolean;
 
      procedure Read_Directory (Directory : Dir_Name_Str);
      --  Open Directory and read all entries. This routine is called
      --  recursively for each sub-directories.
 
      function Make_Pathname (Dir, File : String) return String;
      --  Returns the pathname for File by adding Dir as prefix
 
      -------------------
      -- Make_Pathname --
      -------------------
 
      function Make_Pathname (Dir, File : String) return String is
      begin
         if Dir (Dir'Last) = '/' or else Dir (Dir'Last) = '\' then
            return Dir & File;
         else
            return Dir & Dir_Separator & File;
         end if;
      end Make_Pathname;
 
      --------------------
      -- Read_Directory --
      --------------------
 
      procedure Read_Directory (Directory : Dir_Name_Str) is
         Buffer : String (1 .. 2_048);
         Last   : Natural;
 
         Dir : Dir_Type;
         pragma Warnings (Off, Dir);
 
      begin
         Open (Dir, Directory);
 
         loop
            Read (Dir, Buffer, Last);
            exit when Last = 0;
 
            declare
               Dir_Entry : constant String := Buffer (1 .. Last);
               Pathname  : constant String :=
                             Make_Pathname (Directory, Dir_Entry);
 
            begin
               if Regexp.Match (Dir_Entry, File_Regexp) then
                  Index := Index + 1;
 
                  begin
                     Action (Pathname, Index, Quit);
                  exception
                     when others =>
                        Close (Dir);
                        raise;
                  end;
 
                  exit when Quit;
               end if;
 
               --  Recursively call for sub-directories, except for . and ..
 
               if not (Dir_Entry = "." or else Dir_Entry = "..")
                 and then OS_Lib.Is_Directory (Pathname)
               then
                  Read_Directory (Pathname);
                  exit when Quit;
               end if;
            end;
         end loop;
 
         Close (Dir);
      end Read_Directory;
 
   begin
      Quit := False;
      Read_Directory (Root_Directory);
   end Find;
 
   -----------------------
   -- Wildcard_Iterator --
   -----------------------
 
   procedure Wildcard_Iterator (Path : Path_Name) is
 
      Index : Natural := 0;
 
      procedure Read
        (Directory      : String;
         File_Pattern   : String;
         Suffix_Pattern : String);
      --  Read entries in Directory and call user's callback if the entry
      --  match File_Pattern and Suffix_Pattern is empty otherwise it will go
      --  down one more directory level by calling Next_Level routine above.
 
      procedure Next_Level
        (Current_Path : String;
         Suffix_Path  : String);
      --  Extract next File_Pattern from Suffix_Path and call Read routine
      --  above.
 
      ----------------
      -- Next_Level --
      ----------------
 
      procedure Next_Level
        (Current_Path : String;
         Suffix_Path  : String)
      is
         DS : Natural;
         SP : String renames Suffix_Path;
 
      begin
         if SP'Length > 2
           and then SP (SP'First) = '.'
           and then Strings.Maps.Is_In (SP (SP'First + 1), Dir_Seps)
         then
            --  Starting with "./"
 
            DS := Strings.Fixed.Index
              (SP (SP'First + 2 .. SP'Last),
               Dir_Seps);
 
            if DS = 0 then
 
               --  We have "./"
 
               Read (Current_Path & ".", "*", "");
 
            else
               --  We have "./dir"
 
               Read (Current_Path & ".",
                     SP (SP'First + 2 .. DS - 1),
                     SP (DS .. SP'Last));
            end if;
 
         elsif SP'Length > 3
           and then SP (SP'First .. SP'First + 1) = ".."
           and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
         then
            --  Starting with "../"
 
            DS := Strings.Fixed.Index
                    (SP (SP'First + 3 .. SP'Last), Dir_Seps);
 
            if DS = 0 then
 
               --  We have "../"
 
               Read (Current_Path & "..", "*", "");
 
            else
               --  We have "../dir"
 
               Read (Current_Path & "..",
                     SP (SP'First + 3 .. DS - 1),
                     SP (DS .. SP'Last));
            end if;
 
         elsif Current_Path = ""
           and then SP'Length > 1
           and then Characters.Handling.Is_Letter (SP (SP'First))
           and then SP (SP'First + 1) = ':'
         then
            --  Starting with "<drive>:"
 
            if SP'Length > 2
              and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
            then
               --  Starting with "<drive>:\"
 
               DS :=  Strings.Fixed.Index
                        (SP (SP'First + 3 .. SP'Last), Dir_Seps);
 
               if DS = 0 then
 
                  --  We have "<drive>:\dir"
 
                  Read (SP (SP'First .. SP'First + 2),
                        SP (SP'First + 3 .. SP'Last),
                        "");
 
               else
                  --  We have "<drive>:\dir\kkk"
 
                  Read (SP (SP'First .. SP'First + 2),
                        SP (SP'First + 3 .. DS - 1),
                        SP (DS .. SP'Last));
               end if;
 
            else
               --  Starting with "<drive>:" and the drive letter not followed
               --  by a directory separator. The proper semantic on Windows is
               --  to read the content of the current selected directory on
               --  this drive. For example, if drive C current selected
               --  directory is c:\temp the suffix pattern "c:m*" is
               --  equivalent to c:\temp\m*.
 
               DS :=  Strings.Fixed.Index
                        (SP (SP'First + 2 .. SP'Last), Dir_Seps);
 
               if DS = 0 then
 
                  --  We have "<drive>:dir"
 
                  Read (SP, "", "");
 
               else
                  --  We have "<drive>:dir/kkk"
 
                  Read (SP (SP'First .. DS - 1), "", SP (DS .. SP'Last));
               end if;
            end if;
 
         elsif Strings.Maps.Is_In (SP (SP'First), Dir_Seps) then
 
            --  Starting with a /
 
            DS := Strings.Fixed.Index
                    (SP (SP'First + 1 .. SP'Last), Dir_Seps);
 
            if DS = 0 then
 
               --  We have "/dir"
 
               Read (Current_Path, SP (SP'First + 1 .. SP'Last), "");
            else
               --  We have "/dir/kkk"
 
               Read (Current_Path,
                     SP (SP'First + 1 .. DS - 1),
                     SP (DS .. SP'Last));
            end if;
 
         else
            --  Starting with a name
 
            DS := Strings.Fixed.Index (SP, Dir_Seps);
 
            if DS = 0 then
 
               --  We have "dir"
 
               Read (Current_Path & '.', SP, "");
            else
               --  We have "dir/kkk"
 
               Read (Current_Path & '.',
                     SP (SP'First .. DS - 1),
                     SP (DS .. SP'Last));
            end if;
 
         end if;
      end Next_Level;
 
      ----------
      -- Read --
      ----------
 
      Quit : Boolean := False;
      --  Global state to be able to exit all recursive calls
 
      procedure Read
        (Directory      : String;
         File_Pattern   : String;
         Suffix_Pattern : String)
      is
         File_Regexp : constant Regexp.Regexp :=
                         Regexp.Compile (File_Pattern, Glob => True);
 
         Dir : Dir_Type;
         pragma Warnings (Off, Dir);
 
         Buffer : String (1 .. 2_048);
         Last   : Natural;
 
      begin
         if OS_Lib.Is_Directory (Directory & Dir_Separator) then
            Open (Dir, Directory & Dir_Separator);
 
            Dir_Iterator : loop
               Read (Dir, Buffer, Last);
               exit Dir_Iterator when Last = 0;
 
               declare
                  Dir_Entry : constant String := Buffer (1 .. Last);
                  Pathname  : constant String :=
                                Directory & Dir_Separator & Dir_Entry;
               begin
                  --  Handle "." and ".." only if explicit use in the
                  --  File_Pattern.
 
                  if not
                    ((Dir_Entry = "." and then File_Pattern /= ".")
                       or else
                     (Dir_Entry = ".." and then File_Pattern /= ".."))
                  then
                     if Regexp.Match (Dir_Entry, File_Regexp) then
                        if Suffix_Pattern = "" then
 
                           --  No more matching needed, call user's callback
 
                           Index := Index + 1;
 
                           begin
                              Action (Pathname, Index, Quit);
                           exception
                              when others =>
                                 Close (Dir);
                                 raise;
                           end;
 
                        else
                           --  Down one level
 
                           Next_Level
                             (Directory & Dir_Separator & Dir_Entry,
                              Suffix_Pattern);
                        end if;
                     end if;
                  end if;
               end;
 
               --  Exit if Quit set by call to Action, either at this level
               --  or at some lower recursive call to Next_Level.
 
               exit Dir_Iterator when Quit;
            end loop Dir_Iterator;
 
            Close (Dir);
         end if;
      end Read;
 
   --  Start of processing for Wildcard_Iterator
 
   begin
      if Path = "" then
         return;
      end if;
 
      Next_Level ("", Path);
   end Wildcard_Iterator;
 
end GNAT.Directory_Operations.Iteration;

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [g-diopit.adb] - Blame information for rev 311

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;`