[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
This commit is contained in:
Ed Schonberg 2018-05-23 10:22:03 +00:00 committed by Pierre-Marie de Rodat
parent 87843c8388
commit 728fedc29c
2 changed files with 23 additions and 0 deletions

View file

@ -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.

View file

@ -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;