re PR ada/36777 (Protected type cannot have access taken from its body.)

    gcc/ada/
	PR ada/36777
	* sem_util.ads, sem_util.adb (Is_Protected_Self_Reference): New.
	* sem_attr.adb (Check_Type): The current instance of a protected
	object is not a type name.
	(Analyze_Access_Attribute): Accept instances of protected objects.
	(Analyze_Attribute, Attribute_Address clause): Ditto.
	* exp_attr.adb (Expand_N_Attribute_Reference): Rewrite
	the prefix as being the current instance if needed.

    gcc/testsuite/
	PR ada/36777
	* gnat.dg/protected_self_ref1.adb, gnat.dg/protected_self_ref2.adb:
	New.

From-SVN: r139051

1 files changed, 36 insertions, 0 deletions

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 96e24a4..e1d042c 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -6372,6 +6372,42 @@ package body Sem_Util is
       end if;
    end Is_Potentially_Persistent_Type;
 
+   ---------------------------------
+   -- Is_Protected_Self_Reference --
+   ---------------------------------
+
+   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
+
+      --------------------------
+      -- In_Access_Definition --
+      --------------------------
+
+      function In_Access_Definition (N : Node_Id) return Boolean
+      is
+         P : Node_Id := Parent (N);
+      begin
+         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;
+
+   --  Start of processing for Is_Protected_Self_Reference
+
+   begin
+      return Ada_Version >= Ada_05
+        and then Is_Entity_Name (N)
+        and then Is_Protected_Type (Entity (N))
+        and then In_Open_Scopes (Entity (N))
+        and then not In_Access_Definition (N);
+   end Is_Protected_Self_Reference;
+
    -----------------------------
    -- Is_RCI_Pkg_Spec_Or_Body --
    -----------------------------