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 <kirtc...@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.
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 244788)
+++ sem_ch13.adb (working copy)
@@ -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
