From 076bbec1c8e8be10079027f6519702275ce5f445 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 14 Nov 2018 11:42:49 +0000 Subject: [PATCH] [Ada] Problem with boundary case of XOR operation and unnesting The XOR operation applied to a boolean array whose component type has the range True .. True raises constraint error. Previous to this patch, the expansion of the operation could lead to uplevel references that were not handled properly when unnesting is in effect. 2018-11-14 Ed Schonberg gcc/ada/ * 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. From-SVN: r266137 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/exp_ch4.adb | 5 +++-- gcc/ada/exp_pakd.adb | 5 +++-- gcc/ada/exp_util.adb | 22 ++++++++++++++++++---- gcc/ada/exp_util.ads | 13 ++++++++----- 5 files changed, 41 insertions(+), 13 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 14cc1fd3fd7..d6004111e65 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2018-11-14 Ed Schonberg + + * 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 * libgnarl/a-intnam__linux.ads: Add SIGSYS. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index a00e0c7761d..9cf2d3e410b 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 7e5e337b06c..632c3bd6350 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 a76e92e7e44..b5338d4deb2 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 7c2d9b72ec6..9b76ef88a2d 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; -- 2.30.2