Ada 2005 allows the declaration of an access to function whose return type is
itself an access to function, etc. Each anonymous access type generated for
this pathological construct has a scope which is the scope of the current
declaration.
The following must compile quietly in Ada 2005 mode, and output:
It works
It works
It works
---
with Text_IO; use Text_IO;
function G return Integer is
procedure Proc is
begin
Put_Line ("It works");
end Proc;
function G0 return access procedure is
begin
return Proc'access;
end;
function G1 return access function return access procedure is
begin
return G0'access;
end G1;
function G2 return access function return
access function return access procedure is
begin
return G1'access;
end G2;
begin
G0.all;
G1.all.all;
G2.all.all.all;
return 0;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-11-21 Ed Schonberg <[email protected]>
* sem_ch3.adb (Access_Definition): If the access definition
is itself the return type of an access to function definition
which is ultimately the return type of an access to subprogram
declaration, its scope is the enclosing scope of the ultimate
access to subprogram.
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 181567)
+++ sem_ch3.adb (working copy)
@@ -726,13 +726,33 @@
-- If the access definition is the return type of another access to
-- function, scope is the current one, because it is the one of the
- -- current type declaration.
+ -- current type declaration, except for the pathological case below.
if Nkind_In (Related_Nod, N_Object_Declaration,
N_Access_Function_Definition)
then
Anon_Scope := Current_Scope;
+ -- A pathological case: function returning access functions that
+ -- return access functions, etc. Each anonymous access type created
+ -- is in the enclosing scope of the outermost function.
+
+ declare
+ Par : Node_Id;
+ begin
+ Par := Related_Nod;
+ while Nkind_In (Par,
+ N_Access_Function_Definition,
+ N_Access_Definition)
+ loop
+ Par := Parent (Par);
+ end loop;
+
+ if Nkind (Par) = N_Function_Specification then
+ Anon_Scope := Scope (Defining_Entity (Par));
+ end if;
+ end;
+
-- For the anonymous function result case, retrieve the scope of the
-- function specification's associated entity rather than using the
-- current scope. The current scope will be the function itself if the
