From 649bde867ae0a808b21e837744211339476c8099 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Tue, 28 Jan 2025 12:12:23 +0100 Subject: ada: Fix for validity checking of limited scalar types With a recent change we are now validity checking objects of private scalar types, but need to handle private scalar types whose public view is limited. gcc/ada/ChangeLog: * checks.adb (Insert_Valid_Check): Set flag Assignment_OK in the object declaration inserted for the validity checks. --- gcc/ada/checks.adb | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index dcfcaa3..6a98292 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -8163,6 +8163,7 @@ package body Checks is end if; declare + Decl : Node_Id; CE : Node_Id; PV : Node_Id; Var_Id : Entity_Id; @@ -8215,12 +8216,20 @@ package body Checks is Mutate_Ekind (Var_Id, E_Variable); Set_Etype (Var_Id, Typ); - Insert_Action (Exp, + Decl := Make_Object_Declaration (Loc, Defining_Identifier => Var_Id, Object_Definition => New_Occurrence_Of (Typ, Loc), - Expression => New_Copy_Tree (Exp)), - Suppress => Validity_Check); + Expression => New_Copy_Tree (Exp)); + + -- We might be validity-checking object whose type is declared as + -- limited but completion is a scalar type. We need to explicitly + -- flag its assignment as OK, as otherwise it would be rejected by + -- the language rules. + + Set_Assignment_OK (Decl); + + Insert_Action (Exp, Decl, Suppress => Validity_Check); Set_Validated_Object (Var_Id, New_Copy_Tree (Exp)); -- cgit v1.1 From 855fe3625493e3888df5da12aba945c243ec6650 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 11 Feb 2025 12:47:36 +0100 Subject: ada: Fix internal error on allocator involving interface type The problem is that an itype duplicated through Duplicate_Subexpr_No_Checks ends up in a different scope than its source. It is fixed by adding a new formal parameter New_Scope to the function and forwarding it in the call to the New_Copy_Tree function. gcc/ada/ChangeLog: * exp_aggr.adb (Expand_Record_Aggregate): Use the named form for the second actual parameter in the call to Duplicate_Subexpr. * exp_attr.adb (Expand_Size_Attribute): Likewise. * exp_ch5.adb (Expand_Assign_Array): Likewise. (Expand_Assign_Array_Bitfield): Likewise. (Expand_Assign_Array_Bitfield_Fast): Likewise. * exp_util.ads (Duplicate_Subexpr): Add New_Scope formal parameter. (Duplicate_Subexpr_No_Checks): Likewise. (Duplicate_Subexpr_Move_Checks): Likewise. * exp_util.adb (Build_Allocate_Deallocate_Proc): Pass Proc_Id as the actual for New_Scope in the calls to Duplicate_Subexpr_No_Checks. (Duplicate_Subexpr): Add New_Scope formal parameter and forward it in the call to New_Copy_Tree. (Duplicate_Subexpr_No_Checks): Likewise. (Duplicate_Subexpr_Move_Checks): Likewise. --- gcc/ada/exp_aggr.adb | 3 ++- gcc/ada/exp_attr.adb | 4 ++-- gcc/ada/exp_ch5.adb | 24 +++++++++++++----------- gcc/ada/exp_util.adb | 35 ++++++++++++++++++++++------------- gcc/ada/exp_util.ads | 18 ++++++++++++------ 5 files changed, 51 insertions(+), 33 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index f2e7ad7..8f1869c 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -8077,7 +8077,8 @@ package body Exp_Aggr is Make_Selected_Component (Loc, Prefix => Unchecked_Convert_To (Typ, - Duplicate_Subexpr (Parent_Expr, True)), + Duplicate_Subexpr + (Parent_Expr, Name_Req => True)), Selector_Name => New_Occurrence_Of (Comp, Loc)); Append_To (Comps, diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 4e0052e..455cc22 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -8602,10 +8602,10 @@ package body Exp_Attr is Rewrite (N, Make_Op_Multiply (Loc, Make_Attribute_Reference (Loc, - Prefix => Duplicate_Subexpr (Pref, True), + Prefix => Duplicate_Subexpr (Pref, Name_Req => True), Attribute_Name => Name_Length), Make_Attribute_Reference (Loc, - Prefix => Duplicate_Subexpr (Pref, True), + Prefix => Duplicate_Subexpr (Pref, Name_Req => True), Attribute_Name => Name_Component_Size))); Analyze_And_Resolve (N, Typ); end if; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 06616ea..3d8a542 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1039,7 +1039,8 @@ package body Exp_Ch5 is Prefix => Make_Indexed_Component (Loc, Prefix => - Duplicate_Subexpr_Move_Checks (Larray, True), + Duplicate_Subexpr_Move_Checks + (Larray, Name_Req => True), Expressions => New_List ( Make_Attribute_Reference (Loc, Prefix => @@ -1054,7 +1055,8 @@ package body Exp_Ch5 is Prefix => Make_Indexed_Component (Loc, Prefix => - Duplicate_Subexpr_Move_Checks (Rarray, True), + Duplicate_Subexpr_Move_Checks + (Rarray, Name_Req => True), Expressions => New_List ( Make_Attribute_Reference (Loc, Prefix => @@ -1396,7 +1398,7 @@ package body Exp_Ch5 is Prefix => Make_Indexed_Component (Loc, Prefix => - Duplicate_Subexpr (Larray, True), + Duplicate_Subexpr (Larray, Name_Req => True), Expressions => New_List (New_Copy_Tree (Left_Lo))), Attribute_Name => Name_Address); @@ -1405,7 +1407,7 @@ package body Exp_Ch5 is Prefix => Make_Indexed_Component (Loc, Prefix => - Duplicate_Subexpr (Larray, True), + Duplicate_Subexpr (Larray, Name_Req => True), Expressions => New_List (New_Copy_Tree (Left_Lo))), Attribute_Name => Name_Bit); @@ -1414,7 +1416,7 @@ package body Exp_Ch5 is Prefix => Make_Indexed_Component (Loc, Prefix => - Duplicate_Subexpr (Rarray, True), + Duplicate_Subexpr (Rarray, Name_Req => True), Expressions => New_List (New_Copy_Tree (Right_Lo))), Attribute_Name => Name_Address); @@ -1423,7 +1425,7 @@ package body Exp_Ch5 is Prefix => Make_Indexed_Component (Loc, Prefix => - Duplicate_Subexpr (Rarray, True), + Duplicate_Subexpr (Rarray, Name_Req => True), Expressions => New_List (New_Copy_Tree (Right_Lo))), Attribute_Name => Name_Bit); @@ -1439,11 +1441,11 @@ package body Exp_Ch5 is Make_Op_Multiply (Loc, Make_Attribute_Reference (Loc, Prefix => - Duplicate_Subexpr (Name (N), True), + Duplicate_Subexpr (Name (N), Name_Req => True), Attribute_Name => Name_Length), Make_Attribute_Reference (Loc, Prefix => - Duplicate_Subexpr (Name (N), True), + Duplicate_Subexpr (Name (N), Name_Req => True), Attribute_Name => Name_Component_Size)); begin @@ -1527,11 +1529,11 @@ package body Exp_Ch5 is Make_Op_Multiply (Loc, Make_Attribute_Reference (Loc, Prefix => - Duplicate_Subexpr (Name (N), True), + Duplicate_Subexpr (Name (N), Name_Req => True), Attribute_Name => Name_Length), Make_Attribute_Reference (Loc, Prefix => - Duplicate_Subexpr (Larray, True), + Duplicate_Subexpr (Larray, Name_Req => True), Attribute_Name => Name_Component_Size)); L_Arg, R_Arg, Call : Node_Id; @@ -1582,7 +1584,7 @@ package body Exp_Ch5 is end if; return Make_Assignment_Statement (Loc, - Name => Duplicate_Subexpr (Larray, True), + Name => Duplicate_Subexpr (Larray, Name_Req => True), Expression => Unchecked_Convert_To (L_Typ, Call)); end Expand_Assign_Array_Bitfield_Fast; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index b8c6a9f..51cc790 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1081,10 +1081,12 @@ package body Exp_Util is Make_Attribute_Reference (Loc, Prefix => (if Is_Allocate then - Duplicate_Subexpr_No_Checks (Expression (Alloc_Expr)) + Duplicate_Subexpr_No_Checks + (Expression (Alloc_Expr), New_Scope => Proc_Id) else Make_Explicit_Dereference (Loc, - Duplicate_Subexpr_No_Checks (Expr))), + Duplicate_Subexpr_No_Checks + (Expr, New_Scope => Proc_Id))), Attribute_Name => Name_Alignment))); end if; @@ -1137,7 +1139,9 @@ package body Exp_Util is if Is_RTE (Etype (Temp), RE_Tag_Ptr) then Param := Make_Explicit_Dereference (Loc, - Prefix => Duplicate_Subexpr_No_Checks (Temp)); + Prefix => + Duplicate_Subexpr_No_Checks + (Temp, New_Scope => Proc_Id)); -- In the default case, obtain the tag of the object about -- to be allocated / deallocated. Generate: @@ -1157,7 +1161,9 @@ package body Exp_Util is Param := Make_Attribute_Reference (Loc, - Prefix => Duplicate_Subexpr_No_Checks (Temp), + Prefix => + Duplicate_Subexpr_No_Checks + (Temp, New_Scope => Proc_Id), Attribute_Name => Name_Tag); end if; @@ -5062,12 +5068,13 @@ package body Exp_Util is function Duplicate_Subexpr (Exp : Node_Id; - Name_Req : Boolean := False; - Renaming_Req : Boolean := False) return Node_Id + New_Scope : Entity_Id := Empty; + Name_Req : Boolean := False; + Renaming_Req : Boolean := False) return Node_Id is begin Remove_Side_Effects (Exp, Name_Req, Renaming_Req); - return New_Copy_Tree (Exp); + return New_Copy_Tree (Exp, New_Scope => New_Scope); end Duplicate_Subexpr; --------------------------------- @@ -5076,8 +5083,9 @@ package body Exp_Util is function Duplicate_Subexpr_No_Checks (Exp : Node_Id; - Name_Req : Boolean := False; - Renaming_Req : Boolean := False) return Node_Id + New_Scope : Entity_Id := Empty; + Name_Req : Boolean := False; + Renaming_Req : Boolean := False) return Node_Id is New_Exp : Node_Id; @@ -5087,7 +5095,7 @@ package body Exp_Util is Name_Req => Name_Req, Renaming_Req => Renaming_Req); - New_Exp := New_Copy_Tree (Exp); + New_Exp := New_Copy_Tree (Exp, New_Scope => New_Scope); Remove_Checks (New_Exp); return New_Exp; end Duplicate_Subexpr_No_Checks; @@ -5098,14 +5106,15 @@ package body Exp_Util is function Duplicate_Subexpr_Move_Checks (Exp : Node_Id; - Name_Req : Boolean := False; - Renaming_Req : Boolean := False) return Node_Id + New_Scope : Entity_Id := Empty; + Name_Req : Boolean := False; + Renaming_Req : Boolean := False) return Node_Id is New_Exp : Node_Id; begin Remove_Side_Effects (Exp, Name_Req, Renaming_Req); - New_Exp := New_Copy_Tree (Exp); + New_Exp := New_Copy_Tree (Exp, New_Scope => New_Scope); Remove_Checks (Exp); return New_Exp; end Duplicate_Subexpr_Move_Checks; diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 6178767..1306f5e 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -479,8 +479,9 @@ package Exp_Util is function Duplicate_Subexpr (Exp : Node_Id; - Name_Req : Boolean := False; - Renaming_Req : Boolean := False) return Node_Id; + New_Scope : Entity_Id := Empty; + Name_Req : Boolean := False; + Renaming_Req : Boolean := False) return Node_Id; -- Given the node for a subexpression, this function makes a logical copy -- of the subexpression, and returns it. This is intended for use when the -- expansion of an expression needs to repeat part of it. For example, @@ -494,6 +495,9 @@ package Exp_Util is -- the caller is responsible for analyzing the returned copy after it is -- attached to the tree. -- + -- The New_Scope entity may be used to specify a new scope for all copied + -- entities and itypes. + -- -- The Name_Req flag is set to ensure that the result is suitable for use -- in a context requiring a name (for example, the prefix of an attribute -- reference). @@ -509,8 +513,9 @@ package Exp_Util is function Duplicate_Subexpr_No_Checks (Exp : Node_Id; - Name_Req : Boolean := False; - Renaming_Req : Boolean := False) return Node_Id; + New_Scope : Entity_Id := Empty; + Name_Req : Boolean := False; + Renaming_Req : Boolean := False) return Node_Id; -- Identical in effect to Duplicate_Subexpr, except that Remove_Checks is -- called on the result, so that the duplicated expression does not include -- checks. This is appropriate for use when Exp, the original expression is @@ -519,8 +524,9 @@ package Exp_Util is function Duplicate_Subexpr_Move_Checks (Exp : Node_Id; - Name_Req : Boolean := False; - Renaming_Req : Boolean := False) return Node_Id; + New_Scope : Entity_Id := Empty; + Name_Req : Boolean := False; + Renaming_Req : Boolean := False) return Node_Id; -- Identical in effect to Duplicate_Subexpr, except that Remove_Checks is -- called on Exp after the duplication is complete, so that the original -- expression does not include checks. In this case the result returned -- cgit v1.1 From 1189522245be51d435fcc6d205e690f086f12e46 Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Fri, 7 Feb 2025 12:29:46 -0800 Subject: ada: Incorrect unresolved operator name in an instantiation In some cases, a generic containing a use of a unary operator successfully compiles but the compiler incorrectly rejects the corresponding use in an instantiation. gcc/ada/ChangeLog: * sem_ch4.adb (Find_Unary_Types): Because we reanalyze names in an instance, we sometimes have to take steps to filter out extraneous name resolution candidates that happen to be visible at the point of the instance declaration. Remove some code that appears to have been written with this in mind. This is done for two reasons. First, the code sometimes doesn't work (possibly because the In_Instance test is not specific enough - it probably should be testing to see whether we are in an instance of the particular generic in which the result of calling Corresponding_Generic_Type was declared) and causes correct code to be rejected. Second, the code seems to no longer be necessary (possibly because of subsequent fixes in this area which are not specific to unary operators). --- gcc/ada/sem_ch4.adb | 25 ++----------------------- 1 file changed, 2 insertions(+), 23 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 4069839..50b3eee 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -7642,35 +7642,14 @@ package body Sem_Ch4 is begin if not Is_Overloaded (R) then if Is_Numeric_Type (Etype (R)) then - - -- In an instance a generic actual may be a numeric type even if - -- the formal in the generic unit was not. In that case, the - -- predefined operator was not a possible interpretation in the - -- generic, and cannot be one in the instance, unless the operator - -- is an actual of an instance. - - if In_Instance - and then - not Is_Numeric_Type (Corresponding_Generic_Type (Etype (R))) - then - null; - else - Add_One_Interp (N, Op_Id, Base_Type (Etype (R))); - end if; + Add_One_Interp (N, Op_Id, Base_Type (Etype (R))); end if; else Get_First_Interp (R, Index, It); while Present (It.Typ) loop if Is_Numeric_Type (It.Typ) then - if In_Instance - and then - not Is_Numeric_Type - (Corresponding_Generic_Type (Etype (It.Typ))) - then - null; - - elsif Is_Effectively_Visible_Operator (N, Base_Type (It.Typ)) + if Is_Effectively_Visible_Operator (N, Base_Type (It.Typ)) then Add_One_Interp (N, Op_Id, Base_Type (It.Typ)); end if; -- cgit v1.1 From cb3e76508b1af7ff5ba6e43592d7d67bbb96fac6 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 21 Feb 2025 10:03:22 +0100 Subject: ada: Fix wrong initialization of library-level object by conditional expression At library level the object must be allocated statically and with its bounds when its nominal subtype is an unconstrained array type. gcc/ada/ChangeLog: * exp_ch4.adb (Insert_Conditional_Object_Declaration): Make sure the object is allocated properly by the code generator at library level. --- gcc/ada/exp_ch4.adb | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index eb9fb6b..793e468 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -13292,10 +13292,12 @@ package body Exp_Ch4 is Obj_Decl : constant Node_Id := Make_Object_Declaration (Loc, Defining_Identifier => Obj_Id, - Aliased_Present => Aliased_Present (Decl), + Aliased_Present => True, Constant_Present => Constant_Present (Decl), Object_Definition => New_Copy_Tree (Object_Definition (Decl)), Expression => Relocate_Node (Expr)); + -- We make the object unconditionally aliased to avoid dangling bound + -- issues when its nominal subtype is an unconstrained array type. Master_Node_Decl : Node_Id; Master_Node_Id : Entity_Id; @@ -13310,6 +13312,11 @@ package body Exp_Ch4 is Insert_Action (Expr, Obj_Decl); + -- The object can never be local to an elaboration routine at library + -- level since we will take 'Unrestricted_Access of it. + + Set_Is_Statically_Allocated (Obj_Id, Is_Library_Level_Entity (Obj_Id)); + -- If the object needs finalization, we need to insert its Master_Node -- manually because 1) the machinery in Exp_Ch7 will not pick it since -- it will be declared in the arm of a conditional statement and 2) we -- cgit v1.1 From e0777e78bede3108d41a506d8877c03997bed2c5 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 24 Feb 2025 22:27:21 +0100 Subject: ada: Fix libgpr2 build failure with compiler built with assertions The problem is that the Entity field is accessed for a node without one. gcc/ada/ChangeLog: * sem_ch10.adb (Install_Siblings.In_Context): Add missing guard. --- gcc/ada/sem_ch10.adb | 2 ++ 1 file changed, 2 insertions(+) (limited to 'gcc') diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index de5a8c8..e3d9925 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -4932,6 +4932,8 @@ package body Sem_Ch10 is if Entity (Name (Clause)) = Id or else (Nkind (Name (Clause)) = N_Expanded_Name + and then + Is_Entity_Name (Prefix (Name (Clause))) and then Entity (Prefix (Name (Clause))) = Id) then return True; -- cgit v1.1 From f59d33ad52cbc9c3096862a7e286021463a05998 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Fri, 31 Jan 2025 20:21:09 +0000 Subject: ada: Constant_Indexing used when context requires a variable In the case of an assignment where the type of its left hand side is an indexable container that has indexable container components (for example a container vector of container vectors), and both indexable containers have Constant_Indexing and Variable_Indexing aspects, the left hand side of the assignment is erroneously interpreted as constant indexing. The error results in spurious compile-time error messages saying that the left hand side of the assignment must be a variable. gcc/ada/ChangeLog: * sem_ch4.adb (Constant_Indexing_OK): Add missing support for RM 4.1.6(13/3), and improve performance to avoid climbing more than needed. Add documentation. (Try_Indexing_Function): New subprogram. (Expr_Matches_In_Formal): Added new formals. (Handle_Selected_Component): New subprogram. (Has_IN_Mode): New subprogram. (Try_Container_Indexing): Add documentation, code reorganization and extend its functionality to improve its support for prefixed notation calls. --- gcc/ada/sem_ch4.adb | 886 +++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 667 insertions(+), 219 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 50b3eee..8be9647 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -308,8 +308,12 @@ package body Sem_Ch4 is (N : Node_Id; Prefix : Node_Id; Exprs : List_Id) return Boolean; - -- AI05-0139: Generalized indexing to support iterators over containers - -- ??? Need to provide a more detailed spec of what this function does + -- AI05-0139: Generalized indexing to support iterators over containers. + -- Given the N_Indexed_Component node N, with the given prefix and + -- expressions list, check if the generalized indexing is applicable; + -- if applicable then build its indexing function, link it to N through + -- attribute Generalized_Indexing, and return True; otherwise return + -- False. function Try_Indexed_Call (N : Node_Id; @@ -8512,21 +8516,29 @@ package body Sem_Ch4 is Prefix : Node_Id; Exprs : List_Id) return Boolean is - Pref_Typ : Entity_Id := Etype (Prefix); + Heuristic : Boolean := False; + Pref_Typ : Entity_Id := Etype (Prefix); function Constant_Indexing_OK return Boolean; - -- Constant_Indexing is legal if there is no Variable_Indexing defined - -- for the type, or else node not a target of assignment, or an actual - -- for an IN OUT or OUT formal (RM 4.1.6 (11)). - - function Expr_Matches_In_Formal - (Subp : Entity_Id; - Par : Node_Id) return Boolean; - -- Find formal corresponding to given indexed component that is an - -- actual in a call. Note that the enclosing subprogram call has not - -- been analyzed yet, and the parameter list is not normalized, so - -- that if the argument is a parameter association we must match it - -- by name and not by position. + -- Determines whether the Constant_Indexing aspect has been specified + -- for the type of the prefix and can be interpreted as constant + -- indexing; that is, there is no Variable_Indexing defined for the + -- type, or else the node is not a target of an assignment, or an + -- actual for an IN OUT or OUT formal, or the name in an object + -- renaming (RM 4.1.6 (12/3..15/3)). + -- + -- Given that prefix notation calls have not yet been resolved, if the + -- type of the prefix has both aspects present (Constant_Indexing and + -- Variable_Indexing), and context analysis performed by this routine + -- identifies a potential prefix notation call (i.e., an N_Selected_ + -- Component node), this function may rely on heuristics to decide + -- between constant or variable indexing. In such cases, if the + -- decision is later found to be incorrect, Try_Container_Indexing + -- will retry using the alternative indexing aspect. + + -- When heuristics are used to compute the result of this function + -- the behavior of Try_Container_Indexing might not be strictly + -- following the rules of the RM. function Indexing_Interpretations (T : Entity_Id; @@ -8534,59 +8546,429 @@ package body Sem_Ch4 is -- Return a set of interpretations reflecting all of the functions -- associated with an indexing aspect of type T of the given kind. + function Try_Indexing_Function + (Func_Name : Node_Id; + Assoc : List_Id) return Entity_Id; + -- Build a call to the given indexing function name with the given + -- parameter associations; if there are several indexing functions + -- the call is analyzed for each of the interpretation; if there are + -- several successfull candidates, resolution is handled by result. + -- Return the Etype of the built function call. + -------------------------- -- Constant_Indexing_OK -- -------------------------- function Constant_Indexing_OK return Boolean is - Par : Node_Id; + + function Expr_Matches_In_Formal + (Subp : Entity_Id; + Subp_Call : Node_Id; + Param : Node_Id; + Skip_Controlling_Formal : Boolean := False) return Boolean; + -- Find formal corresponding to given indexed component that is an + -- actual in a call. Note that the enclosing subprogram call has not + -- been analyzed yet, and the parameter list is not normalized, so + -- that if the argument is a parameter association we must match it + -- by name and not by position. In the traversal up the tree done by + -- Constant_Indexing_OK, the previous node in the traversal (that is, + -- the actual parameter used to ascend to the subprogram call node), + -- is passed to this function in formal Param, and it is used to + -- determine wether the argument is passed by name or by position. + -- Skip_Controlling_Formal is set to True to skip the first formal + -- of Subp. + + procedure Handle_Selected_Component + (Current_Node : Node_Id; + Sel_Comp : Node_Id; + Candidate : out Entity_Id; + Is_Constant_Idx : out Boolean); + -- Current_Node is the current node climbing up the tree. Determine + -- if Sel_Comp is a candidate for a prefixed call using constant + -- indexing; if no candidate is found Candidate is returned Empty + -- and Is_Constant_Idx is returned False. + + function Has_IN_Mode (Formal : Node_Id) return Boolean is + (Ekind (Formal) = E_In_Parameter); + -- Return True if the given formal has mode IN + + ---------------------------- + -- Expr_Matches_In_Formal -- + ---------------------------- + + function Expr_Matches_In_Formal + (Subp : Entity_Id; + Subp_Call : Node_Id; + Param : Node_Id; + Skip_Controlling_Formal : Boolean := False) return Boolean + is + pragma Assert (Nkind (Subp_Call) in N_Subprogram_Call); + + Actual : Node_Id := First (Parameter_Associations (Subp_Call)); + Formal : Node_Id := First_Formal (Subp); + + begin + if Skip_Controlling_Formal then + Next_Formal (Formal); + end if; + + -- Match by position + + if Nkind (Param) /= N_Parameter_Association then + while Present (Actual) and then Present (Formal) loop + exit when Actual = Param; + Next (Actual); + + if Present (Formal) then + Next_Formal (Formal); + + -- Otherwise this is a parameter mismatch, the error is + -- reported elsewhere, or else variable indexing is implied. + + else + return False; + end if; + end loop; + + -- Match by name + + else + while Present (Formal) loop + exit when Chars (Formal) = Chars (Selector_Name (Param)); + Next_Formal (Formal); + + if No (Formal) then + return False; + end if; + end loop; + end if; + + return Present (Formal) and then Has_IN_Mode (Formal); + end Expr_Matches_In_Formal; + + ------------------------------- + -- Handle_Selected_Component -- + ------------------------------- + + procedure Handle_Selected_Component + (Current_Node : Node_Id; + Sel_Comp : Node_Id; + Candidate : out Entity_Id; + Is_Constant_Idx : out Boolean) + is + procedure Search_Constant_Interpretation + (Call : Node_Id; + Target_Name : Node_Id; + Candidate : out Entity_Id; + Is_Unique : out Boolean; + Unique_Mode : out Boolean); + -- Given a subprogram call, search in the homonyms chain for + -- visible (or potentially visible) dispatching primitives that + -- have at least one formal. Candidate is the entity of the first + -- found candidate; Is_Unique is returned True when the mode of + -- the first formal of all the candidates match. If no candidate + -- is found the out parameter Candidate is returned Empty, and + -- Is_Unique is returned False. + + procedure Search_Enclosing_Call + (Call_Node : out Node_Id; + Prev_Node : out Node_Id); + -- Climb up to the tree looking for an enclosing subprogram call + -- of a prefixed notation call. If found then the Call_Node and + -- its Prev_Node in such traversal are returned; otherwise + -- Call_Node and Prev_Node are returned Empty. + + ------------------------------------ + -- Search_Constant_Interpretation -- + ------------------------------------ + + procedure Search_Constant_Interpretation + (Call : Node_Id; + Target_Name : Node_Id; + Candidate : out Entity_Id; + Is_Unique : out Boolean; + Unique_Mode : out Boolean) + is + Constant_Idx : Boolean; + In_Proc_Call : constant Boolean := + Present (Call) + and then + Nkind (Call) = N_Procedure_Call_Statement; + Kind : constant Entity_Kind := + (if In_Proc_Call then E_Procedure + else E_Function); + Target_Subp : constant Entity_Id := + Current_Entity (Target_Name); + begin + Candidate := Empty; + Is_Unique := False; + Unique_Mode := False; + + if Present (Target_Subp) then + declare + Hom : Entity_Id := Target_Subp; + + begin + while Present (Hom) loop + if Is_Overloadable (Hom) + and then Is_Dispatching_Operation (Hom) + and then + (Is_Immediately_Visible (Scope (Hom)) + or else + Is_Potentially_Use_Visible (Scope (Hom))) + and then Ekind (Hom) = Kind + and then Present (First_Formal (Hom)) + then + if No (Candidate) then + Candidate := Hom; + Is_Unique := True; + Unique_Mode := True; + Constant_Idx := + Has_IN_Mode (First_Formal (Candidate)); + + else + Is_Unique := False; + + if Ekind (First_Formal (Hom)) + /= Ekind (First_Formal (Candidate)) + or else Has_IN_Mode (First_Formal (Hom)) + /= Constant_Idx + then + Unique_Mode := False; + exit; + end if; + end if; + end if; + + Hom := Homonym (Hom); + end loop; + end; + end if; + end Search_Constant_Interpretation; + + --------------------------- + -- Search_Enclosing_Call -- + --------------------------- + + procedure Search_Enclosing_Call + (Call_Node : out Node_Id; + Prev_Node : out Node_Id) + is + Prev : Node_Id := Current_Node; + Par : Node_Id := Parent (N); + + begin + while Present (Par) + and then Nkind (Par) not in N_Subprogram_Call + | N_Handled_Sequence_Of_Statements + | N_Assignment_Statement + | N_Iterator_Specification + | N_Object_Declaration + | N_Case_Statement + | N_Declaration + | N_Elsif_Part + | N_If_Statement + | N_Simple_Return_Statement + loop + Prev := Par; + Par := Parent (Par); + end loop; + + if Present (Par) + and then Nkind (Par) in N_Subprogram_Call + and then Nkind (Name (Par)) = N_Selected_Component + then + Call_Node := Par; + Prev_Node := Prev; + else + Call_Node := Empty; + Prev_Node := Empty; + end if; + end Search_Enclosing_Call; + + -- Local variables + + Is_Unique : Boolean; + Unique_Mode : Boolean; + Call_Node : Node_Id; + Prev_Node : Node_Id; + + -- Start of processing for Handle_Selected_Component + + begin + pragma Assert (Nkind (Sel_Comp) = N_Selected_Component); + + -- Climb up the tree starting from Current_Node searching for the + -- enclosing subprogram call of a prefixed notation call. + + Search_Enclosing_Call (Call_Node, Prev_Node); + + -- Search for a candidate visible (or potentially visible) + -- dispatching primitive that has at least one formal, and may + -- be called using the prefix notation. This must be done even + -- if we did not found an enclosing call since the prefix notation + -- call has not been transformed yet into a subprogram call. The + -- found Call_Node (if any) is passed now to help identifying if + -- the prefix notation call corresponds with a procedure call or + -- a function call. + + Search_Constant_Interpretation + (Call => Call_Node, + Target_Name => Selector_Name (Sel_Comp), + Candidate => Candidate, + Is_Unique => Is_Unique, + Unique_Mode => Unique_Mode); + + -- If there is no candidate to interpret this node as a prefixed + -- call to a subprogram we return no candidate, and the caller + -- will continue ascending in the tree. + + if No (Candidate) then + Is_Constant_Idx := False; + + -- If we found an unique candidate and also found the enclosing + -- call node, we differentiate two cases: either we climbed up + -- the tree through the first actual parameter of the call (that + -- is, the name of the selected component), or we climbed up the + -- tree though another actual parameter of the prefixed call and + -- we must skip the controlling formal of the call. + + elsif Is_Unique + and then Present (Call_Node) + then + -- First actual parameter + + if Name (Call_Node) = Prev_Node + and then Nkind (Prev_Node) = N_Selected_Component + and then Nkind (Selector_Name (Prev_Node)) in N_Has_Chars + and then Chars (Selector_Name (Prev_Node)) = Chars (Candidate) + then + Is_Constant_Idx := Has_IN_Mode (First_Formal (Candidate)); + + -- Any other actual parameter + + else + Is_Constant_Idx := + Expr_Matches_In_Formal (Candidate, + Subp_Call => Call_Node, + Param => Prev_Node, + Skip_Controlling_Formal => True); + end if; + + -- The mode of the first formal of all the candidates match but, + -- given that we have several candidates, we cannot check if + -- indexing is used in the first actual parameter of the call + -- or in another actual parameter. Heuristically assume here + -- that indexing is used in the prefix of a call. + + elsif Unique_Mode then + Heuristic := True; + Is_Constant_Idx := Has_IN_Mode (First_Formal (Candidate)); + + -- The target candidate subprogram has several possible + -- interpretations; we don't know what to do with an + -- N_Selected_Component node for a prefixed notation call + -- to AA.BB that has several candidate targets and it has + -- not yet been resolved. For now we maintain the + -- behavior that we have had so far; to be improved??? + + else + Heuristic := True; + + if Nkind (Call_Node) = N_Procedure_Call_Statement then + Is_Constant_Idx := False; + + -- For function calls we rely on the mode of the + -- first formal of the first found candidate??? + + else + Is_Constant_Idx := Has_IN_Mode (First_Formal (Candidate)); + end if; + end if; + end Handle_Selected_Component; + + -- Local variables + + Asp_Constant : constant Node_Id := + Find_Value_Of_Aspect (Pref_Typ, + Aspect_Constant_Indexing); + Asp_Variable : constant Node_Id := + Find_Value_Of_Aspect (Pref_Typ, + Aspect_Variable_Indexing); + Par : Node_Id; + + -- Start of processing for Constant_Indexing_OK begin - if No (Find_Value_Of_Aspect (Pref_Typ, Aspect_Variable_Indexing)) then + if No (Asp_Constant) then + return False; + + -- It is interpreted as constant indexing when the prefix has the + -- Constant_Indexing aspect and the Variable_Indexing aspect is not + -- specified for the type of the prefix. + + elsif No (Asp_Variable) then return True; + -- It is interpreted as constant indexing when the prefix denotes + -- a constant. + elsif not Is_Variable (Prefix) then return True; end if; + -- Both aspects are present + + pragma Assert (Present (Asp_Constant) and Present (Asp_Variable)); + + -- The prefix must be interpreted as a constant indexing when it + -- is used within a primary where a name denoting a constant is + -- permitted. + Par := N; while Present (Par) loop - if Nkind (Parent (Par)) = N_Assignment_Statement - and then Par = Name (Parent (Par)) + + -- Avoid climbing more than needed + + exit when Nkind (Parent (Par)) in N_Iterator_Specification + | N_Handled_Sequence_Of_Statements; + + if Nkind (Parent (Par)) in N_Case_Statement + | N_Declaration + | N_Elsif_Part + | N_If_Statement + | N_Simple_Return_Statement then - return False; + return True; + + -- It is not interpreted as constant indexing for the variable + -- name in the LHS of an assignment. + + elsif Nkind (Parent (Par)) = N_Assignment_Statement then + return Par /= Name (Parent (Par)); -- The call may be overloaded, in which case we assume that its -- resolution does not depend on the type of the parameter that - -- includes the indexing operation. + -- includes the indexing operation because we cannot invoke + -- Preanalyze_And_Resolve (since it would cause a never-ending + -- loop). elsif Nkind (Parent (Par)) in N_Subprogram_Call then - if not Is_Entity_Name (Name (Parent (Par))) then + -- Regular subprogram call - -- ??? We don't know what to do with an N_Selected_Component - -- node for a prefixed-notation call to AA.BB where AA's - -- type is known, but BB has not yet been resolved. In that - -- case, the preceding Is_Entity_Name call returns False. - -- Incorrectly returning False here will usually work - -- better than incorrectly returning True, so that's what - -- we do for now. + -- It is not interpreted as constant indexing for the name + -- used for an OUT or IN OUT parameter. - return False; - end if; - - declare - Proc : Entity_Id; - - begin - -- We should look for an interpretation with the proper - -- number of formals, and determine whether it is an - -- In_Parameter, but for now we examine the formal that - -- corresponds to the indexing, and assume that variable - -- indexing is required if some interpretation has an - -- assignable formal at that position. Still does not - -- cover the most complex cases ??? + -- We should look for an interpretation with the proper + -- number of formals, and determine whether it is an + -- In_Parameter, but for now we examine the formal that + -- corresponds to the indexing, and assume that variable + -- indexing is required if some interpretation has an + -- assignable formal at that position. Still does not + -- cover the most complex cases ??? + if Is_Entity_Name (Name (Parent (Par))) then if Is_Overloaded (Name (Parent (Par))) then declare Proc : constant Node_Id := Name (Parent (Par)); @@ -8596,57 +8978,103 @@ package body Sem_Ch4 is begin Get_First_Interp (Proc, I, It); while Present (It.Nam) loop - if not Expr_Matches_In_Formal (It.Nam, Par) then + if not Expr_Matches_In_Formal + (Subp => It.Nam, + Subp_Call => Parent (Par), + Param => Par) + then return False; end if; Get_Next_Interp (I, It); end loop; - end; - -- All interpretations have a matching in-mode formal + -- All interpretations have a matching in-mode formal - return True; + return True; + end; else - Proc := Entity (Name (Parent (Par))); + declare + Proc : Entity_Id := Entity (Name (Parent (Par))); - -- If this is an indirect call, get formals from - -- designated type. + begin + -- If this is an indirect call, get formals from + -- designated type. - if Is_Access_Subprogram_Type (Etype (Proc)) then - Proc := Designated_Type (Etype (Proc)); - end if; + if Is_Access_Subprogram_Type (Etype (Proc)) then + Proc := Designated_Type (Etype (Proc)); + end if; + + return Expr_Matches_In_Formal + (Subp => Proc, + Subp_Call => Parent (Par), + Param => Par); + end; end if; - return Expr_Matches_In_Formal (Proc, Par); - end; + -- Continue climbing + + elsif Nkind (Name (Parent (Par))) = N_Explicit_Dereference then + null; + + -- Not a regular call; we know that we are in a subprogram + -- call, we also know that the name of the call may be a + -- prefixed call, and we know the name of the target + -- subprogram. Search for an unique target candidate in the + -- homonym chain. + + elsif Nkind (Name (Parent (Par))) = N_Selected_Component then + declare + Candidate : Entity_Id; + Is_Constant_Idx : Boolean; + + begin + Handle_Selected_Component + (Current_Node => Par, + Sel_Comp => Name (Parent (Par)), + Candidate => Candidate, + Is_Constant_Idx => Is_Constant_Idx); + + if Present (Candidate) then + return Is_Constant_Idx; + + -- Continue climbing + + else + null; + end if; + end; + end if; + + -- It is not interpreted as constant indexing for the name in + -- an object renaming. elsif Nkind (Parent (Par)) = N_Object_Renaming_Declaration then return False; - -- If the indexed component is a prefix it may be the first actual - -- of a prefixed call. Retrieve the called entity, if any, and - -- check its first formal. Determine if the context is a procedure - -- or function call. + -- If the indexed component is a prefix it may be an actual of + -- of a prefixed call. elsif Nkind (Parent (Par)) = N_Selected_Component then declare - Sel : constant Node_Id := Selector_Name (Parent (Par)); - Nam : constant Entity_Id := Current_Entity (Sel); + Candidate : Entity_Id; + Is_Constant_Idx : Boolean; begin - if Present (Nam) and then Is_Overloadable (Nam) then - if Nkind (Parent (Parent (Par))) = - N_Procedure_Call_Statement - then - return False; + Handle_Selected_Component + (Current_Node => Par, + Sel_Comp => Parent (Par), + Candidate => Candidate, + Is_Constant_Idx => Is_Constant_Idx); - elsif Ekind (Nam) = E_Function - and then Present (First_Formal (Nam)) - then - return Ekind (First_Formal (Nam)) = E_In_Parameter; - end if; + if Present (Candidate) then + return Is_Constant_Idx; + + -- Continue climbing + + else + null; end if; end; @@ -8657,61 +9085,12 @@ package body Sem_Ch4 is Par := Parent (Par); end loop; - -- In all other cases, constant indexing is legal + -- It is not interpreted as constant indexing when both aspects + -- are present (RM 4.1.6(13/3)). - return True; + return False; end Constant_Indexing_OK; - ---------------------------- - -- Expr_Matches_In_Formal -- - ---------------------------- - - function Expr_Matches_In_Formal - (Subp : Entity_Id; - Par : Node_Id) return Boolean - is - Actual : Node_Id; - Formal : Node_Id; - - begin - Formal := First_Formal (Subp); - Actual := First (Parameter_Associations ((Parent (Par)))); - - if Nkind (Par) /= N_Parameter_Association then - - -- Match by position - - while Present (Actual) and then Present (Formal) loop - exit when Actual = Par; - Next (Actual); - - if Present (Formal) then - Next_Formal (Formal); - - -- Otherwise this is a parameter mismatch, the error is - -- reported elsewhere, or else variable indexing is implied. - - else - return False; - end if; - end loop; - - else - -- Match by name - - while Present (Formal) loop - exit when Chars (Formal) = Chars (Selector_Name (Par)); - Next_Formal (Formal); - - if No (Formal) then - return False; - end if; - end loop; - end if; - - return Present (Formal) and then Ekind (Formal) = E_In_Parameter; - end Expr_Matches_In_Formal; - ------------------------------ -- Indexing_Interpretations -- ------------------------------ @@ -8761,14 +9140,127 @@ package body Sem_Ch4 is return Indexing_Func; end Indexing_Interpretations; + --------------------------- + -- Try_Indexing_Function -- + --------------------------- + + function Try_Indexing_Function + (Func_Name : Node_Id; + Assoc : List_Id) return Entity_Id + is + Loc : constant Source_Ptr := Sloc (N); + Func : Entity_Id; + Indexing : Node_Id; + + begin + if not Is_Overloaded (Func_Name) then + Func := Entity (Func_Name); + + Indexing := + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Func, Loc), + Parameter_Associations => Assoc); + + Set_Parent (Indexing, Parent (N)); + Set_Generalized_Indexing (N, Indexing); + Analyze (Indexing); + Set_Etype (N, Etype (Indexing)); + + -- If the return type of the indexing function is a reference + -- type, add the dereference as a possible interpretation. Note + -- that the indexing aspect may be a function that returns the + -- element type with no intervening implicit dereference, and + -- that the reference discriminant is not the first discriminant. + + if Has_Discriminants (Etype (Func)) then + Check_Implicit_Dereference (N, Etype (Func)); + end if; + + else + -- If there are multiple indexing functions, build a function + -- call and analyze it for each of the possible interpretations. + + Indexing := + Make_Function_Call (Loc, + Name => + Make_Identifier (Loc, Chars (Func_Name)), + Parameter_Associations => Assoc); + Set_Parent (Indexing, Parent (N)); + Set_Generalized_Indexing (N, Indexing); + Set_Etype (N, Any_Type); + Set_Etype (Name (Indexing), Any_Type); + + declare + I : Interp_Index; + It : Interp; + Success : Boolean; + + begin + Get_First_Interp (Func_Name, I, It); + Set_Etype (Indexing, Any_Type); + + -- Analyze each candidate function with the given actuals + + while Present (It.Nam) loop + Analyze_One_Call (Indexing, It.Nam, False, Success); + Get_Next_Interp (I, It); + end loop; + + -- If there are several successful candidates, resolution will + -- be by result. Mark the interpretations of the function name + -- itself. + + if Is_Overloaded (Indexing) then + Get_First_Interp (Indexing, I, It); + + while Present (It.Nam) loop + Add_One_Interp (Name (Indexing), It.Nam, It.Typ); + Get_Next_Interp (I, It); + end loop; + + else + Set_Etype (Name (Indexing), Etype (Indexing)); + end if; + + -- Now add the candidate interpretations to the indexing node + -- itself, to be replaced later by the function call. + + if Is_Overloaded (Name (Indexing)) then + Get_First_Interp (Name (Indexing), I, It); + + while Present (It.Nam) loop + Add_One_Interp (N, It.Nam, It.Typ); + + -- Add dereference interpretation if the result type has + -- implicit reference discriminants. + + if Has_Discriminants (Etype (It.Nam)) then + Check_Implicit_Dereference (N, Etype (It.Nam)); + end if; + + Get_Next_Interp (I, It); + end loop; + + else + Set_Etype (N, Etype (Name (Indexing))); + + if Has_Discriminants (Etype (N)) then + Check_Implicit_Dereference (N, Etype (N)); + end if; + end if; + end; + end if; + + return Etype (Indexing); + end Try_Indexing_Function; + -- Local variables Loc : constant Source_Ptr := Sloc (N); Assoc : List_Id; C_Type : Entity_Id; - Func : Entity_Id; Func_Name : Node_Id; - Indexing : Node_Id; + Idx_Type : Entity_Id; -- Start of processing for Try_Container_Indexing @@ -8778,6 +9270,13 @@ package body Sem_Ch4 is if Present (Generalized_Indexing (N)) then return True; + + -- Old language version or unknown type require no action + + elsif Ada_Version < Ada_2012 + or else Pref_Typ = Any_Type + then + return False; end if; -- An explicit dereference needs to be created in the case of a prefix @@ -8812,8 +9311,8 @@ package body Sem_Ch4 is Func_Name := Empty; - -- The context is suitable for constant indexing, so obtain the name of - -- the indexing functions from aspect Constant_Indexing. + -- The context is suitable for constant indexing, so obtain the name + -- of the indexing functions from aspect Constant_Indexing. if Constant_Indexing_OK then Func_Name := @@ -8846,6 +9345,11 @@ package body Sem_Ch4 is else return False; end if; + + -- Handle cascaded errors + + elsif No (Entity (Func_Name)) then + return False; end if; Assoc := New_List (Relocate_Node (Prefix)); @@ -8886,110 +9390,54 @@ package body Sem_Ch4 is end loop; end; - if not Is_Overloaded (Func_Name) then - Func := Entity (Func_Name); - - -- Can happen in case of e.g. cascaded errors - - if No (Func) then - return False; - end if; - - Indexing := - Make_Function_Call (Loc, - Name => New_Occurrence_Of (Func, Loc), - Parameter_Associations => Assoc); - - Set_Parent (Indexing, Parent (N)); - Set_Generalized_Indexing (N, Indexing); - Analyze (Indexing); - Set_Etype (N, Etype (Indexing)); - - -- If the return type of the indexing function is a reference type, - -- add the dereference as a possible interpretation. Note that the - -- indexing aspect may be a function that returns the element type - -- with no intervening implicit dereference, and that the reference - -- discriminant is not the first discriminant. - - if Has_Discriminants (Etype (Func)) then - Check_Implicit_Dereference (N, Etype (Func)); - end if; - - else - -- If there are multiple indexing functions, build a function call - -- and analyze it for each of the possible interpretations. - - Indexing := - Make_Function_Call (Loc, - Name => - Make_Identifier (Loc, Chars (Func_Name)), - Parameter_Associations => Assoc); - Set_Parent (Indexing, Parent (N)); - Set_Generalized_Indexing (N, Indexing); - Set_Etype (N, Any_Type); - Set_Etype (Name (Indexing), Any_Type); - + Idx_Type := Try_Indexing_Function (Func_Name, Assoc); + + -- Last chance handling for heuristics: Given that prefix notation + -- calls have not yet been resolved, when the type of the prefix has + -- both operational aspects present (Constant_Indexing and Variable_ + -- Indexing), and the analysis of the context identified a potential + -- prefix notation call (i.e. an N_Selected_Component node), the + -- evaluation of Constant_Indexing_OK is based on heuristics; in such + -- case, if the chosen indexing approach is noticed now to be wrong + -- we retry with the other alternative before leaving. + + -- Retrying means that the heuristic decision taken when analyzing + -- the context failed in this case, and therefore we should adjust + -- the code of Handle_Selected_Component to improve identification + -- of prefix notation calls. This last chance handling handler is + -- left here for the purpose of improving such routine because it + -- proved to be usefull for identified such cases when the function + -- Handle_Selected_Component was added. + + if Idx_Type = Any_Type and then Heuristic then declare - I : Interp_Index; - It : Interp; - Success : Boolean; + Tried_Func_Name : constant Node_Id := Func_Name; begin - Get_First_Interp (Func_Name, I, It); - Set_Etype (Indexing, Any_Type); + Func_Name := + Indexing_Interpretations (C_Type, + Aspect_Constant_Indexing); - -- Analyze each candidate function with the given actuals - - while Present (It.Nam) loop - Analyze_One_Call (Indexing, It.Nam, False, Success); - Get_Next_Interp (I, It); - end loop; - - -- If there are several successful candidates, resolution will - -- be by result. Mark the interpretations of the function name - -- itself. - - if Is_Overloaded (Indexing) then - Get_First_Interp (Indexing, I, It); - - while Present (It.Nam) loop - Add_One_Interp (Name (Indexing), It.Nam, It.Typ); - Get_Next_Interp (I, It); - end loop; + if Present (Func_Name) + and then Func_Name /= Tried_Func_Name + then + Idx_Type := Try_Indexing_Function (Func_Name, Assoc); else - Set_Etype (Name (Indexing), Etype (Indexing)); - end if; - - -- Now add the candidate interpretations to the indexing node - -- itself, to be replaced later by the function call. - - if Is_Overloaded (Name (Indexing)) then - Get_First_Interp (Name (Indexing), I, It); - - while Present (It.Nam) loop - Add_One_Interp (N, It.Nam, It.Typ); - - -- Add dereference interpretation if the result type has - -- implicit reference discriminants. + Func_Name := + Indexing_Interpretations (C_Type, + Aspect_Variable_Indexing); - if Has_Discriminants (Etype (It.Nam)) then - Check_Implicit_Dereference (N, Etype (It.Nam)); - end if; - - Get_Next_Interp (I, It); - end loop; - - else - Set_Etype (N, Etype (Name (Indexing))); - if Has_Discriminants (Etype (N)) then - Check_Implicit_Dereference (N, Etype (N)); + if Present (Func_Name) + and then Func_Name /= Tried_Func_Name + then + Idx_Type := Try_Indexing_Function (Func_Name, Assoc); end if; end if; end; end if; - if Etype (Indexing) = Any_Type then + if Idx_Type = Any_Type then Error_Msg_NE ("container cannot be indexed with&", N, Etype (First (Exprs))); Rewrite (N, New_Occurrence_Of (Any_Id, Loc)); -- cgit v1.1 From 69eb1716b884f6213aef30194390d7741af97c80 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Sat, 7 Jun 2025 00:25:44 +0000 Subject: Daily bump. --- gcc/ChangeLog | 95 +++++++++++++++++++++++++++++++++++++++++++++++++ gcc/DATESTAMP | 2 +- gcc/ada/ChangeLog | 61 +++++++++++++++++++++++++++++++ gcc/testsuite/ChangeLog | 62 ++++++++++++++++++++++++++++++++ 4 files changed, 219 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ChangeLog b/gcc/ChangeLog index d11e9f1..e4f3f94 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,98 @@ +2025-06-06 Tobias Burnus + + Backported from master: + 2025-06-05 Tobias Burnus + + * config.gcc (--with-{arch,tune}): Use .def file to validate gcn + processor names. + * doc/install.texi (amdgcn*-*-*): Update list of devices supported + by --with-arch/--with-tune. + +2025-06-06 Richard Biener + + Backported from master: + 2025-05-31 Richard Biener + + PR tree-optimization/120357 + * tree-vect-loop.cc (vect_create_epilog_for_reduction): Create + the conditional reduction induction IV increment before the + main IV exit. + +2025-06-06 Richard Biener + + Backported from master: + 2025-05-30 Richard Biener + + PR tree-optimization/120341 + * tree-ssa-loop-im.cc (can_sm_ref_p): STRING_CSTs are readonly. + * tree-ssa-phiopt.cc (cond_store_replacement): Likewise. + +2025-06-06 Richard Biener + + Backported from master: + 2025-05-09 Richard Biener + + PR rtl-optimization/120182 + * dse.cc (canon_address): Constant addresses have no + separate store group. + +2025-06-06 Richard Biener + + Backported from master: + 2025-04-30 Richard Biener + + PR tree-optimization/120003 + * tree-ssa-threadbackward.cc (back_threader::find_paths_to_names): + Allow block re-use but do not enlarge the path beyond such a + re-use. + +2025-06-06 Richard Biener + + Backported from master: + 2025-05-09 Richard Biener + + PR tree-optimization/119960 + * tree-vect-slp.cc (vect_slp_can_convert_to_external): + Handle cases where defs from multiple BBs are ordered + by their dominance relation. + +2025-06-06 Richard Biener + + Backported from master: + 2025-05-08 Richard Biener + + PR tree-optimization/116352 + * tree-vect-slp.cc (vect_build_slp_tree_2): When compressing + operands from a two-operator node make sure the resulting + operation does not mix defs from different basic-blocks. + +2025-06-06 Richard Biener + + Backported from master: + 2025-04-30 Richard Biener + + PR tree-optimization/119960 + * tree-vect-slp.cc (vect_schedule_slp_node): Sanity + check dominance check on operand defs. + +2025-06-06 Richard Biener + + Backported from master: + 2025-04-30 Richard Biener + + * tree-vectorizer.h (get_later_stmt): Robustify against + stmts in different BBs, assert when they are unordered. + +2025-06-06 Richard Biener + + Backported from master: + 2025-05-15 Richard Biener + + * config/i386/i386.cc (ix86_vector_costs::finish_cost): + Do not suggest a first epilogue mode for AVX512 sized + main loops with X86_TUNE_AVX512_TWO_EPILOGUES as that + interferes with using a masked epilogue. + 2025-06-05 Eric Botcazou * tree-vect-data-refs.cc (vect_can_force_dr_alignment_p): Return diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index c6de4e3..a3a91b5 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20250606 +20250607 diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 331a8ab..1f32f1e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,64 @@ +2025-06-06 Javier Miranda + + * sem_ch4.adb (Constant_Indexing_OK): Add missing support for + RM 4.1.6(13/3), and improve performance to avoid climbing more + than needed. Add documentation. + (Try_Indexing_Function): New subprogram. + (Expr_Matches_In_Formal): Added new formals. + (Handle_Selected_Component): New subprogram. + (Has_IN_Mode): New subprogram. + (Try_Container_Indexing): Add documentation, code reorganization + and extend its functionality to improve its support for prefixed + notation calls. + +2025-06-06 Eric Botcazou + + * sem_ch10.adb (Install_Siblings.In_Context): Add missing guard. + +2025-06-06 Eric Botcazou + + * exp_ch4.adb (Insert_Conditional_Object_Declaration): Make sure the + object is allocated properly by the code generator at library level. + +2025-06-06 Steve Baird + + * sem_ch4.adb + (Find_Unary_Types): Because we reanalyze names in an instance, + we sometimes have to take steps to filter out extraneous name + resolution candidates that happen to be visible at the point of the + instance declaration. Remove some code that appears to have been + written with this in mind. This is done for two reasons. First, the + code sometimes doesn't work (possibly because the In_Instance test + is not specific enough - it probably should be testing to see whether + we are in an instance of the particular generic in which the result + of calling Corresponding_Generic_Type was declared) and causes correct + code to be rejected. Second, the code seems to no longer be necessary + (possibly because of subsequent fixes in this area which are not + specific to unary operators). + +2025-06-06 Eric Botcazou + + * exp_aggr.adb (Expand_Record_Aggregate): Use the named form for the + second actual parameter in the call to Duplicate_Subexpr. + * exp_attr.adb (Expand_Size_Attribute): Likewise. + * exp_ch5.adb (Expand_Assign_Array): Likewise. + (Expand_Assign_Array_Bitfield): Likewise. + (Expand_Assign_Array_Bitfield_Fast): Likewise. + * exp_util.ads (Duplicate_Subexpr): Add New_Scope formal parameter. + (Duplicate_Subexpr_No_Checks): Likewise. + (Duplicate_Subexpr_Move_Checks): Likewise. + * exp_util.adb (Build_Allocate_Deallocate_Proc): Pass Proc_Id as the + actual for New_Scope in the calls to Duplicate_Subexpr_No_Checks. + (Duplicate_Subexpr): Add New_Scope formal parameter and forward it + in the call to New_Copy_Tree. + (Duplicate_Subexpr_No_Checks): Likewise. + (Duplicate_Subexpr_Move_Checks): Likewise. + +2025-06-06 Piotr Trojanek + + * checks.adb (Insert_Valid_Check): Set flag Assignment_OK in the object + declaration inserted for the validity checks. + 2025-06-05 Javier Miranda * exp_ch7.adb (Process_Object_Declaration): Avoid generating diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1175523..dede789 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,65 @@ +2025-06-06 Richard Biener + + Backported from master: + 2025-05-31 Richard Biener + + PR tree-optimization/120357 + * gcc.dg/vect/vect-early-break_136-pr120357.c: New testcase. + +2025-06-06 Richard Biener + + Backported from master: + 2025-05-30 Richard Biener + + PR tree-optimization/120341 + * gcc.dg/torture/pr120341-1.c: New testcase. + * gcc.dg/torture/pr120341-2.c: Likewise. + +2025-06-06 Richard Biener + + Backported from master: + 2025-05-09 Richard Biener + + PR rtl-optimization/120182 + * gcc.dg/torture/pr120182.c: New testcase. + +2025-06-06 Richard Biener + + Backported from master: + 2025-05-01 Richard Biener + + PR tree-optimization/120003 + * gcc.dg/tree-ssa/ssa-dom-thread-7.c: Adjust aarch64 expected + thread2 number of threads. + +2025-06-06 Richard Biener + + Backported from master: + 2025-04-30 Richard Biener + + PR tree-optimization/120003 + * gcc.dg/tree-ssa/ssa-thread-23.c: New testcase. + * gcc.dg/tree-ssa/ssa-dom-thread-7.c: Adjust. + +2025-06-06 Richard Biener + + Backported from master: + 2025-05-09 Richard Biener + + PR tree-optimization/119960 + * gcc.dg/vect/bb-slp-pr119960-1.c: New testcase. + +2025-06-06 Richard Biener + + Backported from master: + 2025-05-15 Richard Biener + + * gcc.target/i386/vect-epilogues-1.c: New testcase. + * gcc.target/i386/vect-epilogues-2.c: Likewise. + * gcc.target/i386/vect-epilogues-3.c: Likewise. + * gcc.target/i386/vect-epilogues-4.c: Likewise. + * gcc.target/i386/vect-epilogues-5.c: Likewise. + 2025-06-05 Eric Botcazou * gnat.dg/specs/opt7.ads: New test. -- cgit v1.1 From 4caedcd8cf0c2ff30553970a3f3e43354d7f842f Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Sun, 8 Jun 2025 00:23:18 +0000 Subject: Daily bump. --- gcc/DATESTAMP | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index a3a91b5..800deb1 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20250607 +20250608 -- cgit v1.1 From c8934b1c08111222ccf64932272e2b7ba793fccd Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Mon, 9 Jun 2025 00:23:58 +0000 Subject: Daily bump. --- gcc/DATESTAMP | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 800deb1..d0f154b 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20250608 +20250609 -- cgit v1.1 From 823e9733520536cf1fc427d6a128f5a7a48cc3b5 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 27 Feb 2025 20:43:04 +0100 Subject: ada: Fix spurious error on anonymous array initialized by conditional expression Even though the actual subtype of the anonymous array is not yet set on the object itself by the time Insert_Conditional_Object_Declaration is called, it is set on its initialization expression, so it can simply be forwarded to Insert_Conditional_Object_Declaration from there, which avoids creating a new one for each new object and triggering a subtype mismatch later. gcc/ada/ChangeLog: * exp_ch4.adb (Insert_Conditional_Object_Declaration): Remove Decl formal parameter, add Typ and Const formal parameters. (Expand_N_Case_Expression): Fix pasto in comment. Adjust call to Insert_Conditional_Object_Declaration and tidy up surrounding code. (Expand_N_If_Expression): Adjust couple of calls to Insert_Conditional_Object_Declaration. --- gcc/ada/exp_ch4.adb | 43 +++++++++++++++++++++---------------------- 1 file changed, 21 insertions(+), 22 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 793e468..161bcee 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -193,12 +193,12 @@ package body Exp_Ch4 is procedure Insert_Conditional_Object_Declaration (Obj_Id : Entity_Id; + Typ : Entity_Id; Expr : Node_Id; - Decl : Node_Id); - -- Expr is the dependent expression of a conditional expression and Decl - -- is the declaration of an object whose initialization expression is the - -- conditional expression. Insert in the actions of Expr the declaration - -- of Obj_Id modeled on Decl and with Expr as initialization expression. + Const : Boolean); + -- Expr is the dependent expression of a conditional expression. Insert in + -- the actions of Expr the declaration of Obj_Id with type Typ and Expr as + -- initialization expression. Const is True when Obj_Id is a constant. procedure Insert_Dereference_Action (N : Node_Id); -- N is an expression whose type is an access. When the type of the @@ -5304,7 +5304,7 @@ package body Exp_Ch4 is -- 'Unrestricted_Access. -- Generate: - -- type Ptr_Typ is not null access all [constant] Typ; + -- type Target_Typ is not null access all [constant] Typ; else Target_Typ := Make_Temporary (Loc, 'P'); @@ -5402,20 +5402,16 @@ package body Exp_Ch4 is elsif Optimize_Object_Decl then Obj := Make_Temporary (Loc, 'C', Alt_Expr); - Insert_Conditional_Object_Declaration (Obj, Alt_Expr, Par); - - Alt_Expr := - Make_Attribute_Reference (Alt_Loc, - Prefix => New_Occurrence_Of (Obj, Alt_Loc), - Attribute_Name => Name_Unrestricted_Access); - - LHS := New_Occurrence_Of (Target, Loc); - Set_Assignment_OK (LHS); + Insert_Conditional_Object_Declaration + (Obj, Typ, Alt_Expr, Const => Constant_Present (Par)); Stmts := New_List ( Make_Assignment_Statement (Alt_Loc, - Name => LHS, - Expression => Alt_Expr)); + Name => New_Occurrence_Of (Target, Loc), + Expression => + Make_Attribute_Reference (Alt_Loc, + Prefix => New_Occurrence_Of (Obj, Alt_Loc), + Attribute_Name => Name_Unrestricted_Access))); -- Take the unrestricted access of the expression value for non- -- scalar types. This approach avoids big copies and covers the @@ -6013,8 +6009,10 @@ package body Exp_Ch4 is Target : constant Entity_Id := Make_Temporary (Loc, 'C', N); begin - Insert_Conditional_Object_Declaration (Then_Obj, Thenx, Par); - Insert_Conditional_Object_Declaration (Else_Obj, Elsex, Par); + Insert_Conditional_Object_Declaration + (Then_Obj, Typ, Thenx, Const => Constant_Present (Par)); + Insert_Conditional_Object_Declaration + (Else_Obj, Typ, Elsex, Const => Constant_Present (Par)); -- Generate: -- type Ptr_Typ is not null access all [constant] Typ; @@ -13285,16 +13283,17 @@ package body Exp_Ch4 is procedure Insert_Conditional_Object_Declaration (Obj_Id : Entity_Id; + Typ : Entity_Id; Expr : Node_Id; - Decl : Node_Id) + Const : Boolean) is Loc : constant Source_Ptr := Sloc (Expr); Obj_Decl : constant Node_Id := Make_Object_Declaration (Loc, Defining_Identifier => Obj_Id, Aliased_Present => True, - Constant_Present => Constant_Present (Decl), - Object_Definition => New_Copy_Tree (Object_Definition (Decl)), + Constant_Present => Const, + Object_Definition => New_Occurrence_Of (Typ, Loc), Expression => Relocate_Node (Expr)); -- We make the object unconditionally aliased to avoid dangling bound -- issues when its nominal subtype is an unconstrained array type. -- cgit v1.1 From 8a63f6bd618decc974a46c50894f3b450e025f95 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Fri, 28 Feb 2025 00:08:19 +0000 Subject: ada: Incorrect creation of corresponding expression of class-wide contracts GNAT was incorrectly implementing the Ada rules for resolving calls to primitive functions within inherited class-wide pre- and postconditions, as specified in RM22 6.1.1 (relating to AI12-0113). Only function calls that involve formals of the associated primitive subprogram should be treated using the "(notional) formal derived type" rules. In particular, calls that are tag-indeterminate (for example, "F(G)") should not be mapped to call the corresponding primitives of the derived type (they should still call the primitives of the ancestor type). The fix for this involves a new predicate function that recursively traverses calls to determine the calls that satisfy the criteria for mapping. These changes also completely remove the mapping of formals that was done in Contracts.Merge_Class_Conditions (in Inherit_Condition), since the mapping will be done later anyway by Build_Class_Wide_Expression, and the earlier mapping interferes with that. Note: The utility function Sem_Util.Check_Parents is no longer called after removal of the single call to it from contracts.adb, but it's being retained (along with the generic subprograms in Atree that it depends on) for possible use in VAST. gcc/ada/ChangeLog: * contracts.adb (Inherit_Condition): Remove Assoc_List and its uses along with function Check_Condition, since mapping of formals will effectively be done in Build_Class_Wide_Expression (by Replace_Entity). * exp_util.adb (Replace_Entity): Only rewrite entity references in function calls that qualify according to the result of calling the new function Call_To_Parent_Dispatching_Op_Must_Be_Mapped. (Call_To_Parent_Dispatching_Op_Must_Be_Mapped): New function that determines whether a function call to a primitive of Par_Subp associated tagged type needs to be mapped (according to whether it has any actuals that reference controlling formals of the primitive). --- gcc/ada/contracts.adb | 103 ++++----------------------------------------- gcc/ada/exp_util.adb | 113 +++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 121 insertions(+), 95 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 8b94a67..e0eb26e 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -4389,10 +4389,10 @@ package body Contracts is Seen : Subprogram_List (Subps'Range) := (others => Empty); function Inherit_Condition - (Par_Subp : Entity_Id; - Subp : Entity_Id) return Node_Id; - -- Inherit the class-wide condition from Par_Subp to Subp and adjust - -- all the references to formals in the inherited condition. + (Par_Subp : Entity_Id) return Node_Id; + -- Inherit the class-wide condition from Par_Subp. Simply makes + -- a copy of the condition in preparation for later mapping of + -- referenced formals and functions by Build_Class_Wide_Expression. procedure Merge_Conditions (From : Node_Id; Into : Node_Id); -- Merge two class-wide preconditions or postconditions (the former @@ -4407,92 +4407,11 @@ package body Contracts is ----------------------- function Inherit_Condition - (Par_Subp : Entity_Id; - Subp : Entity_Id) return Node_Id - is - function Check_Condition (Expr : Node_Id) return Boolean; - -- Used in assertion to check that Expr has no reference to the - -- formals of Par_Subp. - - --------------------- - -- Check_Condition -- - --------------------- - - function Check_Condition (Expr : Node_Id) return Boolean is - Par_Formal_Id : Entity_Id; - - function Check_Entity (N : Node_Id) return Traverse_Result; - -- Check occurrence of Par_Formal_Id - - ------------------ - -- Check_Entity -- - ------------------ - - function Check_Entity (N : Node_Id) return Traverse_Result is - begin - if Nkind (N) = N_Identifier - and then Present (Entity (N)) - and then Entity (N) = Par_Formal_Id - then - return Abandon; - end if; - - return OK; - end Check_Entity; - - function Check_Expression is new Traverse_Func (Check_Entity); - - -- Start of processing for Check_Condition - - begin - Par_Formal_Id := First_Formal (Par_Subp); - - while Present (Par_Formal_Id) loop - if Check_Expression (Expr) = Abandon then - return False; - end if; - - Next_Formal (Par_Formal_Id); - end loop; - - return True; - end Check_Condition; - - -- Local variables - - Assoc_List : constant Elist_Id := New_Elmt_List; - Par_Formal_Id : Entity_Id := First_Formal (Par_Subp); - Subp_Formal_Id : Entity_Id := First_Formal (Subp); - New_Condition : Node_Id; - + (Par_Subp : Entity_Id) return Node_Id is begin - while Present (Par_Formal_Id) loop - Append_Elmt (Par_Formal_Id, Assoc_List); - Append_Elmt (Subp_Formal_Id, Assoc_List); - - Next_Formal (Par_Formal_Id); - Next_Formal (Subp_Formal_Id); - end loop; - - -- Check that Parent field of all the nodes have their correct - -- decoration; required because otherwise mapped nodes with - -- wrong Parent field are left unmodified in the copied tree - -- and cause reporting wrong errors at later stages. - - pragma Assert - (Check_Parents (Class_Condition (Kind, Par_Subp), Assoc_List)); - - New_Condition := + return New_Copy_Tree - (Source => Class_Condition (Kind, Par_Subp), - Map => Assoc_List); - - -- Ensure that the inherited condition has no reference to the - -- formals of the parent subprogram. - - pragma Assert (Check_Condition (New_Condition)); - - return New_Condition; + (Source => Class_Condition (Kind, Par_Subp)); end Inherit_Condition; ---------------------- @@ -4606,9 +4525,7 @@ package body Contracts is Par_Prim := Subp_Id; Par_Iface_Prims := Covered_Interface_Primitives (Par_Prim); - Cond := Inherit_Condition - (Subp => Spec_Id, - Par_Subp => Subp_Id); + Cond := Inherit_Condition (Par_Subp => Subp_Id); if Present (Class_Cond) then Merge_Conditions (Cond, Class_Cond); @@ -4652,9 +4569,7 @@ package body Contracts is then Seen (Index) := Subp_Id; - Cond := Inherit_Condition - (Subp => Spec_Id, - Par_Subp => Subp_Id); + Cond := Inherit_Condition (Par_Subp => Subp_Id); Check_Class_Condition (Cond => Cond, diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 51cc790..44e26d1 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1523,7 +1523,118 @@ package body Exp_Util is New_E := Type_Map.Get (Entity (N)); if Present (New_E) then - Rewrite (N, New_Occurrence_Of (New_E, Sloc (N))); + declare + + Ctrl_Type : constant Entity_Id + := Find_Dispatching_Type (Par_Subp); + + function Call_To_Parent_Dispatching_Op_Must_Be_Mapped + (Call_Node : Node_Id) return Boolean; + -- If Call_Node is a call to a primitive function F of the + -- tagged type T associated with Par_Subp that either has + -- any actuals that are controlling formals of Par_Subp, + -- or else the call to F is an actual parameter of an + -- enclosing call to a primitive of T that has any actuals + -- that are controlling formals of Par_Subp (and recursively + -- up the tree of enclosing function calls), returns True; + -- otherwise returns False. Returning True implies that the + -- call to F must be mapped to a call that instead targets + -- the corresponding function F of the tagged type for which + -- Subp is a primitive function. + + -------------------------------------------------- + -- Call_To_Parent_Dispatching_Op_Must_Be_Mapped -- + -------------------------------------------------- + + function Call_To_Parent_Dispatching_Op_Must_Be_Mapped + (Call_Node : Node_Id) return Boolean + is + pragma Assert (Nkind (Call_Node) = N_Function_Call); + + Actual : Node_Id := First_Actual (Call_Node); + Actual_Type : Entity_Id; + Actual_Or_Prefix : Node_Id; + + begin + if Is_Entity_Name (Name (Call_Node)) + and then Is_Dispatching_Operation + (Entity (Name (Call_Node))) + and then + Is_Ancestor + (Ctrl_Type, + Find_Dispatching_Type + (Entity (Name (Call_Node)))) + then + while Present (Actual) loop + + -- Account for 'Old and explicit dereferences, + -- picking up the prefix object in those cases. + + if (Nkind (Actual) = N_Attribute_Reference + and then Attribute_Name (Actual) = Name_Old) + or else Nkind (Actual) = N_Explicit_Dereference + then + Actual_Or_Prefix := Prefix (Actual); + else + Actual_Or_Prefix := Actual; + end if; + + Actual_Type := Etype (Actual); + + if Is_Anonymous_Access_Type (Actual_Type) then + Actual_Type := Designated_Type (Actual_Type); + end if; + + if Nkind (Actual_Or_Prefix) + in N_Identifier + | N_Expanded_Name + | N_Operator_Symbol + + and then Is_Formal (Entity (Actual_Or_Prefix)) + + and then Covers (Ctrl_Type, Actual_Type) + then + -- At least one actual is a formal parameter of + -- Par_Subp with type Ctrl_Type. + + return True; + end if; + + Next_Actual (Actual); + end loop; + + if Nkind (Parent (Call_Node)) = N_Function_Call then + return + Call_To_Parent_Dispatching_Op_Must_Be_Mapped + (Parent (Call_Node)); + end if; + + return False; + + else + return False; + end if; + end Call_To_Parent_Dispatching_Op_Must_Be_Mapped; + + begin + -- If N's entity is in the map, then the entity is either + -- a formal of the parent subprogram that should necessarily + -- be mapped, or it's a function call's target entity that + -- that should be mapped if the call involves any actuals + -- that reference formals of the parent subprogram (or the + -- function call is part of an enclosing call that similarly + -- qualifies for mapping). Rewrite a node that references + -- any such qualified entity to a new node referencing the + -- corresponding entity associated with the derived type. + + if not Is_Subprogram (Entity (N)) + or else Nkind (Parent (N)) /= N_Function_Call + or else + Call_To_Parent_Dispatching_Op_Must_Be_Mapped (Parent (N)) + then + Rewrite (N, New_Occurrence_Of (New_E, Sloc (N))); + end if; + end; end if; -- Update type of function call node, which should be the same as -- cgit v1.1 From e68026cd01d87a89d52c74238d4c1bff8764f9fc Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Tue, 4 Mar 2025 12:33:34 +0100 Subject: ada: Check validity using signedness from the type and not its base type When attribute Valid is applied to a private type, we used the signedness of its implementation base type which wrongly included negative values. gcc/ada/ChangeLog: * exp_attr.adb (Expand_N_Attribute_Reference): When expanding attribute Valid, use signedness from the validated view, not from its base type. --- gcc/ada/exp_attr.adb | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 455cc22..18179d3 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -7872,9 +7872,8 @@ package body Exp_Attr is else declare Uns : constant Boolean := - Is_Unsigned_Type (Ptyp) - or else (Is_Private_Type (Ptyp) - and then Is_Unsigned_Type (PBtyp)); + Is_Unsigned_Type (Validated_View (Ptyp)); + Size : Uint; P : Node_Id := Pref; -- cgit v1.1 From f59c4d4a6a30c655afb53236eee2bda9e2d2cbb2 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Sat, 8 Mar 2025 01:05:35 +0000 Subject: ada: Missing discriminant check on assignment of Bounded_Vector aggregate When a container aggregate for a Bounded_Vector type involves an iterated association that is assigned to a vector object whose capacity (as defined by the Capacity discriminant) is less than the number of elements of the aggregate, Constraint_Error should be raised due to failing a discriminant check on the assignment. But the compiler fails to do proper expansion, plus omits the check, and instead creates a temporary whose capacity is bounded by that of the target vector of the assignment. It attempts to assign all elements of the aggregate to the temporary, resulting in a failure on a call to the Replace_Element operation that assigns past the length of the temporary vector (which can result in a Storage_Error due to a segment violation). This is fixed by ensuring that the temporary object is declared with an unconstrained base subtype rather than the assignment target's constrained subtype. gcc/ada/ChangeLog: * exp_aggr.adb (Expand_Container_Aggregate): Use the Base_Type of the subtype provided by the context as the subtype of the temporary object initialized by the aggregate. --- gcc/ada/exp_aggr.adb | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 8f1869c..f4674f5 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -7496,10 +7496,19 @@ package body Exp_Aggr is Set_Assignment_OK (Lhs); Aggr_Code := Build_Container_Aggr_Code (N, Typ, Lhs, Init); + + -- Use the unconstrained base subtype of the subtype provided by + -- the context for declaring the temporary object (which may come + -- from a constrained assignment target), to ensure that the + -- aggregate can be successfully expanded and assigned to the + -- temporary without exceeding its capacity. (Later assignment + -- of the temporary to a target object may result in failing + -- a discriminant check.) + Prepend_To (Aggr_Code, Make_Object_Declaration (Loc, Defining_Identifier => Obj_Id, - Object_Definition => New_Occurrence_Of (Typ, Loc), + Object_Definition => New_Occurrence_Of (Base_Type (Typ), Loc), Expression => Init)); Insert_Actions (N, Aggr_Code); -- cgit v1.1 From 2fd267be72dfb0dbaa422c21888a40e69173defa Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Mon, 17 Mar 2025 12:57:26 +0100 Subject: ada: Fix glitch in handling of Atomic_Components on generic formal type In Ada 2022 aspects Atomic_Components and Volatile_Components can be specified for a formal array type, but then they need to be set on the base type entity. Otherwise we get an assertion failure in debug build and wrong legality errors in production builds. gcc/ada/ChangeLog: * sem_prag.adb (Analyze_Pragma): If pragmas apply to a formal array type, then set the flags on the base type. --- gcc/ada/sem_prag.adb | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 621edc7..17805c9 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14708,7 +14708,9 @@ package body Sem_Prag is then -- The flag is set on the base type, or on the object - if Nkind (D) = N_Full_Type_Declaration then + if Nkind (D) in N_Full_Type_Declaration + | N_Formal_Type_Declaration + then E := Base_Type (E); end if; -- cgit v1.1 From 6cc5c01aa77a1f01057a963cc5061bad4b0cc270 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Mon, 17 Mar 2025 13:20:53 +0100 Subject: ada: Reject component-related aspects on formal non-array types In Ada 2022 aspects Atomic_Components and Volatile_Components can be specified for a formal array type, but they were wrongly accepted on any formal type. Also, we don't need to check if the corresponding pragmas appear in Ada 2022 mode, because generic formal parameters can't have explicit representation pragmas in any Ada version and can only have aspects since Ada 2022. gcc/ada/ChangeLog: * sem_prag.adb (Analyze_Pragma): Fix conditions for legality checks on formal type declarations. --- gcc/ada/sem_prag.adb | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 17805c9..19e72ab 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14696,21 +14696,18 @@ package body Sem_Prag is D := Declaration_Node (E); - if (Nkind (D) = N_Full_Type_Declaration and then Is_Array_Type (E)) + if (Nkind (D) in N_Full_Type_Declaration + | N_Formal_Type_Declaration + and then Is_Array_Type (E)) or else (Nkind (D) = N_Object_Declaration and then Ekind (E) in E_Constant | E_Variable and then Nkind (Object_Definition (D)) = N_Constrained_Array_Definition) - or else - (Ada_Version >= Ada_2022 - and then Nkind (D) = N_Formal_Type_Declaration) then -- The flag is set on the base type, or on the object - if Nkind (D) in N_Full_Type_Declaration - | N_Formal_Type_Declaration - then + if Is_Array_Type (E) then E := Base_Type (E); end if; -- cgit v1.1 From d96603a48d338a92b78628016d00cbf11576621e Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Mon, 17 Mar 2025 18:30:00 +0000 Subject: ada: Support fixed-lower-bound array types as generic actual parameters Attempting to use a fixed-lower-bound array type (or subtype) as an actual parameter for a formal unconstrained array type was being rejected by the compiler (complaining about the index type of the actual not matching the index type of the formal type). The compiler was improperly testing the actual's FLB range and finding that it didn't statically match the index type of the formal array type; it should instead test the underlying index type of the FLB type or subtype. gcc/ada/ChangeLog: * sem_ch3.adb (Constrain_Index): In the case of a fixed-lower-bound index, set Etype of the newly created itype's Scalar_Range from the index's Etype. * sem_ch12.adb (Validate_Array_Type_Instance): If the actual subtype is a fixed-lower-bound type, then check again the Etype of its Scalar_Range. --- gcc/ada/sem_ch12.adb | 10 ++++++++++ gcc/ada/sem_ch3.adb | 4 +++- 2 files changed, 13 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 5768e28e..d93788b7 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -14132,6 +14132,16 @@ package body Sem_Ch12 is T2 := Etype (I2); end if; + -- In the case of a fixed-lower-bound subtype, we want to check + -- against the index type's range rather than the range of the + -- subtype (which will be seen as unconstrained, and whose bounds + -- won't generally match those of the formal unconstrained array + -- type's corresponding index type). + + if Is_Fixed_Lower_Bound_Index_Subtype (T2) then + T2 := Etype (Scalar_Range (T2)); + end if; + if not Subtypes_Match (Find_Actual_Type (Etype (I1), A_Gen_T), T2) then diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 4b5c5b1..9a25ff7 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -15092,7 +15092,8 @@ package body Sem_Ch3 is -- If this is a range for a fixed-lower-bound subtype, then set the -- index itype's low bound to the FLB and the index itype's upper bound -- to the high bound of the parent array type's index subtype. Also, - -- mark the itype as an FLB index subtype. + -- set the Etype of the new scalar range and mark the itype as an FLB + -- index subtype. if Nkind (S) = N_Range and then Is_FLB_Index then Set_Scalar_Range @@ -15100,6 +15101,7 @@ package body Sem_Ch3 is Make_Range (Sloc (S), Low_Bound => Low_Bound (S), High_Bound => Type_High_Bound (T))); + Set_Etype (Scalar_Range (Def_Id), Etype (Index)); Set_Is_Fixed_Lower_Bound_Index_Subtype (Def_Id); else -- cgit v1.1 From 4e4684ca6a79b22fe91acaa81af2d4a00d6e1345 Mon Sep 17 00:00:00 2001 From: Jason Merrill Date: Wed, 4 Jun 2025 13:31:02 -0400 Subject: c++: constexpr prvalues vs genericize [PR120502] Here constexpr evaluation was getting confused by the result of split_nonconstant_init, which leaves an INIT_EXPR from an empty CONSTRUCTOR to be followed by member initialization. As a result CONSTRUCTOR_NO_CLEARING was set for the time_zone, and cxx_eval_store_expression didn't set it again for the initial clobber in the basic_string constructor, so when cxx_fold_indirect_ref wants to check whether the anonymous union active member had type non_trivial_if, we see that we don't currently have a value for the anonymous union, try to add one, and fail. So let's do constexpr evaluation before split_nonconstant_init. PR c++/120502 gcc/cp/ChangeLog: * cp-gimplify.cc (cp_fold_r) [TARGET_EXPR]: Do constexpr evaluation before genericize. * constexpr.cc (cxx_eval_store_expression): Add comment. gcc/testsuite/ChangeLog: * g++.dg/cpp2a/constexpr-prvalue2.C: New test. --- gcc/cp/constexpr.cc | 3 ++- gcc/cp/cp-gimplify.cc | 21 ++++++++++++-------- gcc/testsuite/g++.dg/cpp2a/constexpr-prvalue2.C | 26 +++++++++++++++++++++++++ 3 files changed, 41 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/g++.dg/cpp2a/constexpr-prvalue2.C (limited to 'gcc') diff --git a/gcc/cp/constexpr.cc b/gcc/cp/constexpr.cc index d647a09..1ed3aba 100644 --- a/gcc/cp/constexpr.cc +++ b/gcc/cp/constexpr.cc @@ -6421,7 +6421,8 @@ cxx_eval_store_expression (const constexpr_ctx *ctx, tree t, if (TREE_CLOBBER_P (init) && CLOBBER_KIND (init) < CLOBBER_OBJECT_END) - /* Only handle clobbers ending the lifetime of objects. */ + /* Only handle clobbers ending the lifetime of objects. + ??? We should probably set CONSTRUCTOR_NO_CLEARING. */ return void_node; /* First we figure out where we're storing to. */ diff --git a/gcc/cp/cp-gimplify.cc b/gcc/cp/cp-gimplify.cc index d2423fd..5363ec8 100644 --- a/gcc/cp/cp-gimplify.cc +++ b/gcc/cp/cp-gimplify.cc @@ -1473,6 +1473,19 @@ cp_fold_r (tree *stmt_p, int *walk_subtrees, void *data_) break; case TARGET_EXPR: + if (!flag_no_inline) + if (tree &init = TARGET_EXPR_INITIAL (stmt)) + { + tree folded = maybe_constant_init (init, TARGET_EXPR_SLOT (stmt), + (data->flags & ff_mce_false + ? mce_false : mce_unknown)); + if (folded != init && TREE_CONSTANT (folded)) + init = folded; + } + + /* This needs to happen between the constexpr evaluation (which wants + pre-generic trees) and fold (which wants the cp_genericize_init + transformations). */ if (data->flags & ff_genericize) cp_genericize_target_expr (stmt_p); @@ -1481,14 +1494,6 @@ cp_fold_r (tree *stmt_p, int *walk_subtrees, void *data_) cp_walk_tree (&init, cp_fold_r, data, NULL); cp_walk_tree (&TARGET_EXPR_CLEANUP (stmt), cp_fold_r, data, NULL); *walk_subtrees = 0; - if (!flag_no_inline) - { - tree folded = maybe_constant_init (init, TARGET_EXPR_SLOT (stmt), - (data->flags & ff_mce_false - ? mce_false : mce_unknown)); - if (folded != init && TREE_CONSTANT (folded)) - init = folded; - } /* Folding might replace e.g. a COND_EXPR with a TARGET_EXPR; in that case, strip it in favor of this one. */ if (TREE_CODE (init) == TARGET_EXPR) diff --git a/gcc/testsuite/g++.dg/cpp2a/constexpr-prvalue2.C b/gcc/testsuite/g++.dg/cpp2a/constexpr-prvalue2.C new file mode 100644 index 0000000..c2dc7cd --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp2a/constexpr-prvalue2.C @@ -0,0 +1,26 @@ +// PR c++/120502 +// { dg-do compile { target c++20 } } +// { dg-additional-options -O } + +struct non_trivial_if { + constexpr non_trivial_if() {} +}; +struct allocator : non_trivial_if {}; +struct padding {}; +struct __short { + [[no_unique_address]] padding p; +}; +struct basic_string { + union { + __short s; + int l; + }; + [[no_unique_address]] allocator a; + constexpr basic_string() {} + ~basic_string() {} +}; +struct time_zone { + basic_string __abbrev; + long __offset; +}; +time_zone convert_to_time_zone() { return {}; } -- cgit v1.1 From e4940c042b753457748e2257a8b13ca3738b4fac Mon Sep 17 00:00:00 2001 From: Jason Merrill Date: Fri, 6 Jun 2025 10:26:28 -0400 Subject: c++: recursive template with deduced return [PR120555] Here since r15-4120 we were prematurely complaining about the use of func within its own definiton, which is fine at instantiation time. So don't require this for function templates that are currently being defined. But keep the error for instantiations of templates that are not currently being defined, which we similarly did not diagnose before r15-4120 but other implementations do. Both of these follow the general principle from [temp.res.general]/6 that we only error in a template body if no instatiation could be well-formed. Also remove a redundant call to require_deduced_type. PR c++/120555 gcc/cp/ChangeLog: * decl2.cc (fn_being_defined, fn_template_being_defined): New. (mark_used): Check fn_template_being_defined. gcc/testsuite/ChangeLog: * g++.dg/cpp1z/constexpr-if39.C: New test. (cherry picked from commit 8d204f2a536f7253e4251aca7bc12af524800b4c) --- gcc/cp/decl2.cc | 33 ++++++++++++++++++++++++++--- gcc/testsuite/g++.dg/cpp1z/constexpr-if39.C | 30 ++++++++++++++++++++++++++ 2 files changed, 60 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/g++.dg/cpp1z/constexpr-if39.C (limited to 'gcc') diff --git a/gcc/cp/decl2.cc b/gcc/cp/decl2.cc index bceaf78..63a5a21 100644 --- a/gcc/cp/decl2.cc +++ b/gcc/cp/decl2.cc @@ -6267,6 +6267,33 @@ mark_single_function (tree expr, tsubst_flags_t complain) return true; } +/* True iff we have started, but not finished, defining FUNCTION_DECL DECL. */ + +bool +fn_being_defined (tree decl) +{ + /* DECL_INITIAL is set to error_mark_node in grokfndecl for a definition, and + changed to BLOCK by poplevel at the end of the function. */ + return (TREE_CODE (decl) == FUNCTION_DECL + && DECL_INITIAL (decl) == error_mark_node); +} + +/* True if DECL is an instantiation of a function template currently being + defined. */ + +bool +fn_template_being_defined (tree decl) +{ + if (TREE_CODE (decl) != FUNCTION_DECL + || !DECL_LANG_SPECIFIC (decl) + || !DECL_TEMPLOID_INSTANTIATION (decl) + || DECL_TEMPLATE_INSTANTIATED (decl)) + return false; + tree tinfo = DECL_TEMPLATE_INFO (decl); + tree pattern = DECL_TEMPLATE_RESULT (TI_TEMPLATE (tinfo)); + return fn_being_defined (pattern); +} + /* Mark DECL (either a _DECL or a BASELINK) as "used" in the program. If DECL is a specialization or implicitly declared class member, generate the actual definition. Return false if something goes @@ -6415,6 +6442,9 @@ mark_used (tree decl, tsubst_flags_t complain /* = tf_warning_or_error */) maybe_instantiate_decl (decl); if (!decl_dependent_p (decl) + /* Don't require this yet for an instantiation of a function template + we're currently defining (c++/120555). */ + && !fn_template_being_defined (decl) && !require_deduced_type (decl, complain)) return false; @@ -6429,9 +6459,6 @@ mark_used (tree decl, tsubst_flags_t complain /* = tf_warning_or_error */) && uses_template_parms (DECL_TI_ARGS (decl))) return true; - if (!require_deduced_type (decl, complain)) - return false; - if (builtin_pack_fn_p (decl)) { error ("use of built-in parameter pack %qD outside of a template", diff --git a/gcc/testsuite/g++.dg/cpp1z/constexpr-if39.C b/gcc/testsuite/g++.dg/cpp1z/constexpr-if39.C new file mode 100644 index 0000000..38ae7a0 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1z/constexpr-if39.C @@ -0,0 +1,30 @@ +// PR c++/120555 +// { dg-do compile { target c++17 } } + +struct A { int m; }; + +template +constexpr auto f() { + if constexpr (sizeof(T) == sizeof(int)) + return 1; + else + return A{f()}; +} + +static_assert(f().m == 1); +static_assert(f() == 1); + +template constexpr auto g(); + +template +constexpr auto f2() { + if constexpr (sizeof(T) == sizeof(int)) + return 1; + else + return A{g()}; // { dg-error "auto" } +} + +template constexpr auto g() { return A{1}; } + +static_assert(f2().m == 1); +static_assert(f2() == 1); -- cgit v1.1 From 62724eaf59b9a888cc27a4b1f9364ee4c5c5dbff Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Tue, 10 Jun 2025 00:25:21 +0000 Subject: Daily bump. --- gcc/DATESTAMP | 2 +- gcc/ada/ChangeLog | 51 +++++++++++++++++++++++++++++++++++++++++++++++++ gcc/cp/ChangeLog | 16 ++++++++++++++++ gcc/testsuite/ChangeLog | 13 +++++++++++++ 4 files changed, 81 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index d0f154b..52988ae 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20250609 +20250610 diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1f32f1e..b275a5c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,54 @@ +2025-06-09 Gary Dismukes + + * sem_ch3.adb (Constrain_Index): In the case of a fixed-lower-bound index, + set Etype of the newly created itype's Scalar_Range from the index's Etype. + * sem_ch12.adb (Validate_Array_Type_Instance): If the actual subtype is + a fixed-lower-bound type, then check again the Etype of its Scalar_Range. + +2025-06-09 Piotr Trojanek + + * sem_prag.adb (Analyze_Pragma): Fix conditions for legality checks on + formal type declarations. + +2025-06-09 Piotr Trojanek + + * sem_prag.adb (Analyze_Pragma): If pragmas apply to a formal array + type, then set the flags on the base type. + +2025-06-09 Gary Dismukes + + * exp_aggr.adb (Expand_Container_Aggregate): Use the Base_Type of the + subtype provided by the context as the subtype of the temporary object + initialized by the aggregate. + +2025-06-09 Piotr Trojanek + + * exp_attr.adb (Expand_N_Attribute_Reference): When expanding attribute + Valid, use signedness from the validated view, not from its base type. + +2025-06-09 Gary Dismukes + + * contracts.adb (Inherit_Condition): Remove Assoc_List and its uses + along with function Check_Condition, since mapping of formals will + effectively be done in Build_Class_Wide_Expression (by Replace_Entity). + * exp_util.adb (Replace_Entity): Only rewrite entity references in + function calls that qualify according to the result of calling the + new function Call_To_Parent_Dispatching_Op_Must_Be_Mapped. + (Call_To_Parent_Dispatching_Op_Must_Be_Mapped): New function that + determines whether a function call to a primitive of Par_Subp + associated tagged type needs to be mapped (according to whether + it has any actuals that reference controlling formals of the + primitive). + +2025-06-09 Eric Botcazou + + * exp_ch4.adb (Insert_Conditional_Object_Declaration): Remove Decl + formal parameter, add Typ and Const formal parameters. + (Expand_N_Case_Expression): Fix pasto in comment. Adjust call to + Insert_Conditional_Object_Declaration and tidy up surrounding code. + (Expand_N_If_Expression): Adjust couple of calls to + Insert_Conditional_Object_Declaration. + 2025-06-06 Javier Miranda * sem_ch4.adb (Constant_Indexing_OK): Add missing support for diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 2534339..db696c1 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,19 @@ +2025-06-09 Jason Merrill + + Backported from master: + 2025-06-06 Jason Merrill + + PR c++/120555 + * decl2.cc (fn_being_defined, fn_template_being_defined): New. + (mark_used): Check fn_template_being_defined. + +2025-06-09 Jason Merrill + + PR c++/120502 + * cp-gimplify.cc (cp_fold_r) [TARGET_EXPR]: Do constexpr evaluation + before genericize. + * constexpr.cc (cxx_eval_store_expression): Add comment. + 2025-06-02 Jason Merrill PR c++/120123 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index dede789..4008287 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,16 @@ +2025-06-09 Jason Merrill + + Backported from master: + 2025-06-06 Jason Merrill + + PR c++/120555 + * g++.dg/cpp1z/constexpr-if39.C: New test. + +2025-06-09 Jason Merrill + + PR c++/120502 + * g++.dg/cpp2a/constexpr-prvalue2.C: New test. + 2025-06-06 Richard Biener Backported from master: -- cgit v1.1 From ba729e217add91ac919c06a51f00145249fbeb4b Mon Sep 17 00:00:00 2001 From: Xi Ruoyao Date: Sun, 11 May 2025 16:44:31 +0800 Subject: ext-dce: Don't refine live width with SUBREG mode if !TRULY_NOOP_TRUNCATION_MODES_P [PR 120050] If we see a promoted subreg and TRULY_NOOP_TRUNCATION says the truncation is not a noop, then all bits of the inner reg are live. We cannot reduce the live mask to that of the mode of the subreg. gcc/ChangeLog: PR rtl-optimization/120050 * ext-dce.cc (ext_dce_process_uses): Break early if a SUBREG in rhs is promoted and the truncation from the inner mode to the outer mode is not a noop when handling SETs. (cherry picked from commit 65f3a439c4f76fe780a30ac66969f51035c4bf98) --- gcc/ext-dce.cc | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) (limited to 'gcc') diff --git a/gcc/ext-dce.cc b/gcc/ext-dce.cc index a034395..aa80c04 100644 --- a/gcc/ext-dce.cc +++ b/gcc/ext-dce.cc @@ -35,6 +35,7 @@ along with GCC; see the file COPYING3. If not see #include "print-rtl.h" #include "dbgcnt.h" #include "diagnostic-core.h" +#include "target.h" /* These should probably move into a C++ class. */ static vec livein; @@ -764,13 +765,25 @@ ext_dce_process_uses (rtx_insn *insn, rtx obj, We don't want to mark those bits live unnecessarily as that inhibits extension elimination in important cases such as those in Coremark. So we need that - outer code. */ + outer code. + + But if !TRULY_NOOP_TRUNCATION_MODES_P, the mode + change performed by Y would normally need to be a + TRUNCATE rather than a SUBREG. It is probably the + guarantee provided by SUBREG_PROMOTED_VAR_P that + allows the SUBREG in Y as an exception. We must + therefore preserve that guarantee and treat the + upper bits of the inner register as live + regardless of the outer code. See PR 120050. */ if (!REG_P (SUBREG_REG (y)) || (SUBREG_PROMOTED_VAR_P (y) && ((GET_CODE (SET_SRC (x)) == SIGN_EXTEND && SUBREG_PROMOTED_SIGNED_P (y)) || (GET_CODE (SET_SRC (x)) == ZERO_EXTEND - && SUBREG_PROMOTED_UNSIGNED_P (y))))) + && SUBREG_PROMOTED_UNSIGNED_P (y)) + || !TRULY_NOOP_TRUNCATION_MODES_P ( + GET_MODE (y), + GET_MODE (SUBREG_REG (y)))))) break; bit = subreg_lsb (y).to_constant (); -- cgit v1.1 From 2859883e8901f5db7b26c07f823e2e8bc531a70d Mon Sep 17 00:00:00 2001 From: Ronan Desplanques Date: Tue, 18 Mar 2025 13:56:58 +0100 Subject: ada: Fix use-after-free in Compute_All_Tasks This patch fixes a bug in System.Stack_Usage.Tasking.Compute_All_Tasks where it would attempt to read the stack of threads that had already completed. gcc/ada/ChangeLog: * libgnarl/s-stusta.adb (Compute_All_Tasks): Skip terminated tasks. --- gcc/ada/libgnarl/s-stusta.adb | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ada/libgnarl/s-stusta.adb b/gcc/ada/libgnarl/s-stusta.adb index 5aca435..c9848a0 100644 --- a/gcc/ada/libgnarl/s-stusta.adb +++ b/gcc/ada/libgnarl/s-stusta.adb @@ -32,6 +32,7 @@ -- This is why this package is part of GNARL: with System.Tasking.Debug; +with System.Tasking.Stages; with System.Task_Primitives.Operations; with System.IO; @@ -103,7 +104,9 @@ package body System.Stack_Usage.Tasking is -- Calculate the task usage for a given task - Report_For_Task (Id); + if not System.Tasking.Stages.Terminated (Id) then + Report_For_Task (Id); + end if; end loop; end if; -- cgit v1.1 From 8a4b72a2d99918d6bc315f2664a22457b9848ce7 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 20 Mar 2025 23:29:33 +0100 Subject: ada: Fix infinite loop with aggregate in generic unit Root_Type does not return the same type for the private and the full view of a derived private tagged type when both derive from an interface type. gcc/ada/ChangeLog: * sem_ch12.adb (Copy_Generic_Node): Do not call Root_Type to find the root type of an aggregate of a derived tagged type. --- gcc/ada/sem_ch12.adb | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index d93788b7..02c7c36 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -9340,9 +9340,6 @@ package body Sem_Ch12 is and then Nkind (Ancestor_Type (N)) in N_Entity then declare - Root_Typ : constant Entity_Id := - Root_Type (Ancestor_Type (N)); - Typ : Entity_Id := Ancestor_Type (N); begin @@ -9351,7 +9348,7 @@ package body Sem_Ch12 is Switch_View (Typ); end if; - exit when Typ = Root_Typ; + exit when Etype (Typ) = Typ; Typ := Etype (Typ); end loop; -- cgit v1.1 From 4aca5bc773ced42d006e07197e24462d0fa38a8f Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Fri, 21 Mar 2025 22:03:46 +0000 Subject: ada: Storage_Error on Ordered_Maps container aggregate with enumeration Key_Type The compiler fails with a Storage_Error when compiling a container aggregate for a Map type coming from an instantiation of Ada.Containers.Ordered_Maps that specifies an enumeration type for the Key_Type formal. gcc/ada/ChangeLog: * exp_aggr.adb (Build_Container_Aggr_Code.To_Int): Apply Enumeration_Pos to Entity (Expr) rather than Expr. --- gcc/ada/exp_aggr.adb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index f4674f5..b6c1605 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -7010,7 +7010,7 @@ package body Exp_Aggr is begin return UI_To_Int ((if Nkind (Expr) = N_Integer_Literal then Intval (Expr) - else Enumeration_Pos (Expr))); + else Enumeration_Pos (Entity (Expr)))); end To_Int; -- Local variables -- cgit v1.1 From d02a2fe99f895f7c8cf969b618a51700e61c69ac Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 25 Mar 2025 18:23:50 +0100 Subject: ada: Fix wrong initialization of library-level object by conditional expression The previous fix was not robust enough in the presence of transient scopes. gcc/ada/ChangeLog: * exp_ch4.adb (Insert_Conditional_Object_Declaration): Deal with a transient scope being created around the declaration. * freeze.adb (Freeze_Entity): Do not call Freeze_Static_Object for a renaming declaration. --- gcc/ada/exp_ch4.adb | 16 +++++++++++++--- gcc/ada/freeze.adb | 3 ++- 2 files changed, 15 insertions(+), 4 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 161bcee..0cf605c 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -13312,9 +13312,19 @@ package body Exp_Ch4 is Insert_Action (Expr, Obj_Decl); -- The object can never be local to an elaboration routine at library - -- level since we will take 'Unrestricted_Access of it. - - Set_Is_Statically_Allocated (Obj_Id, Is_Library_Level_Entity (Obj_Id)); + -- level since we will take 'Unrestricted_Access of it. Beware that + -- Is_Library_Level_Entity always returns False when called from within + -- a transient scope, but the associated block will not be materialized + -- when the transient scope is finally closed in the case of an object + -- declaration (see Exp.Ch7.Wrap_Transient_Declaration). + + if Scope (Obj_Id) = Current_Scope and then Scope_Is_Transient then + Set_Is_Statically_Allocated + (Obj_Id, Is_Library_Level_Entity (Scope (Obj_Id))); + else + Set_Is_Statically_Allocated + (Obj_Id, Is_Library_Level_Entity (Obj_Id)); + end if; -- If the object needs finalization, we need to insert its Master_Node -- manually because 1) the machinery in Exp_Ch7 will not pick it since diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 54b6202..93ba3d0 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -6869,9 +6869,10 @@ package body Freeze is end if; end if; - -- Static objects require special handling + -- Statically allocated objects require special handling if (Ekind (E) = E_Constant or else Ekind (E) = E_Variable) + and then No (Renamed_Object (E)) and then Is_Statically_Allocated (E) then Freeze_Static_Object (E); -- cgit v1.1 From e249cec1ac9957a1e0d064104014f9c4c339d2d6 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 26 Mar 2025 00:37:22 +0100 Subject: ada: Fix fallout of latest change Freeze_Static_Object needs to deal with the objects that have been created by Insert_Conditional_Object_Declaration. gcc/ada/ChangeLog: * freeze.adb (Freeze_Static_Object): Do not issue any error message for compiler-generated entities. --- gcc/ada/freeze.adb | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 93ba3d0..eb751e1 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -10231,11 +10231,17 @@ package body Freeze is -- issue an error message saying that this object cannot be imported -- or exported. If it has an address clause it is an overlay in the -- current partition and the static requirement is not relevant. - -- Do not issue any error message when ignoring rep clauses. + -- Do not issue any error message when ignoring rep clauses or for + -- compiler-generated entities. if Ignore_Rep_Clauses then null; + elsif not Comes_From_Source (E) then + pragma + Assert (Nkind (Parent (Declaration_Node (E))) in N_Case_Statement + | N_If_Statement); + elsif Is_Imported (E) then if No (Address_Clause (E)) then Error_Msg_N -- cgit v1.1 From a35f642d231baa62d6b28e5e5aaf3cc30425552c Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Sat, 22 Mar 2025 00:01:52 +0000 Subject: ada: Error on subtype with static predicate used in case_expression The compiler improperly flags an error on the use of a subtype with a static predicate as a choice in a case expression alternative, complaining that the subtype has a nonstatic predicate. The fix for this is to add a test for the subtype not having a static predicate. gcc/ada/ChangeLog: * einfo.ads: Revise comment about Dynamic_Predicate flag to make it more accurate. * sem_case.adb (Check_Choices): Test "not Has_Static_Predicate_Aspect" as additional guard for error about use of subtype with nonstatic predicate as a case choice. Improve related error message. --- gcc/ada/einfo.ads | 2 +- gcc/ada/sem_case.adb | 8 +++++--- 2 files changed, 6 insertions(+), 4 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index f154e7f..7c05e53 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1623,7 +1623,7 @@ package Einfo is -- Has_Dynamic_Predicate_Aspect -- Defined in all types and subtypes. Set if a Dynamic_Predicate aspect --- was explicitly applied to the type. Generally we treat predicates as +-- was applied to the type or subtype. Generally we treat predicates as -- static if possible, regardless of whether they are specified using -- Predicate, Static_Predicate, or Dynamic_Predicate. And if a predicate -- can be treated as static (i.e. its expression is predicate-static), diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 3399a41..c81b563 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -3684,13 +3684,15 @@ package body Sem_Case is -- Use of nonstatic predicate is an error if not Is_Discrete_Type (E) - or else not Has_Static_Predicate (E) + or else (not Has_Static_Predicate (E) + and then + not Has_Static_Predicate_Aspect (E)) or else Has_Dynamic_Predicate_Aspect (E) or else Has_Ghost_Predicate_Aspect (E) then Bad_Predicated_Subtype_Use - ("cannot use subtype& with non-static " - & "predicate as case alternative", + ("cannot use subtype& with nonstatic " + & "predicate as choice in case alternative", Choice, E, Suggest_Static => True); -- Static predicate case. The bounds are those of -- cgit v1.1 From 615a92a1e6a90bcb012deb216cd141266b0954a0 Mon Sep 17 00:00:00 2001 From: Andrew Pinski Date: Wed, 30 Apr 2025 15:10:29 -0700 Subject: vectorizer: Fix riscv build [PR120042] r15-9859-ga6cfde60d8c added a call to dominated_by_p to tree-vectorizer.h but dominance.h is not always included; and you get a build failure on riscv building riscv-vector-costs.cc. Let's add the include of dominance.h to tree-vectorizer.h Pushed as obvious after builds for riscv and x86_64. gcc/ChangeLog: PR target/120042 * tree-vectorizer.h: Include dominance.h. Signed-off-by: Andrew Pinski (cherry picked from commit 299d48ff4a34c00a6ef964b694fb9b1312683049) --- gcc/tree-vectorizer.h | 1 + 1 file changed, 1 insertion(+) (limited to 'gcc') diff --git a/gcc/tree-vectorizer.h b/gcc/tree-vectorizer.h index 94cbfde6..63991c3 100644 --- a/gcc/tree-vectorizer.h +++ b/gcc/tree-vectorizer.h @@ -30,6 +30,7 @@ typedef struct _slp_tree *slp_tree; #include "internal-fn.h" #include "tree-ssa-operands.h" #include "gimple-match.h" +#include "dominance.h" /* Used for naming of new temporaries. */ enum vect_var_kind { -- cgit v1.1