Commit 7a3f77d2 by Arnaud Charlet

(Eval_Relational_Op): Use new Is_Known_Null flag to deal with case

	of null = null, now known true.

From-SVN: r111106
parent 51c40324
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -2202,25 +2202,29 @@ package body Sem_Eval is ...@@ -2202,25 +2202,29 @@ package body Sem_Eval is
end if; end if;
end; end;
-- Another special case: comparisons against null for pointers that -- Another special case: comparisons of access types, where one or both
-- are known to be non-null. This is useful when migrating from Ada95 -- operands are known to be null, so the result can be determined.
-- code when non-null restrictions are added to type declarations and
-- parameter specifications.
elsif Is_Access_Type (Typ) elsif Is_Access_Type (Typ) then
and then Comes_From_Source (N) if Known_Null (Left) then
and then if Known_Null (Right) then
((Is_Entity_Name (Left) Fold_Uint (N, Test (Nkind (N) = N_Op_Eq), False);
and then Is_Known_Non_Null (Entity (Left)) Warn_On_Known_Condition (N);
and then Nkind (Right) = N_Null) return;
or else
(Is_Entity_Name (Right) elsif Known_Non_Null (Right) then
and then Is_Known_Non_Null (Entity (Right)) Fold_Uint (N, Test (Nkind (N) = N_Op_Ne), False);
and then Nkind (Left) = N_Null)) Warn_On_Known_Condition (N);
then return;
Fold_Uint (N, Test (Nkind (N) = N_Op_Ne), False); end if;
Warn_On_Known_Condition (N);
return; 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; end if;
-- Can only fold if type is scalar (don't fold string ops) -- Can only fold if type is scalar (don't fold string ops)
...@@ -4014,13 +4018,8 @@ package body Sem_Eval is ...@@ -4014,13 +4018,8 @@ package body Sem_Eval is
elsif elsif
Has_Unknown_Discriminants (T1) /= Has_Unknown_Discriminants (T2) Has_Unknown_Discriminants (T1) /= Has_Unknown_Discriminants (T2)
then then
if Is_Generic_Actual_Type (T1) return
and then Etype (T1) = T2 Is_Generic_Actual_Type (T1) or else Is_Generic_Actual_Type (T2);
then
return True;
else
return False;
end if;
-- Array type -- Array type
...@@ -4060,11 +4059,13 @@ package body Sem_Eval is ...@@ -4060,11 +4059,13 @@ package body Sem_Eval is
if Can_Never_Be_Null (T1) /= Can_Never_Be_Null (T2) then if Can_Never_Be_Null (T1) /= Can_Never_Be_Null (T2) then
return False; 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 return
Subtype_Conformant Subtype_Conformant
(Designated_Type (T1), (Designated_Type (T1),
Designated_Type (T1)); Designated_Type (T2));
else else
return return
Subtypes_Statically_Match Subtypes_Statically_Match
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment