The compiler was incorrectly generating an unconditional raise of
Program_Error (and associated warnings) for returning a component with an
anonymous access type within a function of a generic instance. The code
that was performing this check was intended to apply only to anonymous
access discriminants (as indicated by comments) but neglected to test
whether the selected component was a discriminant. This was ancient code
that was implemented prior to Ada 2005's additions of anonymous access
types for components and stand-alone objects. The fix refines the test
so that it only applies to access discriminants.
The following test must compile quietly:
$ gcc -c anonymous_instance.ads
----
generic
package Anonymous_Generic is
type Holder is tagged limited private;
function Get_Ref_Named (This : in Holder) return not null access Integer;
function Get_Ref_Anon (This : in Holder) return not null access Integer;
private
type Integer_Access is access all Integer;
type Holder is tagged limited record
M_Named : Integer_Access := new Integer'(1);
M_Anon : access Integer := new Integer'(2);
end record;
end Anonymous_Generic;
package body Anonymous_Generic is
function Get_Ref_Named (This : in Holder) return not null access Integer is
begin
return This.M_Named;
end Get_Ref_Named;
function Get_Ref_Anon (This : in Holder) return not null access Integer is
begin
return This.M_Anon;
end Get_Ref_Anon;
end Anonymous_Generic;
with Anonymous_Generic;
package Anonymous_Instance is new Anonymous_Generic;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-11-08 Gary Dismukes <[email protected]>
* exp_ch4.adb (Expand_N_Type_Conversion): Add test that the selector
name is a discriminant in check for unconditional accessibility
violation within instances.
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 254542)
+++ exp_ch4.adb (working copy)
@@ -11279,6 +11279,7 @@
elsif In_Instance_Body
and then Ekind (Operand_Type) = E_Anonymous_Access_Type
and then Nkind (Operand) = N_Selected_Component
+ and then Ekind (Entity (Selector_Name (Operand))) = E_Discriminant
and then Object_Access_Level (Operand) >
Type_Access_Level (Target_Type)
then
