===================================================================
@@ -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
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 <kirtchev@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.