===================================================================
@@ -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;
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 <miranda@adacore.com> * sem_ch3.adb (Check_Anonymous_Access_Components): Create extra formals associated with anonymous access to subprograms.