diff options
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/sem_eval.adb | 19 |
2 files changed, 27 insertions, 8 deletions
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 470f5ed..5e8e6dc 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -8090,16 +8090,22 @@ package body Sem_Ch12 is begin return (Base_Type (T) = Base_Type (Act_T) --- why is the and then commented out here??? --- and then Is_Constrained (T) = Is_Constrained (Act_T) and then Subtypes_Statically_Match (T, Act_T)) or else (Is_Class_Wide_Type (Gen_T) and then Is_Class_Wide_Type (Act_T) and then - Subtypes_Match ( - Get_Instance_Of (Root_Type (Gen_T)), - Root_Type (Act_T))); + Subtypes_Match + (Get_Instance_Of (Root_Type (Gen_T)), + Root_Type (Act_T))) + + or else + ((Ekind (Gen_T) = E_Anonymous_Access_Subprogram_Type + or else Ekind (Gen_T) = E_Anonymous_Access_Type) + and then Ekind (Act_T) = Ekind (Gen_T) + and then + Subtypes_Statically_Match + (Designated_Type (Gen_T), Designated_Type (Act_T))); end Subtypes_Match; ----------------------------------------- diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index d99e042..3e354ec 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -38,6 +38,7 @@ with Nlists; use Nlists; with Opt; use Opt; with Sem; use Sem; with Sem_Cat; use Sem_Cat; +with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; @@ -4056,9 +4057,21 @@ package body Sem_Eval is end; elsif Is_Access_Type (T1) then - return Subtypes_Statically_Match - (Designated_Type (T1), - Designated_Type (T2)); + if Can_Never_Be_Null (T1) /= Can_Never_Be_Null (T2) then + return False; + + elsif Ekind (T1) = E_Access_Subprogram_Type then + return + Subtype_Conformant + (Designated_Type (T1), + Designated_Type (T1)); + else + return + Subtypes_Statically_Match + (Designated_Type (T1), + Designated_Type (T2)) + and then Is_Access_Constant (T1) = Is_Access_Constant (T2); + end if; -- All other types definitely match |