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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [g-diopit.adb] - Blame information for rev 778

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-2010, 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 3,  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.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- 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

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [g-diopit.adb] - Blame information for rev 778

Line No.	Rev	Author	Line
1	706	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-2010, 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`
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
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;`