From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Wed, 15 Feb 2006 09:51:54 +0000 (+0100)
Subject: (Eval_Relational_Op): Use new Is_Known_Null flag to deal with case
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7a3f77d2a9a1ce40f15c192b60805947f4bcc58e;p=gcc.git

(Eval_Relational_Op): Use new Is_Known_Null flag to deal with case
	of null = null, now known true.

From-SVN: r111106
---

diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 3e354ec1b4d..65005de952b 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -2202,25 +2202,29 @@ package body Sem_Eval is
             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.
+      --  Another special case: comparisons of access types, where one or both
+      --  operands are known to be null, so the result can be determined.
 
-      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;
+      elsif Is_Access_Type (Typ) then
+         if Known_Null (Left) then
+            if Known_Null (Right) then
+               Fold_Uint (N, Test (Nkind (N) = N_Op_Eq), False);
+               Warn_On_Known_Condition (N);
+               return;
+
+            elsif Known_Non_Null (Right) then
+               Fold_Uint (N, Test (Nkind (N) = N_Op_Ne), False);
+               Warn_On_Known_Condition (N);
+               return;
+            end if;
+
+         elsif Known_Non_Null (Left) then
+            if Known_Null (Right) then
+               Fold_Uint (N, Test (Nkind (N) = N_Op_Ne), False);
+               Warn_On_Known_Condition (N);
+               return;
+            end if;
+         end if;
       end if;
 
       --  Can only fold if type is scalar (don't fold string ops)
@@ -4014,13 +4018,8 @@ package body Sem_Eval is
       elsif
          Has_Unknown_Discriminants (T1) /= Has_Unknown_Discriminants (T2)
       then
-         if Is_Generic_Actual_Type (T1)
-           and then Etype (T1) = T2
-         then
-            return True;
-         else
-            return False;
-         end if;
+         return
+           Is_Generic_Actual_Type (T1) or else Is_Generic_Actual_Type (T2);
 
       --  Array type
 
@@ -4060,11 +4059,13 @@ package body Sem_Eval is
          if Can_Never_Be_Null (T1) /= Can_Never_Be_Null (T2) then
             return False;
 
-         elsif Ekind (T1) = E_Access_Subprogram_Type then
+         elsif Ekind (T1) = E_Access_Subprogram_Type
+           or else Ekind (T1) = E_Anonymous_Access_Subprogram_Type
+         then
             return
               Subtype_Conformant
                 (Designated_Type (T1),
-                 Designated_Type (T1));
+                 Designated_Type (T2));
          else
             return
               Subtypes_Statically_Match