diff options
| -rw-r--r-- | gcc/ada/sem_eval.adb | 33 |
1 files changed, 32 insertions, 1 deletions
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 442ca6e2965..954fe023790 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -2199,6 +2199,26 @@ package body Sem_Eval is return; end if; end; + + -- Another special case: comparisons against null for pointers that + -- are known to be non-null. This is useful when migrating from Ada95 + -- code when non-null restrictions are added to type declarations and + -- parameter specifications. + + elsif Is_Access_Type (Typ) + and then Comes_From_Source (N) + and then + ((Is_Entity_Name (Left) + and then Is_Known_Non_Null (Entity (Left)) + and then Nkind (Right) = N_Null) + or else + (Is_Entity_Name (Right) + and then Is_Known_Non_Null (Entity (Right)) + and then Nkind (Left) = N_Null)) + then + Fold_Uint (N, Test (Nkind (N) = N_Op_Ne), False); + Warn_On_Known_Condition (N); + return; end if; -- Can only fold if type is scalar (don't fold string ops) @@ -3906,8 +3926,19 @@ package body Sem_Eval is -- Type with discriminants elsif Has_Discriminants (T1) or else Has_Discriminants (T2) then + + -- We really need comments here ??? + if Has_Discriminants (T1) /= Has_Discriminants (T2) then - return False; + if In_Instance + and then Is_Private_Type (T2) + and then Present (Full_View (T2)) + and then Has_Discriminants (Full_View (T2)) + then + return Subtypes_Statically_Match (T1, Full_View (T2)); + else + return False; + end if; end if; declare |