diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2005-02-10 14:54:15 +0100 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2005-02-10 14:54:15 +0100 |
commit | 8aceda6473a81be00de01313a0b7594b438cb17f (patch) | |
tree | 96296fb7c3c197b7499a99d51ec3dcd9936c69d5 /gcc/ada | |
parent | 3cf3e5c6a2dcd0233ee237f291fdf9ac25052dd5 (diff) | |
download | gcc-8aceda6473a81be00de01313a0b7594b438cb17f.zip gcc-8aceda6473a81be00de01313a0b7594b438cb17f.tar.gz gcc-8aceda6473a81be00de01313a0b7594b438cb17f.tar.bz2 |
exp_ch4.adb (Expand_Composite_Equality): If a component is an unchecked union with no inferable discriminants...
* exp_ch4.adb (Expand_Composite_Equality): If a component is an
unchecked union with no inferable discriminants, return a
Raise_Program_Error node, rather than inserting it at the point the
type is frozen.
(Expand_Record_Equality, Component_Equality): Handle properly the case
where some subcomponent is an unchecked union whose generated equality
code raises program error.
From-SVN: r94814
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/exp_ch4.adb | 77 |
1 files changed, 45 insertions, 32 deletions
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 67fc5e8..fd03a08 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005, 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- -- @@ -1063,12 +1063,20 @@ package body Exp_Ch4 is Test := Expand_Composite_Equality (Nod, Component_Type (Typ), L, R, Decls); - return - Make_Implicit_If_Statement (Nod, - Condition => Make_Op_Not (Loc, Right_Opnd => Test), - Then_Statements => New_List ( - Make_Return_Statement (Loc, - Expression => New_Occurrence_Of (Standard_False, Loc)))); + -- If some (sub)component is an unchecked_union, the whole + -- operation will raise program error. + + if Nkind (Test) = N_Raise_Program_Error then + return Test; + + else + return + Make_Implicit_If_Statement (Nod, + Condition => Make_Op_Not (Loc, Right_Opnd => Test), + Then_Statements => New_List ( + Make_Return_Statement (Loc, + Expression => New_Occurrence_Of (Standard_False, Loc)))); + end if; end Component_Equality; ------------------ @@ -1650,14 +1658,9 @@ package body Exp_Ch4 is -- It is not possible to infer the discriminant since -- the subtype is not constrained. - Insert_Action (Nod, + return Make_Raise_Program_Error (Loc, - Reason => PE_Unchecked_Union_Restriction)); - - -- Prevent Gigi from generating illegal code, change - -- the equality to a standard False. - - return New_Occurrence_Of (Standard_False, Loc); + Reason => PE_Unchecked_Union_Restriction); end if; -- Rhs of the composite equality @@ -1686,11 +1689,9 @@ package body Exp_Ch4 is end if; else - Insert_Action (Nod, + return Make_Raise_Program_Error (Loc, - Reason => PE_Unchecked_Union_Restriction)); - - return Empty; + Reason => PE_Unchecked_Union_Restriction); end if; -- Call the TSS equality function with the inferred @@ -7108,6 +7109,7 @@ package body Exp_Ch4 is declare New_Lhs : Node_Id; New_Rhs : Node_Id; + Check : Node_Id; begin if First_Time then @@ -7119,20 +7121,31 @@ package body Exp_Ch4 is New_Rhs := New_Copy_Tree (Rhs); end if; - Result := - Make_And_Then (Loc, - Left_Opnd => Result, - Right_Opnd => - Expand_Composite_Equality (Nod, Etype (C), - Lhs => - Make_Selected_Component (Loc, - Prefix => New_Lhs, - Selector_Name => New_Reference_To (C, Loc)), - Rhs => - Make_Selected_Component (Loc, - Prefix => New_Rhs, - Selector_Name => New_Reference_To (C, Loc)), - Bodies => Bodies)); + Check := + Expand_Composite_Equality (Nod, Etype (C), + Lhs => + Make_Selected_Component (Loc, + Prefix => New_Lhs, + Selector_Name => New_Reference_To (C, Loc)), + Rhs => + Make_Selected_Component (Loc, + Prefix => New_Rhs, + Selector_Name => New_Reference_To (C, Loc)), + Bodies => Bodies); + + -- If some (sub)component is an unchecked_union, the whole + -- operation will raise program error. + + if Nkind (Check) = N_Raise_Program_Error then + Result := Check; + Set_Etype (Result, Standard_Boolean); + exit; + else + Result := + Make_And_Then (Loc, + Left_Opnd => Result, + Right_Opnd => Check); + end if; end; C := Suitable_Element (Next_Entity (C)); |