This patch removes the restriction on attribute definition clause 'Address
which prevented it from being used with controlled objects. The restriction
was a legacy left over from the previous controlled type implementation where
each controlled type had hidden components that should not be overlayed.
------------
-- Source --
------------
-- types.ads
with Ada.Finalization; use Ada.Finalization;
package Types is
type Ctrl is new Controlled with record
Comp_1 : Integer;
end record;
type Rec is record
Comp_1 : Ctrl;
Comp_2 : Integer;
end record;
type Tag_Typ is tagged record
Comp_1 : Integer;
Comp_2 : Integer;
Comp_3 : Integer;
end record;
end Types;
-- main.adb
with Ada.Text_IO; use Ada.Text_IO;
with System; use System;
with System.Storage_Elements; use System.Storage_Elements;
with Types; use Types;
procedure Main is
Obj_1 : constant Integer := 1;
Obj_1_Addr : constant Address := Obj_1'Address;
-- The objects are declared in one order, but their address clauses order
-- them in reverse declarative order.
Obj_4_Addr : constant Address := Obj_1_Addr + Integer'Size;
Obj_3_Addr : constant Address := Obj_4_Addr + Tag_Typ'Size;
Obj_2_Addr : constant Address := Obj_3_Addr + Ctrl'Size;
Obj_2 : Ctrl;
for Obj_2'Address use Obj_2_Addr;
Obj_3 : Rec;
for Obj_3'Address use Obj_3_Addr;
Obj_4 : Tag_Typ;
for Obj_4'Address use Obj_4_Addr;
begin
if Obj_2'Address /= Obj_2_Addr then
Put_Line ("ERROR: Obj_2 is in the wrong place");
end if;
if Obj_3'Address /= Obj_3_Addr then
Put_Line ("ERROR: Obj_3 is in the wrong place");
end if;
if Obj_4'Address /= Obj_4_Addr then
Put_Line ("ERROR: Obj_4 is in the wrong place");
end if;
end Main;
-----------------
-- Compilation --
-----------------
$ gnatmake -q -gnatws main.adb
$ ./main
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Hristian Kirtchev <[email protected]>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Remove the
restriction converning the use of 'Address where the prefix is
of a controlled type.
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 247160)
+++ sem_ch13.adb (working copy)
@@ -4887,21 +4887,6 @@
("\?j?use interrupt procedure instead", N);
end if;
- -- Case of an address clause for a controlled object, which we
- -- consider to be erroneous.
-
- elsif Is_Controlled (Etype (U_Ent))
- or else Has_Controlled_Component (Etype (U_Ent))
- then
- Error_Msg_NE
- ("??controlled object & must not be overlaid", Nam, U_Ent);
- Error_Msg_N
- ("\??Program_Error will be raised at run time", Nam);
- Insert_Action (Declaration_Node (U_Ent),
- Make_Raise_Program_Error (Loc,
- Reason => PE_Overlaid_Controlled_Object));
- return;
-
-- Case of an address clause for a class-wide object, which is
-- considered erroneous.
@@ -4915,9 +4900,9 @@
Reason => PE_Overlaid_Controlled_Object));
return;
- -- Case of address clause for a (non-controlled) object
+ -- Case of address clause for an object
- elsif Ekind_In (U_Ent, E_Variable, E_Constant) then
+ elsif Ekind_In (U_Ent, E_Constant, E_Variable) then
declare
Expr : constant Node_Id := Expression (N);
O_Ent : Entity_Id;
@@ -5006,28 +4991,11 @@
end;
end if;
- -- Overlaying controlled objects is erroneous. Emit warning
- -- but continue analysis because program is itself legal,
- -- and back end must see address clause.
-
- if Present (O_Ent)
- and then (Has_Controlled_Component (Etype (O_Ent))
- or else Is_Controlled (Etype (O_Ent)))
- and then not Inside_A_Generic
- then
- Error_Msg_N
- ("??cannot use overlays with controlled objects", Expr);
- Error_Msg_N
- ("\??Program_Error will be raised at run time", Expr);
- Insert_Action (Declaration_Node (U_Ent),
- Make_Raise_Program_Error (Loc,
- Reason => PE_Overlaid_Controlled_Object));
-
-- Issue an unconditional warning for a constant overlaying
-- a variable. For the reverse case, we will issue it only
-- if the variable is modified.
- elsif Ekind (U_Ent) = E_Constant
+ if Ekind (U_Ent) = E_Constant
and then Present (O_Ent)
and then not Overlays_Constant (U_Ent)
and then Address_Clause_Overlay_Warnings
