diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/exp_pakd.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/exp_util.ads | 13 |
5 files changed, 41 insertions, 13 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 14cc1fd..d600411 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2018-11-14 Ed Schonberg <schonberg@adacore.com> + + * exp_util.ads, exp_util.adb: Change the profile of + Silly_Boolean_Array_Xor_Test, adding a formal that can be a copy + of the right opersnd. This prevents unnesting anomalies when + that operand contains uplevel references. + * exp_ch4.adb (Expand_Boolean_Operation): Use this new profile. + * exp_pakd.adb (Expand_Packed_Boolean_Operator): Ditto. + 2018-11-14 Patrick Bernardi <bernardi@adacore.com> * libgnarl/a-intnam__linux.ads: Add SIGSYS. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index a00e0c7..9cf2d3e 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -2031,7 +2031,7 @@ package body Exp_Ch4 is declare Loc : constant Source_Ptr := Sloc (N); L : constant Node_Id := Relocate_Node (Left_Opnd (N)); - R : constant Node_Id := Relocate_Node (Right_Opnd (N)); + R : Node_Id := Relocate_Node (Right_Opnd (N)); Func_Body : Node_Id; Func_Name : Entity_Id; @@ -2043,7 +2043,8 @@ package body Exp_Ch4 is Apply_Length_Check (R, Etype (L)); if Nkind (N) = N_Op_Xor then - Silly_Boolean_Array_Xor_Test (N, Etype (L)); + R := Duplicate_Subexpr (R); + Silly_Boolean_Array_Xor_Test (N, R, Etype (L)); end if; if Nkind (Parent (N)) = N_Assignment_Statement diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 7e5e337..632c3bd 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -1506,7 +1506,7 @@ package body Exp_Pakd is Loc : constant Source_Ptr := Sloc (N); Typ : constant Entity_Id := Etype (N); L : constant Node_Id := Relocate_Node (Left_Opnd (N)); - R : constant Node_Id := Relocate_Node (Right_Opnd (N)); + R : Node_Id := Relocate_Node (Right_Opnd (N)); Ltyp : Entity_Id; Rtyp : Entity_Id; @@ -1528,7 +1528,8 @@ package body Exp_Pakd is -- True .. True where an exception must be raised. if Nkind (N) = N_Op_Xor then - Silly_Boolean_Array_Xor_Test (N, Rtyp); + R := Duplicate_Subexpr (R); + Silly_Boolean_Array_Xor_Test (N, R, Rtyp); end if; -- Now that that silliness is taken care of, get packed array type diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index a76e92e..b5338d4 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -7062,7 +7062,6 @@ package body Exp_Util is | N_Procedure_Instantiation | N_Protected_Body | N_Protected_Body_Stub - | N_Protected_Type_Declaration | N_Single_Task_Declaration | N_Subprogram_Body | N_Subprogram_Body_Stub @@ -7071,7 +7070,6 @@ package body Exp_Util is | N_Subtype_Declaration | N_Task_Body | N_Task_Body_Stub - | N_Task_Type_Declaration -- Use clauses can appear in lists of declarations @@ -7135,6 +7133,21 @@ package body Exp_Util is return; end if; + -- the expansion of Task and protected type declarations can + -- create declarations for temporaries which, like other actions + -- are inserted and analyzed before the current declaraation. + -- However, the current scope is the synchronized type, and + -- for unnesting it is critical that the proper scope for these + -- generated entities be the enclosing one. + + when N_Task_Type_Declaration + | N_Protected_Type_Declaration => + + Push_Scope (Scope (Current_Scope)); + Insert_List_Before_And_Analyze (P, Ins_Actions); + Pop_Scope; + return; + -- A special case, N_Raise_xxx_Error can act either as a statement -- or a subexpression. We tell the difference by looking at the -- Etype. It is set to Standard_Void_Type in the statement case. @@ -13400,7 +13413,8 @@ package body Exp_Util is -- required for the case of False .. False, since False xor False = False. -- See also Silly_Boolean_Array_Not_Test - procedure Silly_Boolean_Array_Xor_Test (N : Node_Id; T : Entity_Id) is + procedure Silly_Boolean_Array_Xor_Test + (N : Node_Id; R : Node_Id; T : Entity_Id) is Loc : constant Source_Ptr := Sloc (N); CT : constant Entity_Id := Component_Type (T); @@ -13435,7 +13449,7 @@ package body Exp_Util is Prefix => New_Occurrence_Of (CT, Loc), Attribute_Name => Name_Last))), - Right_Opnd => Make_Non_Empty_Check (Loc, Right_Opnd (N))), + Right_Opnd => Make_Non_Empty_Check (Loc, R)), Reason => CE_Range_Check_Failed)); end Silly_Boolean_Array_Xor_Test; diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 7c2d9b7..9b76ef8 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -1140,11 +1140,14 @@ package Exp_Util is -- the boolean array is False..False or True..True, where it is required -- that a Constraint_Error exception be raised (RM 4.5.6(6)). - procedure Silly_Boolean_Array_Xor_Test (N : Node_Id; T : Entity_Id); - -- N is the node for a boolean array XOR operation, and T is the type of - -- the array. This routine deals with the silly case where the subtype of - -- the boolean array is True..True, where a raise of a Constraint_Error - -- exception is required (RM 4.5.6(6)). + procedure Silly_Boolean_Array_Xor_Test + (N : Node_Id; R : Node_Id; T : Entity_Id); + -- N is the node for a boolean array XOR operation, T is the type of the + -- array, and R is a copy of the right operand of N, required to prevent + -- scope anomalies when unnesting is in effect. This routine deals with + -- the admitedly silly case where the subtype of the boolean array is + -- True..True, where a raise of a Constraint_Error exception is required + -- (RM 4.5.6(6)) and ACATS-tested. function Target_Has_Fixed_Ops (Left_Typ : Entity_Id; |