From: Robert Dewar Date: Wed, 6 Jun 2007 10:47:02 +0000 (+0200) Subject: sem_eval.adb (Eval_Relational_Op): nothing to do if an operand is an illegal aggregat... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=13f34a3ff1be41d95ada5f840c25060072e7abf4;p=gcc.git sem_eval.adb (Eval_Relational_Op): nothing to do if an operand is an illegal aggregate and the type is still... 2007-04-20 Robert Dewar * 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 --- diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 84f67a2e284..81729906d49 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -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;