===================================================================
@@ -4915,7 +4915,7 @@
or else Has_Controlled_Component (Etype (U_Ent))
then
Error_Msg_NE
- ("??controlled object& must not be overlaid", Nam, U_Ent);
+ ("??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),
@@ -4923,6 +4923,19 @@
Reason => PE_Overlaid_Controlled_Object));
return;
+ -- Case of an address clause for a class-wide object which is
+ -- considered erroneous.
+
+ elsif Is_Class_Wide_Type (Etype (U_Ent)) then
+ Error_Msg_NE
+ ("??class-wide 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 address clause for a (non-controlled) object
elsif Ekind_In (U_Ent, E_Variable, E_Constant) then
This patch adds an extra restriction to the placement of an 'Address attribute definition clause where a prefix of a class-wide type cannot be subject to the clause. ------------ -- Source -- ------------ -- types.ads with Ada.Finalization; use Ada.Finalization; package Types is type Arr_Typ is array (1 .. 5) of Integer; type Ctrl is new Controlled with record Comp : Integer; end record; type Rec_Ctrl is record Comp : Ctrl; end record; type Rec_Typ is record Comp : Integer; end record; type Tag_Typ is tagged record Comp : Integer; end record; function Make_Any_Tag_Typ return Tag_Typ'Class; end Types; -- gnat_address.adb with System; use System; with Types; use Types; procedure GNAT_Address (Here : Address) is Obj_1 : Integer; for Obj_1'Address use Here; -- OK Obj_2 : Arr_Typ; for Obj_2'Address use Here; -- OK Obj_3 : Ctrl; for Obj_3'Address use Here; -- Error Obj_4 : Rec_Ctrl; for Obj_4'Address use Here; -- Error Obj_5 : Rec_Typ; for Obj_5'Address use Here; -- OK Obj_6 : Tag_Typ; for Obj_6'Address use Here; -- Error Obj_7 : Tag_Typ'Class := Make_Any_Tag_Typ; for Obj_7'Address use Here; -- Error begin null; end GNAT_Address; ---------------------------- -- Compilation and output -- ---------------------------- $ gcc -c gnat_address.adb t_address.adb:11:04: warning: variable "Obj_3" is read but never assigned gnat_address.adb:12:08: warning: controlled object "Obj_3" must not be overlaid gnat_address.adb:12:08: warning: Program_Error will be raised at run time gnat_address.adb:14:04: warning: variable "Obj_4" is read but never assigned gnat_address.adb:15:08: warning: controlled object "Obj_4" must not be overlaid gnat_address.adb:15:08: warning: Program_Error will be raised at run time gnat_address.adb:21:08: warning: default initialization of "Obj_6" may modify overlaid storage gnat_address.adb:21:08: warning: use pragma Import for "Obj_6" to suppress initialization (RM B.1(24)) gnat_address.adb:24:08: warning: class-wide object "Obj_7" must not be overlaid gnat_address.adb:24:08: warning: Program_Error will be raised at run time Tested on x86_64-pc-linux-gnu, committed on trunk 2017-01-23 Hristian Kirtchev <kirtchev@adacore.com> * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Do not allow an 'Address clause to be specified on a prefix of a class-wide type.