summaryrefslogtreecommitdiff
path: root/gcc/ada/g-diopit.adb
diff options
context:
space:
mode:
authorbosch <bosch@138bc75d-0d04-0410-961f-82ee72b054a4>2001-12-11 22:50:45 +0000
committerbosch <bosch@138bc75d-0d04-0410-961f-82ee72b054a4>2001-12-11 22:50:45 +0000
commit95a5c38ed22b3b3c3d1d7746f32453035b116cf7 (patch)
treeb4ff6b95bcd0d7b38300eb8065cd673c688596c6 /gcc/ada/g-diopit.adb
parent3d236665245a6e17df6ffef3509fb709120b3a00 (diff)
downloadgcc-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.adb394
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;