[Ada] AI12-0085 Missing aspect cases for Remote_Types

2020-06-08  Arnaud Charlet  <charlet@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.

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 8631ded..69b36a4 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/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 ???

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index c59c059..e82082b 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/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);
 

diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb
index 5aa3080..8d785af 100644 (file)
--- a/gcc/ada/sem_cat.adb
+++ b/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

diff --git a/gcc/ada/sem_cat.ads b/gcc/ada/sem_cat.ads
index 895f526..2c95897 100644 (file)
--- a/gcc/ada/sem_cat.ads
+++ b/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

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 5a95427..878b4c5 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/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