[Ada] Missing accessibility check in anonymous access types

[Arnaud Charlet]

The compiler does not handle well the accessibility check of anonymous
access types that are formals of anonymous access to subprogram
components of record types. The execution of the program may
crash or have unexpected behavior since the check is performed
with an expected actual (the accessibility level) which is not
passed by the caller.

After this patch the following test executes without errors.

with Text_IO; use Text_IO;
procedure Cutdown is

    type Self_Ref;
    type Self_Ref is record
        Ptr : access procedure (X: access Self_Ref);
    end record;

    Ptr : access Self_Ref;

    procedure Foo (Xxx : access Self_Ref) is
    begin
       --  Accessibility check required for this assignment

       Ptr := Xxx;
    end Foo;

    procedure Nested is
       Yyy : aliased Self_Ref := (Ptr => Foo'Access);

    begin
       Yyy.Ptr.all (Yyy'Access); --  must raise PE
       Put_Line ("Test failed");
    exception
       when Program_Error =>
          null;
    end;

begin
   Nested;
end;

Command: gnatmake -gnat05 cutdown.adb; ./cutdown

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

2011-08-02  Javier Miranda  <mira...@adacore.com>

        * sem_ch3.adb (Check_Anonymous_Access_Components): Create extra formals
        associated with anonymous access to subprograms.


Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 177139)
+++ sem_ch3.adb (working copy)
@@ -18760,7 +18760,7 @@
             --  an access_to_object or an access_to_subprogram.
 
             if Present (Acc_Def) then
-               if Nkind  (Acc_Def) = N_Access_Function_Definition then
+               if Nkind (Acc_Def) = N_Access_Function_Definition then
                   Type_Def :=
                     Make_Access_Function_Definition (Loc,
                       Parameter_Specifications =>
@@ -18799,10 +18799,15 @@
             Insert_Before (Typ_Decl, Decl);
             Analyze (Decl);
 
-            --  If an access to object, Preserve entity of designated type,
+            --  If an access to subprogram, create the extra formals
+
+            if Present (Acc_Def) then
+               Create_Extra_Formals (Designated_Type (Anon_Access));
+
+            --  If an access to object, preserve entity of designated type,
             --  for ASIS use, before rewriting the component definition.
 
-            if No (Acc_Def) then
+            else
                declare
                   Desig : Entity_Id;