[gcc(refs/users/guojiufu/heads/guojiufu-branch)] [Ada] AI12-0287 Legality Rules for null exclusions in renaming are too fierce

[gcc(refs/users/guojiufu/heads/guojiufu-branch)] [Ada] AI12-0287 Legality Rules for null exclusions in renaming are too fierce

[Jiu Fu Guo]

https://gcc.gnu.org/g:b4aa6e2978408f0f45fe1074481cfd4044947ab9

commit b4aa6e2978408f0f45fe1074481cfd4044947ab9
Author: Arnaud Charlet <charlet@adacore.com>
Date:   Sun Feb 16 07:16:45 2020 -0500

    [Ada] AI12-0287 Legality Rules for null exclusions in renaming are too fierce
    
    2020-06-08  Arnaud Charlet  <charlet@adacore.com>
    
    gcc/ada/
    
            * sem_ch12.adb (Instantiate_Object): Relax rules related to null
            exclusions and generic objects. Handle all anonymous types
            consistently and not just E_Anonymous_Access_Type.
            * sem_ch8.adb (Analyze_Object_Renaming): Change wording so that
            it applies to both renamings and instantiations to avoid
            confusion.

Diff:
---
 gcc/ada/sem_ch12.adb | 34 +++++++++++++++++++++-------------
 gcc/ada/sem_ch8.adb  | 10 ++++------
 2 files changed, 25 insertions(+), 19 deletions(-)

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 76159bc2405..2b38f924133 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -11279,10 +11279,9 @@ package body Sem_Ch12 is
             --  access type.
 
             if Ada_Version < Ada_2005
-              or else Ekind (Base_Type (Ftyp))           /=
-                                                  E_Anonymous_Access_Type
-              or else Ekind (Base_Type (Etype (Actual))) /=
-                                                  E_Anonymous_Access_Type
+              or else Ekind (Base_Type (Ftyp)) not in Anonymous_Access_Kind
+              or else Ekind (Base_Type (Etype (Actual)))
+                        not in Anonymous_Access_Kind
             then
                Error_Msg_NE
                  ("type of actual does not match type of&", Actual, Gen_Obj);
@@ -11477,15 +11476,19 @@ package body Sem_Ch12 is
          Actual_Decl := Parent (Entity (Actual));
       end if;
 
-      --  Ada 2005 (AI-423): For a formal object declaration with a null
-      --  exclusion or an access definition that has a null exclusion: If the
-      --  actual matching the formal object declaration denotes a generic
-      --  formal object of another generic unit G, and the instantiation
-      --  containing the actual occurs within the body of G or within the body
-      --  of a generic unit declared within the declarative region of G, then
-      --  the declaration of the formal object of G must have a null exclusion.
-      --  Otherwise, the subtype of the actual matching the formal object
-      --  declaration shall exclude null.
+      --  Ada 2005 (AI-423) refined by AI12-0287:
+      --  For an object_renaming_declaration with a null_exclusion or an
+      --  access_definition that has a null_exclusion, the subtype of the
+      --  object_name shall exclude null. In addition, if the
+      --  object_renaming_declaration occurs within the body of a generic unit
+      --  G or within the body of a generic unit declared within the
+      --  declarative region of generic unit G, then:
+      --  * if the object_name statically denotes a generic formal object of
+      --    mode in out of G, then the declaration of that object shall have a
+      --    null_exclusion;
+      --  * if the object_name statically denotes a call of a generic formal
+      --    function of G, then the declaration of the result of that function
+      --    shall have a null_exclusion.
 
       if Ada_Version >= Ada_2005
         and then Present (Actual_Decl)
@@ -11494,6 +11497,11 @@ package body Sem_Ch12 is
         and then Nkind (Analyzed_Formal) = N_Formal_Object_Declaration
         and then not Has_Null_Exclusion (Actual_Decl)
         and then Has_Null_Exclusion (Analyzed_Formal)
+        and then Ekind (Defining_Identifier (Analyzed_Formal))
+                  = E_Generic_In_Out_Parameter
+        and then ((In_Generic_Scope (Entity (Actual))
+                    and then In_Package_Body (Scope (Entity (Actual))))
+                  or else not Can_Never_Be_Null (Etype (Actual)))
       then
          Error_Msg_Sloc := Sloc (Analyzed_Formal);
          Error_Msg_N
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index fcdc0f36ec0..c65ab5cd95f 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -1278,7 +1278,7 @@ package body Sem_Ch8 is
                then
                   if not Can_Never_Be_Null (Etype (Nam_Ent)) then
                      Error_Msg_N
-                       ("renamed formal does not exclude `NULL` "
+                       ("object does not exclude `NULL` "
                         & "(RM 8.5.1(4.6/2))", N);
 
                   elsif In_Package_Body (Scope (Id)) then
@@ -1292,7 +1292,7 @@ package body Sem_Ch8 is
 
                elsif not Can_Never_Be_Null (Etype (Nam_Ent)) then
                   Error_Msg_N
-                    ("renamed object does not exclude `NULL` "
+                    ("object does not exclude `NULL` "
                      & "(RM 8.5.1(4.6/2))", N);
 
                --  An instance is illegal if it contains a renaming that
@@ -1309,8 +1309,7 @@ package body Sem_Ch8 is
                                             N_Raise_Constraint_Error
                then
                   Error_Msg_N
-                    ("renamed actual does not exclude `NULL` "
-                     & "(RM 8.5.1(4.6/2))", N);
+                    ("actual does not exclude `NULL` (RM 8.5.1(4.6/2))", N);
 
                --  Finally, if there is a null exclusion, the subtype mark
                --  must not be null-excluding.
@@ -1328,8 +1327,7 @@ package body Sem_Ch8 is
               and then not Can_Never_Be_Null (Etype (Nam_Ent))
             then
                Error_Msg_N
-                 ("renamed object does not exclude `NULL` "
-                  & "(RM 8.5.1(4.6/2))", N);
+                 ("object does not exclude `NULL` (RM 8.5.1(4.6/2))", N);
 
             elsif Has_Null_Exclusion (N)
               and then No (Access_Definition (N))