[Ada] Compiler fails to reject illegal store of anonymous_access_to_subprogram

GNAT properly rejects an attempt to assign an access_to_subprogram formal
to a local variable, according to accessibiiity rules. This patch forces the
same behavior on the use of such a formal in an object declaration.

Compiling store_anon.adb must yield:

  store_anon.adb:7:35: illegal attempt to store anonymous access to subprogram
  store_anon.adb:7:35: value has deeper accessibility than any master
   (RM 3.10.2 (13))
 store_anon.adb:7:35: use named access type for "P" instead of access parameter

----
package Store_Anon is
   procedure Store (P : not null access procedure);

   procedure Invoke;
end Store_Anon;
----
package body Store_Anon is
   type P_Ptr is access procedure;

   Stored : P_Ptr;

   procedure Store (P : not null access procedure) is
      Illegal : constant P_Ptr := P;
   begin -- Store
      Stored := Illegal;
   end Store;

   procedure Invoke is
      -- Empty
   begin -- Invoke
      Stored.all;
   end Invoke;
end Store_Anon;

2018-05-23  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch3.adb (Analyze_Object_Declaration): If expression is an
	anonymous_access_to_ subprogram formal, apply a conversion to force an
	accsssibility check that will fail statically, enforcing 3.10.2 (13).

From-SVN: r260576

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8b656cd..723a7c1 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2018-05-23  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch3.adb (Analyze_Object_Declaration): If expression is an
+       anonymous_access_to_ subprogram formal, apply a conversion to force an
+       accsssibility check that will fail statically, enforcing 3.10.2 (13).
+
 2018-05-23  Daniel Mercier  <mercier@adacore.com>
 
        * gnat1drv.adb: Turn off length expansion in CodePeer mode.

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 747b3cd..965596a 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4268,6 +4268,23 @@ package body Sem_Ch3 is
             Set_Etype (E, T);
 
          else
+
+            --  If the expression is a formal that is a "subprogram pointer"
+            --  this is illegal in accessibility terms. Add an explicit
+            --  conversion to force the corresponding check, as is done for
+            --  assignments.
+
+            if Comes_From_Source (N)
+              and then Is_Entity_Name (E)
+              and then Present (Entity (E))
+              and then Is_Formal (Entity (E))
+              and then
+                Ekind (Etype (Entity (E))) = E_Anonymous_Access_Subprogram_Type
+              and then Ekind (T) /= E_Anonymous_Access_Subprogram_Type
+            then
+               Rewrite (E, Convert_To (T, Relocate_Node (E)));
+            end if;
+
             Resolve (E, T);
          end if;