This change adds a missing check on setting aspects Storage_Size and
Storage_Pool on remote access-to-class-wide types.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-08 Arnaud Charlet <char...@adacore.com>
gcc/ada/
* sem_cat.ads: Fix typo.
* sem_cat.adb (Validate_Remote_Access_To_Class_Wide_Type): Add
handling of N_Attribute_Definition_Clause.
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Call
Validate_Remote_Access_To_Class_Wide_Type for Storage_Size and
Storage_Pool.
* sem_attr.adb, exp_ch4.adb: Update comments.--- gcc/ada/exp_ch4.adb
+++ gcc/ada/exp_ch4.adb
@@ -4489,7 +4489,7 @@ package body Exp_Ch4 is
Error_Msg_N ("?use of an anonymous access type allocator", N);
end if;
- -- RM E.2.3(22). We enforce that the expected type of an allocator
+ -- RM E.2.2(17). We enforce that the expected type of an allocator
-- shall not be a remote access-to-class-wide-limited-private type
-- Why is this being done at expansion time, seems clearly wrong ???
--- gcc/ada/sem_attr.adb
+++ gcc/ada/sem_attr.adb
@@ -6004,7 +6004,7 @@ package body Sem_Attr is
-- Validate_Remote_Access_To_Class_Wide_Type for attribute
-- Storage_Pool since this attribute is not defined for such
- -- types (RM E.2.3(22)).
+ -- types (RM E.2.2(17)).
Validate_Remote_Access_To_Class_Wide_Type (N);
@@ -6038,9 +6038,9 @@ package body Sem_Attr is
Check_Type;
Set_Etype (N, Universal_Integer);
- -- Validate_Remote_Access_To_Class_Wide_Type for attribute
- -- Storage_Size since this attribute is not defined for
- -- such types (RM E.2.3(22)).
+ -- Validate_Remote_Access_To_Class_Wide_Type for attribute
+ -- Storage_Size since this attribute is not defined for
+ -- such types (RM E.2.2(17)).
Validate_Remote_Access_To_Class_Wide_Type (N);
--- gcc/ada/sem_cat.adb
+++ gcc/ada/sem_cat.adb
@@ -1815,7 +1815,17 @@ package body Sem_Cat is
-- 4. called from sem_res Resolve_Actuals
- if K = N_Attribute_Reference then
+ if K = N_Attribute_Definition_Clause then
+ E := Etype (Entity (N));
+
+ if Is_Remote_Access_To_Class_Wide_Type (E) then
+ Error_Msg_Name_1 := Chars (N);
+ Error_Msg_N
+ ("cannot specify% aspect for a remote operand", N);
+ return;
+ end if;
+
+ elsif K = N_Attribute_Reference then
E := Etype (Prefix (N));
if Is_Remote_Access_To_Class_Wide_Type (E) then
--- gcc/ada/sem_cat.ads
+++ gcc/ada/sem_cat.ads
@@ -120,8 +120,8 @@ package Sem_Cat is
-- Checks that Storage_Pool and Storage_Size attribute references are
-- not applied to remote access-to-class-wide types. Also checks that the
-- expected type for an allocator cannot be a remote access-to-class-wide
- -- type. ALso checks that a remote access-to-class-wide type cannot be an
- -- actual parameter for a generic formal access type. RM E.2.3(22).
+ -- type. Also checks that a remote access-to-class-wide type cannot be an
+ -- actual parameter for a generic formal access type. RM E.2.2(17).
procedure Validate_RT_RAT_Component (N : Node_Id);
-- Given N, the package library unit declaration node, we should check
--- gcc/ada/sem_ch13.adb
+++ gcc/ada/sem_ch13.adb
@@ -48,6 +48,7 @@ with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Case; use Sem_Case;
+with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch7; use Sem_Ch7;
@@ -6415,6 +6416,12 @@ package body Sem_Ch13 is
return;
end if;
+ -- Validate_Remote_Access_To_Class_Wide_Type for attribute
+ -- Storage_Pool since this attribute cannot be defined for such
+ -- types (RM E.2.2(17)).
+
+ Validate_Remote_Access_To_Class_Wide_Type (N);
+
-- If the argument is a name that is not an entity name, then
-- we construct a renaming operation to define an entity of
-- type storage pool.
@@ -6524,6 +6531,12 @@ package body Sem_Ch13 is
null;
else
+ -- Validate_Remote_Access_To_Class_Wide_Type for attribute
+ -- Storage_Size since this attribute cannot be defined for such
+ -- types (RM E.2.2(17)).
+
+ Validate_Remote_Access_To_Class_Wide_Type (N);
+
Analyze_And_Resolve (Expr, Any_Integer);
if Is_Access_Type (U_Ent) then
