diff options
author | bosch <bosch@138bc75d-0d04-0410-961f-82ee72b054a4> | 2001-12-11 22:50:45 +0000 |
---|---|---|
committer | bosch <bosch@138bc75d-0d04-0410-961f-82ee72b054a4> | 2001-12-11 22:50:45 +0000 |
commit | 95a5c38ed22b3b3c3d1d7746f32453035b116cf7 (patch) | |
tree | b4ff6b95bcd0d7b38300eb8065cd673c688596c6 /gcc/ada/g-diopit.adb | |
parent | 3d236665245a6e17df6ffef3509fb709120b3a00 (diff) | |
download | gcc-95a5c38ed22b3b3c3d1d7746f32453035b116cf7.tar.gz |
* lib-xref.adb (Output_Refs): Don't output type references outside
the main unit if they are not otherwise referenced.
* sem_attr.adb (Analyze_attribute, case Address and Size): Simplify
code and diagnose additional illegal uses
* sem_util.adb (Is_Object_Reference): An indexed component is an
object only if the prefix is.
* g-diopit.adb: Initial version.
* g-diopit.ads: Initial version.
* g-dirope.adb:
(Expand_Path): Avoid use of Unbounded_String
(Find, Wildcard_Iterator): Moved to child package Iteration
* Makefile.in: Added g-diopit.o to GNATRTL_NONTASKING_OBJS
* sem_attr.adb: Minor reformatting
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@47901 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/g-diopit.adb')
-rw-r--r-- | gcc/ada/g-diopit.adb | 394 |
1 files changed, 394 insertions, 0 deletions
diff --git a/gcc/ada/g-diopit.adb b/gcc/ada/g-diopit.adb new file mode 100644 index 00000000000..69c7e4a41dc --- /dev/null +++ b/gcc/ada/g-diopit.adb @@ -0,0 +1,394 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- -- +-- $Revision$ +-- -- +-- Copyright (C) 2001 Ada Core Technologies, Inc. -- +-- -- +-- 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, 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 is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +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 + 4 .. 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 + + -- Se have "<drive>:\dir" + + Read (SP (SP'First .. SP'First + 1), + SP (SP'First + 3 .. SP'Last), + ""); + + else + -- We have "<drive>:\dir\kkk" + + Read (SP (SP'First .. SP'First + 1), + SP (SP'First + 3 .. DS - 1), + SP (DS .. SP'Last)); + end if; + + else + -- Starting with "<drive>:" + + DS := Strings.Fixed.Index + (SP (SP'First + 2 .. SP'Last), Dir_Seps); + + if DS = 0 then + + -- We have "<drive>:dir" + + Read (SP (SP'First .. SP'First + 1), + SP (SP'First + 2 .. SP'Last), + ""); + + else + -- We have "<drive>:dir/kkk" + + Read (SP (SP'First .. SP'First + 1), + SP (SP'First + 2 .. 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) then + Open (Dir, Directory); + + 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; + + exit Dir_Iterator when Quit; + + else + -- Down one level + + Next_Level + (Directory & Dir_Separator & Dir_Entry, + Suffix_Pattern); + end if; + end if; + end if; + end; + + exit Dir_Iterator when Quit; + + end loop Dir_Iterator; + + Close (Dir); + end if; + end Read; + + begin + Next_Level ("", Path); + end Wildcard_Iterator; + +end GNAT.Directory_Operations.Iteration; |