===================================================================
@@ -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
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 <kirtchev@adacore.com> * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Remove the restriction converning the use of 'Address where the prefix is of a controlled type.