This patch adds a missing case to the accessibility mechanism. The machinery can now recognize a rewritten interface conversion and properly extract the level of the operand.
------------ -- Source -- ------------ -- types.ads package Types is type Iface is limited interface; type Any_Iface_Ptr is access all Iface'Class; type Port_Type is tagged record Data : Any_Iface_Ptr; end record; procedure Connect (Port : in out Port_Type; Data : Any_Iface_Ptr); type Computer_Type is limited new Iface with record Port : Port_Type; end record; procedure Init_Ports (Comp : in out Computer_Type); end Types; -- types.adb package body Types is procedure Connect (Port : in out Port_Type; Data : Any_Iface_Ptr) is begin Port.Data := Data; end Connect; procedure Init_Ports (Comp : in out Computer_Type) is begin Comp.Port.Connect (Iface (Comp)'Access); end Init_Ports; end Types; ---------------------------- -- Compilation and output -- ---------------------------- $ gcc -c -gnat05 types.adb types.adb:9:26: non-local pointer cannot point to local object Tested on x86_64-pc-linux-gnu, committed on trunk 2013-02-06 Hristian Kirtchev <kirtc...@adacore.com> * sem_util.adb (Is_Interface_Conversion): New routine. (Object_Access_Level): Detect an interface conversion that has been rewritten into a different construct. Use the original form of the conversion to find the access level of the operand.
Index: sem_util.adb =================================================================== --- sem_util.adb (revision 195798) +++ sem_util.adb (working copy) @@ -11997,9 +11997,6 @@ -- Object_Access_Level -- ------------------------- - function Object_Access_Level (Obj : Node_Id) return Uint is - E : Entity_Id; - -- Returns the static accessibility level of the view denoted by Obj. Note -- that the value returned is the result of a call to Scope_Depth. Only -- scope depths associated with dynamic scopes can actually be returned. @@ -12008,6 +12005,12 @@ -- always one is immaterial (invariant: if level(E2) is deeper than -- level(E1), then Scope_Depth(E1) < Scope_Depth(E2)). + function Object_Access_Level (Obj : Node_Id) return Uint is + function Is_Interface_Conversion (N : Node_Id) return Boolean; + -- Determine whether N is a construct of the form + -- Some_Type (Operand._tag'Address) + -- This construct appears in the context of dispatching calls + function Reference_To (Obj : Node_Id) return Node_Id; -- An explicit dereference is created when removing side-effects from -- expressions for constraint checking purposes. In this case a local @@ -12016,6 +12019,18 @@ -- prefix of the dereference is created by an object declaration whose -- initial expression is a reference. + ----------------------------- + -- Is_Interface_Conversion -- + ----------------------------- + + function Is_Interface_Conversion (N : Node_Id) return Boolean is + begin + return + Nkind (N) = N_Unchecked_Type_Conversion + and then Nkind (Expression (N)) = N_Attribute_Reference + and then Attribute_Name (Expression (N)) = Name_Address; + end Is_Interface_Conversion; + ------------------ -- Reference_To -- ------------------ @@ -12034,6 +12049,10 @@ end if; end Reference_To; + -- Local variables + + E : Entity_Id; + -- Start of processing for Object_Access_Level begin @@ -12104,7 +12123,17 @@ then return Object_Access_Level (Prefix (Obj)); - elsif not (Comes_From_Source (Obj)) then + -- Detect an interface conversion in the context of a dispatching + -- call. Use the original form of the conversion to find the access + -- level of the operand. + + elsif Is_Interface (Etype (Obj)) + and then Is_Interface_Conversion (Prefix (Obj)) + and then Nkind (Original_Node (Obj)) = N_Type_Conversion + then + return Object_Access_Level (Original_Node (Obj)); + + elsif not Comes_From_Source (Obj) then declare Ref : constant Node_Id := Reference_To (Obj); begin @@ -12119,9 +12148,7 @@ return Type_Access_Level (Etype (Prefix (Obj))); end if; - elsif Nkind (Obj) = N_Type_Conversion - or else Nkind (Obj) = N_Unchecked_Type_Conversion - then + elsif Nkind_In (Obj, N_Type_Conversion, N_Unchecked_Type_Conversion) then return Object_Access_Level (Expression (Obj)); elsif Nkind (Obj) = N_Function_Call then