From 072c5071e0e95401cec2b700c3f276c9eb91abb1 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 21 Feb 2020 09:44:28 -0500 Subject: [PATCH] [Ada] AI12-0085 Missing aspect cases for Remote_Types 2020-06-08 Arnaud Charlet 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 | 2 +- gcc/ada/sem_attr.adb | 8 ++++---- gcc/ada/sem_cat.adb | 12 +++++++++++- gcc/ada/sem_cat.ads | 4 ++-- gcc/ada/sem_ch13.adb | 13 +++++++++++++ 5 files changed, 31 insertions(+), 8 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 8631ded4ea9..69b36a4bec5 100644 --- 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 c59c0595547..e82082bc07a 100644 --- 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 5aa30809b76..8d785af9f6d 100644 --- 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 895f526b684..2c958979712 100644 --- 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 5a954273fc4..878b4c5118c 100644 --- 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 -- 2.30.2