Ada: Fix missing implicit dereference for access-to-protected used as prefix

... of access-related attribute.  This is a regression present on all active
branches caused by a local resolution of the N_Selected_Component node.

gcc/ada/
	PR ada/124226
	* sem_res.adb (Resolve_Implicit_Dereference): Move declaration to...
	* sem_res.ads (Resolve_Implicit_Dereference): ...here.
	* sem_attr.adb (Resolve_Attribute) <Attribute_Access>: Also call
	Resolve_Implicit_Dereference when resolving a protected operation.

gcc/testsuite/
	* gnat.dg/protected_deref1.adb: New test.

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index d1f9e5e46e1d6519424f7ae1f5b1649087e35288..90eb682a09446c71b841798964f16da836425fc4 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -11888,6 +11888,7 @@ package body Sem_Attr is
                end if;
 
                Resolve (Prefix (P));
+               Resolve_Implicit_Dereference (Prefix (P));
 
                if not Is_Overloaded (P) then
                   Generate_Reference (Entity (Selector_Name (P)), P);

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 96a67247d2d959ebf892208b06764c10b183b06f..43ff97cd8c823a17cf01ec0e4d506371cd57a851 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -275,12 +275,6 @@ package body Sem_Res is
    --  is the context type, which is used when the operation is a protected
    --  function with no arguments, and the return value is indexed.
 
-   procedure Resolve_Implicit_Dereference (P : Node_Id);
-   --  Called when P is the prefix of an indexed component, or of a selected
-   --  component, or of a slice. If P is of an access type, we unconditionally
-   --  rewrite it as an explicit dereference. This ensures that the expander
-   --  and the code generator have a fully explicit tree to work with.
-
    procedure Resolve_Intrinsic_Operator (N : Node_Id; Typ : Entity_Id);
    --  A call to a user-defined intrinsic operator is rewritten as a call to
    --  the corresponding predefined operator, with suitable conversions. Note

diff --git a/gcc/ada/sem_res.ads b/gcc/ada/sem_res.ads
index c364c190baa21468dcec3092c5c0a47af9f7ab46..77324846d9837935c8ad91aa65347ca79c7b18e1 100644 (file)
--- a/gcc/ada/sem_res.ads
+++ b/gcc/ada/sem_res.ads
@@ -133,6 +133,12 @@ package Sem_Res is
    --  own type. For now we assume that the prefix cannot be overloaded and
    --  the name of the entry plays no role in the resolution.
 
+   procedure Resolve_Implicit_Dereference (P : Node_Id);
+   --  Called when P is the prefix of an indexed component, or of a selected
+   --  component, or of a slice. If P is of an access type, we unconditionally
+   --  rewrite it as an explicit dereference. This ensures that the expander
+   --  and the code generator have a fully explicit tree to work with.
+
    procedure Resolve_Membership_Equality (N : Node_Id; Typ : Entity_Id);
    --  Resolve the equality operator in an individual membership test
 

diff --git a/gcc/testsuite/gnat.dg/protected_deref1.adb b/gcc/testsuite/gnat.dg/protected_deref1.adb
new file mode 100644 (file)
index 0000000..361be93
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/protected_deref1.adb
@@ -0,0 +1,32 @@
+-- { dg-do run }
+
+with Ada.Text_IO;
+
+procedure Protected_Deref1 is
+
+   protected type Fallback_Hit_Counter_Type is
+      procedure Handler;
+   end Fallback_Hit_Counter_Type;
+
+   protected body Fallback_Hit_Counter_Type is
+      procedure Handler is
+      begin
+         Ada.Text_IO.Put_Line ("Test");
+      end Handler;
+   end Fallback_Hit_Counter_Type;
+
+   Fallback_Hit_Counter : access Fallback_Hit_Counter_Type :=
+     new Fallback_Hit_Counter_Type;
+
+   type X is access protected procedure;
+
+   A : X := Fallback_Hit_Counter.all.Handler'Access;
+   B : X := Fallback_Hit_Counter.Handler'Access;
+
+begin
+   A.all;
+   B.all;
+   if A /= B then
+      raise Program_Error;
+   end if;
+end;