===================================================================
@@ -9762,6 +9762,12 @@
-- Error, or warning within an instance, if the static accessibility
-- rules of 3.10.2 are violated.
+ function Declared_Within_Generic_Unit
+ (Entity : Entity_Id;
+ Generic_Unit : Node_Id) return Boolean;
+ -- Returns True if Declared_Entity is declared within the declarative
+ -- region of Generic_Unit; otherwise returns False.
+
---------------------------
-- Accessibility_Message --
---------------------------
@@ -9811,6 +9817,33 @@
end if;
end Accessibility_Message;
+ ----------------------------------
+ -- Declared_Within_Generic_Unit --
+ ----------------------------------
+
+ function Declared_Within_Generic_Unit
+ (Entity : Entity_Id;
+ Generic_Unit : Node_Id) return Boolean
+ is
+ Generic_Encloser : Node_Id := Enclosing_Generic_Unit (Entity);
+
+ begin
+ while Present (Generic_Encloser) loop
+ if Generic_Encloser = Generic_Unit then
+ return True;
+ end if;
+
+ -- We have to step to the scope of the generic's entity, because
+ -- otherwise we'll just get back the same generic.
+
+ Generic_Encloser :=
+ Enclosing_Generic_Unit
+ (Scope (Defining_Entity (Generic_Encloser)));
+ end loop;
+
+ return False;
+ end Declared_Within_Generic_Unit;
+
-- Start of processing for Resolve_Attribute
begin
@@ -10058,11 +10091,11 @@
-- level of the actual type is not known). This restriction
-- does not apply when the attribute type is an anonymous
-- access-to-subprogram type. Note that this check was
- -- revised by AI-229, because the originally Ada 95 rule
+ -- revised by AI-229, because the original Ada 95 rule
-- was too lax. The original rule only applied when the
-- subprogram was declared within the body of the generic,
-- which allowed the possibility of dangling references).
- -- The rule was also too strict in some case, in that it
+ -- The rule was also too strict in some cases, in that it
-- didn't permit the access to be declared in the generic
-- spec, whereas the revised rule does (as long as it's not
-- a formal type).
@@ -10106,13 +10139,15 @@
then
-- The attribute type's ultimate ancestor must be
-- declared within the same generic unit as the
- -- subprogram is declared. The error message is
+ -- subprogram is declared (including within another
+ -- nested generic unit). The error message is
-- specialized to say "ancestor" for the case where the
-- access type is not its own ancestor, since saying
-- simply "access type" would be very confusing.
- if Enclosing_Generic_Unit (Entity (P)) /=
- Enclosing_Generic_Unit (Root_Type (Btyp))
+ if not Declared_Within_Generic_Unit
+ (Root_Type (Btyp),
+ Enclosing_Generic_Unit (Entity (P)))
then
Error_Msg_N
("''Access attribute not allowed in generic body",
When the Access attribute is applied within a generic body to a prefix that denotes a subprogram declared in an enclosing generic unit, the compiler rejects this as a violation of the rule in the last sentence of RM 3.10.2(32/3). This is happening because the compiler is requiring both the access type and subprogram to be declared within the same enclosing generic unit, but it should be allowing the type to be anywhere within the declarative part of the generic unit where the subprogram is declared. The compiler must issue this output for the test below (based on ACATS B3A2017) using the command 'gcc -c -gnatd70 generic_subp_access.adb', flagging only the lines marked 'ERROR': generic_subp_access.adb:42:22: 'Access attribute not allowed in generic body, because access type "Ref" is declared outside generic unit (RM 3.10.2(32)), move 'Access to private part, or (Ada 2005) use anonymous access type instead of "Ref" generic_subp_access.adb:44:15: subprogram must not be deeper than access type generic_subp_access.adb:48:19: 'Access attribute not allowed in generic body, because access type "Ref" is declared outside generic unit (RM 3.10.2(32)), move 'Access to private part, or (Ada 2005) use anonymous access type instead of "Ref" generic_subp_access.adb:50:12: subprogram must not be deeper than access type ---- procedure Generic_Subp_Access is package Pkg is type Ref is access procedure; P, Q, R : Ref; end Pkg; generic type Formal_Subp_Acc is access procedure; package Outer_Generic is procedure Foo; generic package Inner_Generic is type Inner_Ref is access procedure; Y : Inner_Ref; end Inner_Generic; end Outer_Generic; package body Outer_Generic is X : Natural := 0; type Local_Ref is access procedure; W : Local_Ref; V : Formal_Subp_Acc; procedure Foo is begin X := X + 1; end Foo; package body Inner_Generic is M : Formal_Subp_Acc; begin Pkg.Q := Foo'Access; -- ERROR Y := Foo'Access; -- OK (was incorrectly flagged as an error) M := Foo'Access; -- ERROR end Inner_Generic; begin Pkg.P := Foo'Access; -- ERROR W := Foo'Access; -- OK V := Foo'Access; -- ERROR end Outer_Generic; begin null; end Generic_Subp_Access; Tested on x86_64-pc-linux-gnu, committed on trunk 2015-01-30 Gary Dismukes <dismukes@adacore.com> * sem_attr.adb (Declared_Within_Generic_Unit): New function to test whether an entity is declared within the declarative region of a given generic unit. (Resolve_Attribute): For checking legality of subprogram'Access within a generic unit, call new Boolean function Declared_Within_Generic_Unit instead of simply comparing the results of Enclosing_Generic_Unit on the prefix and access type. Correct minor comment typos.