[gcc(refs/users/guojiufu/heads/guojiufu-branch)] [Ada] Refine implementation of AI05-0149 missing conversion checks

Jiu Fu Guo guojiufu@gcc.gnu.org
Wed Jun 10 03:47:35 GMT 2020


https://gcc.gnu.org/g:742048af50e79b4e0dabba3f4cf2e5779bdc273a

commit 742048af50e79b4e0dabba3f4cf2e5779bdc273a
Author: Arnaud Charlet <charlet@adacore.com>
Date:   Fri Feb 21 11:36:40 2020 -0500

    [Ada] Refine implementation of AI05-0149 missing conversion checks
    
    2020-06-09  Arnaud Charlet  <charlet@adacore.com>
    
    gcc/ada/
    
            * sem_type.adb (Covers): Fix implementation of AI05-0149.
            * sem_res.adb: Fix typo.

Diff:
---
 gcc/ada/sem_res.adb  |  2 +-
 gcc/ada/sem_type.adb | 12 +++++++-----
 2 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 0856c893562..6e26ffb3c45 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -2852,7 +2852,7 @@ package body Sem_Res is
                return;
 
             --  Under relaxed RM semantics silently replace occurrences of null
-            --  by System.Address_Null.
+            --  by System.Null_Address.
 
             elsif Null_To_Null_Address_Convert_OK (N, Typ) then
                Replace_Null_By_Null_Address (N);
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 12f2038e6ba..af0687cf436 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -1021,15 +1021,17 @@ package body Sem_Type is
 
       --  Ada 2012 (AI05-0149): Allow an anonymous access type in the context
       --  of a named general access type. An implicit conversion will be
-      --  applied. For the resolution, one designated type must cover the
-      --  other.
+      --  applied. For the resolution, the designated types must match if
+      --  untagged; further, if the designated type is tagged, the designated
+      --  type of the anonymous access type shall be covered by the designated
+      --  type of the named access type.
 
       elsif Ada_Version >= Ada_2012
         and then Ekind (BT1) = E_General_Access_Type
         and then Ekind (BT2) = E_Anonymous_Access_Type
-        and then (Covers (Designated_Type (T1), Designated_Type (T2))
-                    or else
-                  Covers (Designated_Type (T2), Designated_Type (T1)))
+        and then Covers (Designated_Type (T1), Designated_Type (T2))
+        and then (Is_Class_Wide_Type (Designated_Type (T1)) >=
+                  Is_Class_Wide_Type (Designated_Type (T2)))
       then
          return True;


More information about the Gcc-cvs mailing list