aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@adacore.com>2020-02-21 11:36:40 -0500
committerPierre-Marie de Rodat <derodat@adacore.com>2020-06-09 04:09:00 -0400
commit742048af50e79b4e0dabba3f4cf2e5779bdc273a (patch)
tree07cd6e078d988f6f8a03a001e8c3c1d982785f12 /gcc
parent54025948c0a4cad05cc22fe67d104e5e3ac9b0de (diff)
downloadgcc-742048af50e79b4e0dabba3f4cf2e5779bdc273a.zip
gcc-742048af50e79b4e0dabba3f4cf2e5779bdc273a.tar.gz
gcc-742048af50e79b4e0dabba3f4cf2e5779bdc273a.tar.bz2
[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.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/sem_res.adb2
-rw-r--r--gcc/ada/sem_type.adb12
2 files changed, 8 insertions, 6 deletions
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 0856c89..6e26ffb 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 12f2038..af0687c 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;