2009-04-08 Robert Dewar <dewar@adacore.com>

	* exp_attr.adb, sem_attr.adb, sem_util.adb: Code clean up.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@145741 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f9afe51..80c2376 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,9 @@
 2009-04-08  Robert Dewar  <dewar@adacore.com>
 
+       * exp_attr.adb, sem_attr.adb, sem_util.adb: Code clean up.
+
+2009-04-08  Robert Dewar  <dewar@adacore.com>
+
        * sem_cat.adb (Check_Categorization_Dependencies): Handle Preelaborate
        properly in the presence of Remote_Types or Remote_Call_Interface.
 

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 04e7a0b..7f82cde 100644 (file)
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -867,7 +867,9 @@ package body Exp_Attr is
             --  If the prefix of an Access attribute is a dereference of an
             --  access parameter (or a renaming of such a dereference, or a
             --  subcomponent of such a dereference) and the context is a
-            --  general access type (but not an anonymous access type), then
+            --  general access type (including the type of an object or
+            --  component with an access_definition, but not the anonymous
+            --  type of an access parameter or access discriminant), then
             --  apply an accessibility check to the access parameter. We used
             --  to rewrite the access parameter as a type conversion, but that
             --  could only be done if the immediate prefix of the Access
@@ -882,7 +884,8 @@ package body Exp_Attr is
             elsif Id = Attribute_Access
               and then Nkind (Enc_Object) = N_Explicit_Dereference
               and then Is_Entity_Name (Prefix (Enc_Object))
-              and then Ekind (Btyp) = E_General_Access_Type
+              and then (Ekind (Btyp) = E_General_Access_Type
+                         or else Is_Local_Anonymous_Access (Btyp))
               and then Ekind (Entity (Prefix (Enc_Object))) in Formal_Kind
               and then Ekind (Etype (Entity (Prefix (Enc_Object))))
                          = E_Anonymous_Access_Type

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 533c8b4..014f0ca 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -713,8 +713,7 @@ package body Sem_Attr is
                then
                   null;
 
-               --  OK if reference to the current instance of a protected
-               --  object.
+               --  OK if reference to current instance of a protected object
 
                elsif Is_Protected_Self_Reference (P) then
                   null;
@@ -1651,8 +1650,8 @@ package body Sem_Attr is
 
          elsif Is_Protected_Self_Reference (P) then
             Error_Attr_P
-              ("prefix of % attribute denotes current instance " &
-                 "(RM 9.4(21/2))");
+              ("prefix of % attribute denotes current instance "
+               & "(RM 9.4(21/2))");
 
          elsif Ekind (Entity (P)) = E_Incomplete_Type
             and then Present (Full_View (Entity (P)))
@@ -2021,8 +2020,8 @@ package body Sem_Attr is
          --  applies to other entity-denoting expressions.
 
          if Is_Protected_Self_Reference (P) then
-            --  An Address attribute on a protected object self reference
-            --  is legal.
+
+            --  Address attribute on a protected object self reference is legal
 
             null;
 

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 4876303..34ad212 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -6383,8 +6383,8 @@ package body Sem_Util is
    -- Is_Protected_Self_Reference --
    ---------------------------------
 
-   function Is_Protected_Self_Reference (N : Node_Id) return Boolean
-   is
+   function Is_Protected_Self_Reference (N : Node_Id) return Boolean is
+
       function In_Access_Definition (N : Node_Id) return Boolean;
       --  Returns true if N belongs to an access definition
 
@@ -6392,16 +6392,19 @@ package body Sem_Util is
       -- In_Access_Definition --
       --------------------------
 
-      function In_Access_Definition (N : Node_Id) return Boolean
-      is
-         P : Node_Id := Parent (N);
+      function In_Access_Definition (N : Node_Id) return Boolean is
+         P : Node_Id;
+
       begin
+         P := Parent (N);
          while Present (P) loop
             if Nkind (P) = N_Access_Definition then
                return True;
             end if;
+
             P := Parent (P);
          end loop;
+
          return False;
       end In_Access_Definition;