FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

sem_eval.adb (Eval_Relational_Op): nothing to do if an operand is an illegal aggregate and the type is still...

Browse source 
2007-04-20  Robert Dewar  <dewar@adacore.com>

	* sem_eval.adb (Eval_Relational_Op): nothing to do if an operand is an
	illegal aggregate and the type is still Any_Composite.
	(Subtypes_Statically_Match): Fix problem of empty discriminant list

From-SVN: r125460
This commit is contained in:
Robert Dewar 2007-06-06 12:47:02 +02:00 • committed by Arnaud Charlet
parent 79e448454b
commit 13f34a3ff1
1 changed files with 46 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

81
gcc/ada/sem_eval.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, 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- --
@ -33,6 +33,7 @@ with Errout; use Errout;
with Eval_Fat; use Eval_Fat;
with Exp_Util; use Exp_Util;
with Lib; use Lib;
with Namet; use Namet;
with Nmake; use Nmake;
with Nlists; use Nlists;
with Opt; use Opt;
@ -2262,11 +2263,13 @@ package body Sem_Eval is
-- then we can replace the entire result by False. We only
-- do this for one dimensional arrays, because the case of
-- multi-dimensional arrays is rare and too much trouble!
-- If one of the operands is an illegal aggregate, its type
-- might still be an arbitrary composite type, so nothing to do.
if Is_Array_Type (Typ)
and then Typ /= Any_Composite
and then Number_Dimensions (Typ) = 1
and then (Nkind (N) = N_Op_Eq
or else Nkind (N) = N_Op_Ne)
and then (Nkind (N) = N_Op_Eq or else Nkind (N) = N_Op_Ne)
then
if Raises_Constraint_Error (Left)
or else Raises_Constraint_Error (Right)
@ -2276,9 +2279,9 @@ package body Sem_Eval is
declare
procedure Get_Static_Length (Op : Node_Id; Len : out Uint);
-- If Op is an expression for a constrained array with a
-- known at compile time length, then Len is set to this
-- (non-negative length). Otherwise Len is set to minus 1.
-- If Op is an expression for a constrained array with a known
-- at compile time length, then Len is set to this (non-negative
-- length). Otherwise Len is set to minus 1.
-----------------------
-- Get_Static_Length --
@ -2963,9 +2966,9 @@ package body Sem_Eval is
Val : Uint;
begin
-- If already in cache, then we know it's compile time known and
-- we can return the value that was previously stored in the cache
-- since compile time known values cannot change :-)
-- If already in cache, then we know it's compile time known and we can
-- return the value that was previously stored in the cache since
-- compile time known values cannot change.
if CV_Ent.N = N then
return CV_Ent.V;
@ -4092,45 +4095,53 @@ package body Sem_Eval is
DL1 : constant Elist_Id := Discriminant_Constraint (T1);
DL2 : constant Elist_Id := Discriminant_Constraint (T2);
DA1 : Elmt_Id := First_Elmt (DL1);
DA2 : Elmt_Id := First_Elmt (DL2);
DA1 : Elmt_Id;
DA2 : Elmt_Id;
begin
if DL1 = DL2 then
return True;
elsif Is_Constrained (T1) /= Is_Constrained (T2) then
return False;
end if;
while Present (DA1) loop
declare
Expr1 : constant Node_Id := Node (DA1);
Expr2 : constant Node_Id := Node (DA2);
-- Now loop through the discriminant constraints
begin
if not Is_Static_Expression (Expr1)
or else not Is_Static_Expression (Expr2)
then
return False;
-- Note: the guard here seems necessary, since it is possible at
-- least for DL1 to be No_Elist. Not clear this is reasonable ???
-- If either expression raised a constraint error,
-- consider the expressions as matching, since this
-- helps to prevent cascading errors.
if Present (DL1) and then Present (DL2) then
DA1 := First_Elmt (DL1);
DA2 := First_Elmt (DL2);
while Present (DA1) loop
declare
Expr1 : constant Node_Id := Node (DA1);
Expr2 : constant Node_Id := Node (DA2);
elsif Raises_Constraint_Error (Expr1)
or else Raises_Constraint_Error (Expr2)
then
null;
begin
if not Is_Static_Expression (Expr1)
or else not Is_Static_Expression (Expr2)
then
return False;
elsif Expr_Value (Expr1) /= Expr_Value (Expr2) then
return False;
end if;
end;
-- If either expression raised a constraint error,
-- consider the expressions as matching, since this
-- helps to prevent cascading errors.
Next_Elmt (DA1);
Next_Elmt (DA2);
end loop;
elsif Raises_Constraint_Error (Expr1)
or else Raises_Constraint_Error (Expr2)
then
null;
elsif Expr_Value (Expr1) /= Expr_Value (Expr2) then
return False;
end if;
end;
Next_Elmt (DA1);
Next_Elmt (DA2);
end loop;
end if;
end;
return True;