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