diff options
Diffstat (limited to 'gcc/ada/exp_pakd.adb')
| -rw-r--r-- | gcc/ada/exp_pakd.adb | 78 |
1 files changed, 8 insertions, 70 deletions
diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 21a78ac80a4..8f191be3a36 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -1092,7 +1092,7 @@ package body Exp_Pakd is -- discriminants, so we treat it as a default/per-object expression. Set_Parent (Len_Expr, Typ); - Analyze_Per_Use_Expression (Len_Expr, Standard_Long_Long_Integer); + Preanalyze_Spec_Expression (Len_Expr, Standard_Long_Long_Integer); -- Use a modular type if possible. We can do this if we have -- static bounds, and the length is small enough, and the length @@ -1774,47 +1774,11 @@ package body Exp_Pakd is Ltyp := Etype (L); Rtyp := Etype (R); - -- First an odd and silly test. We explicitly check for the XOR - -- case where the component type is True .. True, since this will - -- raise constraint error. A special check is required since CE - -- will not be required other wise (cf Expand_Packed_Not). - - -- No such check is required for AND and OR, since for both these - -- cases False op False = False, and True op True = True. + -- Deeal with silly case of XOR where the subcomponent has a range + -- True .. True where an exception must be raised. if Nkind (N) = N_Op_Xor then - declare - CT : constant Entity_Id := Component_Type (Rtyp); - BT : constant Entity_Id := Base_Type (CT); - - begin - Insert_Action (N, - Make_Raise_Constraint_Error (Loc, - Condition => - Make_Op_And (Loc, - Left_Opnd => - Make_Op_Eq (Loc, - Left_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (CT, Loc), - Attribute_Name => Name_First), - - Right_Opnd => - Convert_To (BT, - New_Occurrence_Of (Standard_True, Loc))), - - Right_Opnd => - Make_Op_Eq (Loc, - Left_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (CT, Loc), - Attribute_Name => Name_Last), - - Right_Opnd => - Convert_To (BT, - New_Occurrence_Of (Standard_True, Loc)))), - Reason => CE_Range_Check_Failed)); - end; + Silly_Boolean_Array_Xor_Test (N, Rtyp); end if; -- Now that that silliness is taken care of, get packed array type @@ -2186,37 +2150,11 @@ package body Exp_Pakd is Convert_To_Actual_Subtype (Opnd); Rtyp := Etype (Opnd); - -- First an odd and silly test. We explicitly check for the case - -- where the 'First of the component type is equal to the 'Last of - -- this component type, and if this is the case, we make sure that - -- constraint error is raised. The reason is that the NOT is bound - -- to cause CE in this case, and we will not otherwise catch it. + -- Deal with silly False..False and True..True subtype case - -- Believe it or not, this was reported as a bug. Note that nearly - -- always, the test will evaluate statically to False, so the code - -- will be statically removed, and no extra overhead caused. + Silly_Boolean_Array_Not_Test (N, Rtyp); - declare - CT : constant Entity_Id := Component_Type (Rtyp); - - begin - Insert_Action (N, - Make_Raise_Constraint_Error (Loc, - Condition => - Make_Op_Eq (Loc, - Left_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (CT, Loc), - Attribute_Name => Name_First), - - Right_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (CT, Loc), - Attribute_Name => Name_Last)), - Reason => CE_Range_Check_Failed)); - end; - - -- Now that that silliness is taken care of, get packed array type + -- Now that the silliness is taken care of, get packed array type Convert_To_PAT_Type (Opnd); PAT := Etype (Opnd); |