lib-xref.adb (Output_Refs): Don't output type references outside the main unit if...
* 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 From-SVN: r47901
This commit is contained in:
Geert Bosch
parent
81217be921
commit
0873bafcaa
@ -1,3 +1,32 @@
|
||||
2001-12-11 Robert Dewar <dewar@gnat.com>
|
||||
|
||||
* lib-xref.adb (Output_Refs): Don't output type references outside
|
||||
the main unit if they are not otherwise referenced.
|
||||
|
||||
2001-12-11 Ed Schonberg <schonber@gnat.com>
|
||||
|
||||
* 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.
|
||||
|
||||
2001-12-11 Vincent Celier <celier@gnat.com>
|
||||
|
||||
* 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
|
||||
|
||||
2001-12-11 Richard Kenner <dewar@gnat.com>
|
||||
|
||||
* sem_attr.adb: Minor reformatting
|
||||
|
||||
2001-12-11 Ed Schonberg <schonber@gnat.com>
|
||||
|
||||
* sem_ch3.adb: Clarify some ???.
|
||||
|
||||
@ -1666,6 +1666,7 @@ GNATRTL_NONTASKING_OBJS= \
|
||||
g-curexc.o \
|
||||
g-debuti.o \
|
||||
g-debpoo.o \
|
||||
g-diopit.o \
|
||||
g-dirope.o \
|
||||
g-except.o \
|
||||
g-exctra.o \
|
||||
@ -3171,10 +3172,18 @@ g-comlin.o : ada.ads a-comlin.ads a-except.ads a-finali.ads a-filico.ads \
|
||||
s-parame.ads s-secsta.ads s-soflin.ads s-stache.ads s-stalib.ads \
|
||||
s-stoele.ads s-stratt.ads s-strops.ads s-unstyp.ads unchconv.ads
|
||||
|
||||
g-diopit.o : ada.ads a-charac.ads a-chahan.ads a-chlat1.ads a-except.ads \
|
||||
a-finali.ads a-filico.ads a-stream.ads a-string.ads a-strfix.ads \
|
||||
a-strmap.ads a-tags.ads gnat.ads g-dirope.ads g-dirope.adb \
|
||||
g-os_lib.ads g-regexp.ads system.ads s-exctab.ads s-finimp.ads \
|
||||
s-finroo.ads s-parame.ads s-secsta.ads s-soflin.ads s-stache.ads \
|
||||
s-stalib.ads s-stoele.ads s-stratt.ads s-strops.ads s-unstyp.ads \
|
||||
unchconv.ads unchdeal.ads
|
||||
|
||||
g-dirope.o : ada.ads a-charac.ads a-chahan.ads a-chlat1.ads a-except.ads \
|
||||
a-finali.ads a-filico.ads a-stream.ads a-string.ads a-strfix.ads \
|
||||
a-strmap.ads a-strunb.ads a-tags.ads gnat.ads g-dirope.ads g-dirope.adb \
|
||||
g-os_lib.ads g-regexp.ads system.ads s-exctab.ads s-finimp.ads \
|
||||
a-strmap.ads a-tags.ads gnat.ads g-dirope.ads g-dirope.adb \
|
||||
g-os_lib.ads system.ads s-exctab.ads s-finimp.ads \
|
||||
s-finroo.ads s-parame.ads s-secsta.ads s-soflin.ads s-stache.ads \
|
||||
s-stalib.ads s-stoele.ads s-stratt.ads s-strops.ads s-unstyp.ads \
|
||||
unchconv.ads unchdeal.ads
|
||||
|
||||
394
gcc/ada/g-diopit.adb
Normal file
394
gcc/ada/g-diopit.adb
Normal file
@ -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;
|
||||
95
gcc/ada/g-diopit.ads
Normal file
95
gcc/ada/g-diopit.ads
Normal file
@ -0,0 +1,95 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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 --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- $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). --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- Iterators among files
|
||||
|
||||
package GNAT.Directory_Operations.Iteration is
|
||||
|
||||
generic
|
||||
with procedure Action
|
||||
(Item : String;
|
||||
Index : Positive;
|
||||
Quit : in out Boolean);
|
||||
procedure Find
|
||||
(Root_Directory : Dir_Name_Str;
|
||||
File_Pattern : String);
|
||||
-- Recursively searches the directory structure rooted at Root_Directory.
|
||||
-- This provides functionality similar to the UNIX 'find' command.
|
||||
-- Action will be called for every item matching the regular expression
|
||||
-- File_Pattern (see GNAT.Regexp). Item is the full pathname to the file
|
||||
-- starting with Root_Directory that has been matched. Index is set to one
|
||||
-- for the first call and is incremented by one at each call. The iterator
|
||||
-- will pass in the value False on each call to Action. The iterator will
|
||||
-- terminate after passing the last matched path to Action or after
|
||||
-- returning from a call to Action which sets Quit to True.
|
||||
-- Raises GNAT.Regexp.Error_In_Regexp if File_Pattern is ill formed.
|
||||
|
||||
generic
|
||||
with procedure Action
|
||||
(Item : String;
|
||||
Index : Positive;
|
||||
Quit : in out Boolean);
|
||||
procedure Wildcard_Iterator (Path : Path_Name);
|
||||
-- Calls Action for each path matching Path. Path can include wildcards '*'
|
||||
-- and '?' and [...]. The rules are:
|
||||
--
|
||||
-- * can be replaced by any sequence of characters
|
||||
-- ? can be replaced by a single character
|
||||
-- [a-z] match one character in the range 'a' through 'z'
|
||||
-- [abc] match either character 'a', 'b' or 'c'
|
||||
--
|
||||
-- Item is the filename that has been matched. Index is set to one for the
|
||||
-- first call and is incremented by one at each call. The iterator's
|
||||
-- termination can be controlled by setting Quit to True. It is by default
|
||||
-- set to False.
|
||||
--
|
||||
-- For example, if we have the following directory structure:
|
||||
-- /boo/
|
||||
-- foo.ads
|
||||
-- /sed/
|
||||
-- foo.ads
|
||||
-- file/
|
||||
-- foo.ads
|
||||
-- /sid/
|
||||
-- foo.ads
|
||||
-- file/
|
||||
-- foo.ads
|
||||
-- /life/
|
||||
--
|
||||
-- A call with expression "/s*/file/*" will call Action for the following
|
||||
-- items:
|
||||
-- /sed/file/foo.ads
|
||||
-- /sid/file/foo.ads
|
||||
|
||||
end GNAT.Directory_Operations.Iteration;
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- $Revision: 1.2 $
|
||||
-- $Revision$
|
||||
-- --
|
||||
-- Copyright (C) 1998-2001 Ada Core Technologies, Inc. --
|
||||
-- --
|
||||
@ -34,13 +34,11 @@
|
||||
|
||||
with Ada.Characters.Handling;
|
||||
with Ada.Strings.Fixed;
|
||||
with Ada.Strings.Unbounded;
|
||||
with Ada.Strings.Maps;
|
||||
with Unchecked_Deallocation;
|
||||
with Unchecked_Conversion;
|
||||
with System; use System;
|
||||
|
||||
with GNAT.Regexp;
|
||||
with GNAT.OS_Lib;
|
||||
|
||||
package body GNAT.Directory_Operations is
|
||||
@ -51,10 +49,6 @@ package body GNAT.Directory_Operations is
|
||||
-- This is the low-level address directory structure as returned by the C
|
||||
-- opendir routine.
|
||||
|
||||
Dir_Seps : constant Strings.Maps.Character_Set :=
|
||||
Strings.Maps.To_Set ("/\");
|
||||
-- UNIX and DOS style directory separators.
|
||||
|
||||
procedure Free is new
|
||||
Unchecked_Deallocation (Dir_Type_Value, Dir_Type);
|
||||
|
||||
@ -220,7 +214,16 @@ package body GNAT.Directory_Operations is
|
||||
-----------------
|
||||
|
||||
function Expand_Path (Path : Path_Name) return String is
|
||||
use Ada.Strings.Unbounded;
|
||||
|
||||
Result : OS_Lib.String_Access := new String (1 .. 200);
|
||||
Result_Last : Natural := 0;
|
||||
|
||||
procedure Append (C : Character);
|
||||
procedure Append (S : String);
|
||||
-- Append to Result
|
||||
|
||||
procedure Double_Result_Size;
|
||||
-- Reallocate Result, doubling its size
|
||||
|
||||
procedure Read (K : in out Positive);
|
||||
-- Update Result while reading current Path starting at position K. If
|
||||
@ -230,10 +233,43 @@ package body GNAT.Directory_Operations is
|
||||
-- Translate variable name starting at position K with the associated
|
||||
-- environment value.
|
||||
|
||||
procedure Free is
|
||||
new Unchecked_Deallocation (String, OS_Lib.String_Access);
|
||||
------------
|
||||
-- Append --
|
||||
------------
|
||||
|
||||
Result : Unbounded_String;
|
||||
procedure Append (C : Character) is
|
||||
begin
|
||||
if Result_Last = Result'Last then
|
||||
Double_Result_Size;
|
||||
end if;
|
||||
|
||||
Result_Last := Result_Last + 1;
|
||||
Result (Result_Last) := C;
|
||||
end Append;
|
||||
|
||||
procedure Append (S : String) is
|
||||
begin
|
||||
while Result_Last + S'Length - 1 > Result'Last loop
|
||||
Double_Result_Size;
|
||||
end loop;
|
||||
|
||||
Result (Result_Last + 1 .. Result_Last + S'Length - 1) := S;
|
||||
Result_Last := Result_Last + S'Length - 1;
|
||||
end Append;
|
||||
|
||||
------------------------
|
||||
-- Double_Result_Size --
|
||||
------------------------
|
||||
|
||||
procedure Double_Result_Size is
|
||||
New_Result : constant OS_Lib.String_Access :=
|
||||
new String (1 .. 2 * Result'Last);
|
||||
|
||||
begin
|
||||
New_Result (1 .. Result_Last) := Result (1 .. Result_Last);
|
||||
OS_Lib.Free (Result);
|
||||
Result := New_Result;
|
||||
end Double_Result_Size;
|
||||
|
||||
----------
|
||||
-- Read --
|
||||
@ -253,7 +289,7 @@ package body GNAT.Directory_Operations is
|
||||
-- Not a variable after all, this is a double $, just
|
||||
-- insert one in the result string.
|
||||
|
||||
Append (Result, '$');
|
||||
Append ('$');
|
||||
K := K + 1;
|
||||
|
||||
else
|
||||
@ -266,13 +302,13 @@ package body GNAT.Directory_Operations is
|
||||
else
|
||||
-- We have an ending $ sign
|
||||
|
||||
Append (Result, '$');
|
||||
Append ('$');
|
||||
end if;
|
||||
|
||||
else
|
||||
-- This is a standard character, just add it to the result
|
||||
|
||||
Append (Result, Path (K));
|
||||
Append (Path (K));
|
||||
end if;
|
||||
|
||||
-- Skip to next character
|
||||
@ -311,15 +347,16 @@ package body GNAT.Directory_Operations is
|
||||
OS_Lib.Getenv (Path (K + 1 .. E - 1));
|
||||
|
||||
begin
|
||||
Append (Result, Env.all);
|
||||
Free (Env);
|
||||
Append (Env.all);
|
||||
OS_Lib.Free (Env);
|
||||
end;
|
||||
|
||||
else
|
||||
-- No closing curly bracket, not a variable after all or a
|
||||
-- syntax error, ignore it, insert string as-is.
|
||||
|
||||
Append (Result, '$' & Path (K .. E));
|
||||
Append ('$');
|
||||
Append (Path (K .. E));
|
||||
end if;
|
||||
|
||||
else
|
||||
@ -350,14 +387,15 @@ package body GNAT.Directory_Operations is
|
||||
Env : OS_Lib.String_Access := OS_Lib.Getenv (Path (K .. E));
|
||||
|
||||
begin
|
||||
Append (Result, Env.all);
|
||||
Free (Env);
|
||||
Append (Env.all);
|
||||
OS_Lib.Free (Env);
|
||||
end;
|
||||
|
||||
else
|
||||
-- This is not a variable after all
|
||||
|
||||
Append (Result, '$' & Path (E));
|
||||
Append ('$');
|
||||
Append (Path (E));
|
||||
end if;
|
||||
|
||||
end if;
|
||||
@ -373,7 +411,14 @@ package body GNAT.Directory_Operations is
|
||||
|
||||
begin
|
||||
Read (K);
|
||||
return To_String (Result);
|
||||
|
||||
declare
|
||||
Returned_Value : constant String := Result (1 .. Result_Last);
|
||||
|
||||
begin
|
||||
OS_Lib.Free (Result);
|
||||
return Returned_Value;
|
||||
end;
|
||||
end;
|
||||
end Expand_Path;
|
||||
|
||||
@ -413,91 +458,6 @@ package body GNAT.Directory_Operations is
|
||||
return Base_Name (Path);
|
||||
end File_Name;
|
||||
|
||||
----------
|
||||
-- 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;
|
||||
|
||||
---------------------
|
||||
-- Get_Current_Dir --
|
||||
---------------------
|
||||
@ -717,268 +677,4 @@ package body GNAT.Directory_Operations is
|
||||
rmdir (C_Dir_Name);
|
||||
end Remove_Dir;
|
||||
|
||||
-----------------------
|
||||
-- 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;
|
||||
|
||||
@ -751,7 +751,7 @@ package body Lib.Xref is
|
||||
|
||||
if Sloc (Tref) = Standard_Location then
|
||||
|
||||
-- For now, output only if speial -gnatdM flag set
|
||||
-- For now, output only if special -gnatdM flag set
|
||||
|
||||
exit when not Debug_Flag_MM;
|
||||
|
||||
@ -769,6 +769,14 @@ package body Lib.Xref is
|
||||
|
||||
exit when not (Debug_Flag_MM or else Left = '<');
|
||||
|
||||
-- Do not output type reference if referenced
|
||||
-- entity is not in the main unit and is itself
|
||||
-- not referenced, since otherwise the reference
|
||||
-- will dangle.
|
||||
|
||||
exit when not Referenced (Tref)
|
||||
and then not In_Extended_Main_Source_Unit (Tref);
|
||||
|
||||
-- Output the reference
|
||||
|
||||
Write_Info_Char (Left);
|
||||
|
||||
@ -1545,33 +1545,48 @@ package body Sem_Attr is
|
||||
-- get the proper value, but if expansion is not active, then
|
||||
-- the check here allows proper semantic analysis of the reference.
|
||||
|
||||
if (Is_Entity_Name (P)
|
||||
and then
|
||||
(((Ekind (Entity (P)) = E_Task_Type
|
||||
or else Ekind (Entity (P)) = E_Protected_Type)
|
||||
and then Etype (Entity (P)) = Base_Type (Entity (P)))
|
||||
or else Ekind (Entity (P)) = E_Package
|
||||
or else Is_Generic_Unit (Entity (P))))
|
||||
or else
|
||||
(Nkind (P) = N_Attribute_Reference
|
||||
and then
|
||||
Attribute_Name (P) = Name_AST_Entry)
|
||||
-- An Address attribute created by expansion is legal even when it
|
||||
-- applies to other entity-denoting expressions.
|
||||
|
||||
if (Is_Entity_Name (P)) then
|
||||
if Is_Subprogram (Entity (P))
|
||||
or else Is_Object (Entity (P))
|
||||
or else Ekind (Entity (P)) = E_Label
|
||||
then
|
||||
Set_Address_Taken (Entity (P));
|
||||
|
||||
elsif ((Ekind (Entity (P)) = E_Task_Type
|
||||
or else Ekind (Entity (P)) = E_Protected_Type)
|
||||
and then Etype (Entity (P)) = Base_Type (Entity (P)))
|
||||
or else Ekind (Entity (P)) = E_Package
|
||||
or else Is_Generic_Unit (Entity (P))
|
||||
then
|
||||
Rewrite (N,
|
||||
New_Occurrence_Of (RTE (RE_Null_Address), Sloc (N)));
|
||||
|
||||
else
|
||||
Error_Attr ("invalid prefix for % attribute", P);
|
||||
end if;
|
||||
|
||||
elsif Nkind (P) = N_Attribute_Reference
|
||||
and then Attribute_Name (P) = Name_AST_Entry
|
||||
then
|
||||
Rewrite (N,
|
||||
New_Occurrence_Of (RTE (RE_Null_Address), Sloc (N)));
|
||||
|
||||
-- The following logic is obscure, needs explanation ???
|
||||
elsif Is_Object_Reference (P) then
|
||||
null;
|
||||
|
||||
elsif Nkind (P) = N_Attribute_Reference
|
||||
or else (Is_Entity_Name (P)
|
||||
and then not Is_Subprogram (Entity (P))
|
||||
and then not Is_Object (Entity (P))
|
||||
and then Ekind (Entity (P)) /= E_Label)
|
||||
elsif Nkind (P) = N_Selected_Component
|
||||
and then Is_Subprogram (Entity (Selector_Name (P)))
|
||||
then
|
||||
Error_Attr ("invalid prefix for % attribute", P);
|
||||
null;
|
||||
|
||||
elsif Is_Entity_Name (P) then
|
||||
Set_Address_Taken (Entity (P));
|
||||
elsif not Comes_From_Source (N) then
|
||||
null;
|
||||
|
||||
else
|
||||
Error_Attr ("invalid prefix for % attribute", P);
|
||||
end if;
|
||||
|
||||
Set_Etype (N, RTE (RE_Address));
|
||||
@ -3138,22 +3153,21 @@ package body Sem_Attr is
|
||||
|
||||
if Is_Object_Reference (P)
|
||||
or else (Is_Entity_Name (P)
|
||||
and then
|
||||
Ekind (Entity (P)) = E_Function)
|
||||
and then Ekind (Entity (P)) = E_Function)
|
||||
then
|
||||
Check_Object_Reference (P);
|
||||
|
||||
elsif Nkind (P) = N_Attribute_Reference
|
||||
or else
|
||||
(Nkind (P) = N_Selected_Component
|
||||
and then (Is_Entry (Entity (Selector_Name (P)))
|
||||
or else
|
||||
Is_Subprogram (Entity (Selector_Name (P)))))
|
||||
or else
|
||||
(Is_Entity_Name (P)
|
||||
and then not Is_Type (Entity (P))
|
||||
and then not Is_Object (Entity (P)))
|
||||
elsif Is_Entity_Name (P)
|
||||
and then Is_Type (Entity (P))
|
||||
then
|
||||
null;
|
||||
|
||||
elsif Nkind (P) = N_Type_Conversion
|
||||
and then not Comes_From_Source (P)
|
||||
then
|
||||
null;
|
||||
|
||||
else
|
||||
Error_Attr ("invalid prefix for % attribute", P);
|
||||
end if;
|
||||
|
||||
@ -5490,7 +5504,7 @@ package body Sem_Attr is
|
||||
|
||||
when Attribute_Small =>
|
||||
|
||||
-- The floating-point case is present only for Ada 83 compatibility.
|
||||
-- The floating-point case is present only for Ada 83 compatability.
|
||||
-- Note that strictly this is an illegal addition, since we are
|
||||
-- extending an Ada 95 defined attribute, but we anticipate an
|
||||
-- ARG ruling that will permit this.
|
||||
@ -6511,24 +6525,6 @@ package body Sem_Attr is
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Do not permit address to be applied to entry
|
||||
|
||||
if (Is_Entity_Name (P) and then Is_Entry (Entity (P)))
|
||||
or else Nkind (P) = N_Entry_Call_Statement
|
||||
|
||||
or else (Nkind (P) = N_Selected_Component
|
||||
and then Is_Entry (Entity (Selector_Name (P))))
|
||||
|
||||
or else (Nkind (P) = N_Indexed_Component
|
||||
and then Nkind (Prefix (P)) = N_Selected_Component
|
||||
and then Is_Entry (Entity (Selector_Name (Prefix (P)))))
|
||||
then
|
||||
Error_Msg_Name_1 := Aname;
|
||||
Error_Msg_N
|
||||
("prefix of % attribute cannot be entry", N);
|
||||
return;
|
||||
end if;
|
||||
|
||||
if not Is_Entity_Name (P)
|
||||
or else not Is_Overloadable (Entity (P))
|
||||
then
|
||||
|
||||
@ -3053,7 +3053,7 @@ package body Sem_Util is
|
||||
else
|
||||
case Nkind (N) is
|
||||
when N_Indexed_Component | N_Slice =>
|
||||
return True;
|
||||
return Is_Object_Reference (Prefix (N));
|
||||
|
||||
-- In Ada95, a function call is a constant object.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user