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 <[email protected]>
* 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
