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

gcc/ada/ChangeLog

+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 ???.

gcc/ada/Makefile.in

@@ -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,14 +3172,22 @@ 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-dirope.o : ada.ads a-charac.ads a-chahan.ads a-chlat1.ads a-except.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-strunb.ads a-tags.ads gnat.ads g-dirope.ads g-dirope.adb \
+   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-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 
+
 get_targ.o : get_targ.ads get_targ.adb system.ads s-exctab.ads \
    s-stalib.ads types.ads unchconv.ads unchdeal.ads 
 

gcc/ada/g-diopit.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         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;

gcc/ada/lib-xref.adb

@@ -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);

gcc/ada/sem_attr.adb

@@ -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

gcc/ada/sem_util.adb

@@ -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.