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

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [ada/] [g-diopit.adb] - Blame information for rev 27

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-2005, 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;
 
      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
         Dir    : Dir_Type;
         Buffer : String (1 .. 2_048);
         Last   : Natural;
         Quit   : Boolean;
 
      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
                  Quit  := False;
                  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);
               end if;
            end;
         end loop;
 
         Close (Dir);
      end Read_Directory;
 
   begin
      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;
         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 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 scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [ada/] [g-diopit.adb] - Blame information for rev 27

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