From 6eaf4095470fa44376f802f70382f4ee56b6aa9e Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 16 Jun 2005 10:46:01 +0200 Subject: [PATCH] sem_eval.adb (Subtypes_Statically_Match): Use discriminant constraint of full view if present... 2005-06-14 Ed Schonberg * sem_eval.adb (Subtypes_Statically_Match): Use discriminant constraint of full view if present, when other type is discriminated. (Eval_Relational_Op): Recognize tests of pointer values against Null, when the pointer is known to be non-null, and emit appropriate warning. From-SVN: r101059 --- gcc/ada/sem_eval.adb | 33 ++++++++++++++++++++++++++++++++- 1 file changed, 32 insertions(+), 1 deletion(-) 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 -- 2.30.2