[Ada] Compiler fails to reject illegal store of anonymous_access_to_subprogram

[Pierre-Marie de Rodat]

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;

Tested on x86_64-pc-linux-gnu, committed on trunk

2018-05-23  Ed Schonberg  <schonb...@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).
--- gcc/ada/sem_ch3.adb
+++ 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;