[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