sem_eval.adb (Subtypes_Statically_Match): Use discriminant constraint of full view...

2005-06-14  Ed Schonberg  <schonberg@adacore.com>

	* 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

diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 442ca6e296553d10e43d3314670eff6e64fb8ced..954fe02379032f9d7372005f66e7338ca38ace45 100644 (file)
--- 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