diff options
Diffstat (limited to 'gcc')
71 files changed, 1886 insertions, 444 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 59f447c..d11e9f1 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,8 @@ +2025-06-05 Eric Botcazou <ebotcazou@adacore.com> + + * tree-vect-data-refs.cc (vect_can_force_dr_alignment_p): Return + false if the variable has no symtab node. + 2025-05-29 Yuta Mukai <mukai.yuta@fujitsu.com> Backported from master: diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp index 34e6157..6ac795b 100644 --- a/gcc/ChangeLog.omp +++ b/gcc/ChangeLog.omp @@ -1,3 +1,32 @@ +2025-06-06 Tobias Burnus <tburnus@baylibre.com> + + Backported from master: + 2025-06-06 Tobias Burnus <tburnus@baylibre.com> + Sandra Loosemore <sloosemore@baylibre.com> + + * gimple-fold.cc (gimple_fold_builtin_omp_get_initial_device, + gimple_fold_builtin_omp_get_num_devices): New. + (gimple_fold_builtin): Call them. + * omp-builtins.def (BUILT_IN_OMP_GET_INITIAL_DEVICE): Add + (BUILT_IN_OMP_GET_NUM_DEVICES): Make uservisible + pure. + +2025-06-06 Tobias Burnus <tburnus@baylibre.com> + + Backported from master: + 2025-06-06 Tobias Burnus <tburnus@baylibre.com> + + * builtins.def (DEF_GOACC_BUILTIN_COMPILER, DEF_GOMP_BUILTIN_COMPILER): + Set NONANSI_P = false to enable those also with -fno-nonansi-builtins. + +2025-06-05 Sandra Loosemore <sloosemore@baylibre.com> + + Backported from master: + 2025-06-04 Sandra Loosemore <sloosemore@baylibre.com> + + PR c++/120518 + * omp-general.cc (omp_device_num_check): Look inside a + CLEANUP_POINT_EXPR when trying to optimize special cases. + 2025-06-04 Thomas Schwinge <tschwinge@baylibre.com> Backported from master: diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 5646e6e..c6de4e3 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20250602 +20250606 diff --git a/gcc/DATESTAMP.omp b/gcc/DATESTAMP.omp index 932c2dd..c6de4e3 100644 --- a/gcc/DATESTAMP.omp +++ b/gcc/DATESTAMP.omp @@ -1 +1 @@ -20250604 +20250606 diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 89cb7d4..331a8ab 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,91 @@ +2025-06-05 Javier Miranda <miranda@adacore.com> + + * exp_ch7.adb (Process_Object_Declaration): Avoid generating + duplicate names for master nodes. + +2025-06-05 Steve Baird <baird@adacore.com> + + * sem_util.adb + (Side_Effect_Free_Statements): Return False if the statement list + includes an explicit (i.e. Comes_From_Source) raise statement. + +2025-06-05 Ronan Desplanques <desplanques@adacore.com> + + * exp_ch4.adb (Tagged_Membership): Fix for protected types. + +2025-06-05 Ronan Desplanques <desplanques@adacore.com> + + * exp_attr.adb (Interunit_Ref_OK): Tweak categorization of compilation + units. + +2025-06-05 Eric Botcazou <ebotcazou@adacore.com> + + * exp_aggr.adb (Build_Two_Pass_Aggr_Code): New function containing + most of the code initially present in Two_Pass_Aggregate_Expansion. + (Two_Pass_Aggregate_Expansion): Remove redundant N parameter. + Implement built-in-place expansion for (static) object declarations + and allocators, using Build_Two_Pass_Aggr_Code for the main work. + (Expand_Array_Aggregate): Adjust Two_Pass_Aggregate_Expansion call. + Replace Etype (N) by Typ in a couple of places. + * exp_ch3.adb (Expand_Freeze_Array_Type): Remove special case for + two-pass array aggregates. + (Expand_N_Object_Declaration): Do not adjust the object when it is + initialized by a two-pass array aggregate. + * exp_ch4.adb (Expand_Allocator_Expression): Apply the processing + used for container aggregates to two-pass array aggregates. + * exp_ch6.adb (Validate_Subprogram_Calls): Skip calls present in + initialization expressions of N_Object_Declaration nodes that have + No_Initialization set. + * sem_ch3.adb (Analyze_Object_Declaration): Detect the cases of an + array originally initialized by an aggregate consistently. + +2025-06-05 Viljar Indus <indus@adacore.com> + + * doc/gnat_rm/implementation_defined_attributes.rst: Update the + documentation for Valid_Value. + * sem_attr.adb (Analyze_Attribute): Reject types where + the root type originates from Standard. + * gnat_rm.texi: Regenerate. + +2025-06-05 Gary Dismukes <dismukes@adacore.com> + + * exp_aggr.adb (Two_Pass_Aggregate_Expansion): Change call to Make_Assignment + for the indexed aggregate object to call Change_Make_OK_Assignment instead. + +2025-06-05 Eric Botcazou <ebotcazou@adacore.com> + + * exp_ch6.adb (Expand_Actuals): Remove obsolete comment. + (Make_Build_In_Place_Call_In_Anonymous_Context): Always use a proper + object declaration initialized with the function call in the cases + where a temporary is needed, with Assignment_OK set on it. + * sem_util.adb (Entity_Of): Deal with rewritten function call first. + +2025-06-05 Steve Baird <baird@adacore.com> + + * exp_attr.adb (Expand_N_Attribute_Reference): When accessing the + maps declared in package Cached_Attribute_Ops, the key value + passed to Get or to Set should never be the entity node for a + subtype. Use the entity of the corresponding type declaration + instead. + +2025-06-05 Steve Baird <baird@adacore.com> + + * sem_res.adb + (Set_Mixed_Mode_Operand): If we are about to call Resolve + passing in Any_Fixed as the expected type, then instead pass in + the fixed point type of the other operand (i.e., B_Typ). + +2025-06-05 Gary Dismukes <dismukes@adacore.com> + + * sem_util.adb (Check_Function_Writable_Actuals): Add handling for + N_Iterated_Component_Association and N_Iterated_Element_Association. + Fix a typo in an RM reference (6.4.1(20/3) => 6.4.1(6.20/3)). + (Collect_Expression_Ids): New procedure factoring code for collecting + identifiers from expressions of aggregate associations. + (Handle_Association_Choices): New procedure factoring code for handling + id collection for expressions of aggregate associations with multiple + choices. Removed redundant test of Box_Present from original code. + 2025-05-05 Eric Botcazou <ebotcazou@adacore.com> PR ada/120104 diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst b/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst index f051810..86d2a81 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst @@ -1629,9 +1629,9 @@ Attribute Valid_Value .. index:: Valid_Value The ``'Valid_Value`` attribute is defined for enumeration types other than -those in package Standard. This attribute is a function that takes -a String, and returns Boolean. ``T'Valid_Value (S)`` returns True -if and only if ``T'Value (S)`` would not raise Constraint_Error. +those in package Standard or types derived from those types. This attribute is +a function that takes a String, and returns Boolean. ``T'Valid_Value (S)`` +returns True if and only if ``T'Value (S)`` would not raise Constraint_Error. Attribute Valid_Scalars ======================= diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 7cb26ce..f2e7ad7 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4956,6 +4956,14 @@ package body Exp_Aggr is -- type using the computable sizes of the aggregate and its sub- -- aggregates. + function Build_Two_Pass_Aggr_Code + (Lhs : Node_Id; + Aggr_Typ : out Entity_Id) return List_Id; + -- The aggregate consists only of iterated associations and Lhs is an + -- expression containing the location of the anonymous object, which + -- may be built in place. Returns the dynamic subtype of the aggregate + -- in Aggr_Typ and the list of statements needed to build it. + procedure Check_Bounds (Aggr_Bounds_Node, Index_Bounds_Node : Node_Id); -- Checks that the bounds of Aggr_Bounds are within the bounds defined -- by Index_Bounds. For null array aggregate (Ada 2022) check that the @@ -4983,7 +4991,7 @@ package body Exp_Aggr is -- built directly into the target of an assignment, the target must -- be free of side effects. N is the target of the assignment. - procedure Two_Pass_Aggregate_Expansion (N : Node_Id); + procedure Two_Pass_Aggregate_Expansion; -- If the aggregate consists only of iterated associations then the -- aggregate is constructed in two steps: -- a) Build an expression to compute the number of elements @@ -5053,6 +5061,221 @@ package body Exp_Aggr is Freeze_Itype (Agg_Type, N); end Build_Constrained_Type; + ------------------------------ + -- Build_Two_Pass_Aggr_Code -- + ------------------------------ + + function Build_Two_Pass_Aggr_Code + (Lhs : Node_Id; + Aggr_Typ : out Entity_Id) return List_Id + is + Index_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N); + Index_Type : constant Entity_Id := Etype (First_Index (Typ)); + Index_Base : constant Entity_Id := Base_Type (Index_Type); + Size_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N); + Size_Type : constant Entity_Id := + Integer_Type_For + (Esize (Index_Base), Is_Unsigned_Type (Index_Base)); + + Assoc : Node_Id; + Incr : Node_Id; + Iter : Node_Id; + New_Comp : Node_Id; + One_Loop : Node_Id; + Iter_Id : Entity_Id; + + Aggr_Code : List_Id; + Size_Expr_Code : List_Id; + + begin + Size_Expr_Code := New_List ( + Make_Object_Declaration (Loc, + Defining_Identifier => Size_Id, + Object_Definition => New_Occurrence_Of (Size_Type, Loc), + Expression => Make_Integer_Literal (Loc, 0))); + + -- First pass: execute the iterators to count the number of elements + -- that will be generated. + + Assoc := First (Component_Associations (N)); + while Present (Assoc) loop + Iter := Iterator_Specification (Assoc); + Iter_Id := Defining_Identifier (Iter); + Incr := + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Size_Id, Loc), + Expression => + Make_Op_Add (Loc, + Left_Opnd => New_Occurrence_Of (Size_Id, Loc), + Right_Opnd => Make_Integer_Literal (Loc, 1))); + + -- Avoid using the same iterator definition in both loops by + -- creating a new iterator for each loop and mapping it over the + -- original iterator references. + + One_Loop := + Make_Implicit_Loop_Statement (N, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Iterator_Specification => + New_Copy_Tree (Iter, + Map => New_Elmt_List (Iter_Id, New_Copy (Iter_Id)))), + Statements => New_List (Incr)); + + Append (One_Loop, Size_Expr_Code); + Next (Assoc); + end loop; + + Insert_Actions (N, Size_Expr_Code); + + -- Build a constrained subtype with the bounds deduced from + -- the size computed above and declare the aggregate object. + -- The index type is some discrete type, so the bounds of the + -- constrained subtype are computed as T'Val (integer bounds). + + declare + -- Pos_Lo := Index_Type'Pos (Index_Type'First) + + Pos_Lo : constant Node_Id := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Index_Type, Loc), + Attribute_Name => Name_Pos, + Expressions => New_List ( + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Index_Type, Loc), + Attribute_Name => Name_First))); + + -- Corresponding index value, i.e. Index_Type'First + + Aggr_Lo : constant Node_Id := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Index_Type, Loc), + Attribute_Name => Name_First); + + -- Pos_Hi := Pos_Lo + Size - 1 + + Pos_Hi : constant Node_Id := + Make_Op_Add (Loc, + Left_Opnd => Pos_Lo, + Right_Opnd => + Make_Op_Subtract (Loc, + Left_Opnd => New_Occurrence_Of (Size_Id, Loc), + Right_Opnd => Make_Integer_Literal (Loc, 1))); + + -- Corresponding index value + + Aggr_Hi : constant Node_Id := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Index_Type, Loc), + Attribute_Name => Name_Val, + Expressions => New_List (Pos_Hi)); + + begin + Aggr_Typ := Make_Temporary (Loc, 'T'); + + Insert_Action (N, + Make_Subtype_Declaration (Loc, + Defining_Identifier => Aggr_Typ, + Subtype_Indication => + Make_Subtype_Indication (Loc, + Subtype_Mark => + New_Occurrence_Of (Base_Type (Typ), Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint + (Loc, + Constraints => + New_List (Make_Range (Loc, Aggr_Lo, Aggr_Hi)))))); + end; + + -- Second pass: use the iterators to generate the elements of the + -- aggregate. We assume that the second evaluation of each iterator + -- generates the same number of elements as the first pass, and thus + -- consider that the execution is erroneous (even if the RM does not + -- state this explicitly) if the number of elements generated differs + -- between first and second pass. + + Assoc := First (Component_Associations (N)); + + -- Initialize insertion position to first array component + + Aggr_Code := New_List ( + Make_Object_Declaration (Loc, + Defining_Identifier => Index_Id, + Object_Definition => + New_Occurrence_Of (Index_Type, Loc), + Expression => + Make_Attribute_Reference (Loc, + Prefix => New_Copy_Tree (Lhs), + Attribute_Name => Name_First))); + + while Present (Assoc) loop + Iter := Iterator_Specification (Assoc); + Iter_Id := Defining_Identifier (Iter); + New_Comp := + Make_OK_Assignment_Statement (Loc, + Name => + Make_Indexed_Component (Loc, + Prefix => New_Copy_Tree (Lhs), + Expressions => + New_List (New_Occurrence_Of (Index_Id, Loc))), + Expression => Copy_Separate_Tree (Expression (Assoc))); + + -- Arrange for the component to be adjusted if need be (the call + -- will be generated by Make_Tag_Ctrl_Assignment). + + if Needs_Finalization (Ctyp) + and then not Is_Inherently_Limited_Type (Ctyp) + then + Set_No_Finalize_Actions (New_Comp); + else + Set_No_Ctrl_Actions (New_Comp); + end if; + + -- Advance index position for insertion + + Incr := + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Index_Id, Loc), + Expression => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Index_Type, Loc), + Attribute_Name => Name_Succ, + Expressions => + New_List (New_Occurrence_Of (Index_Id, Loc)))); + + -- Add guard to skip last increment when upper bound is reached + + Incr := + Make_If_Statement (Loc, + Condition => + Make_Op_Ne (Loc, + Left_Opnd => New_Occurrence_Of (Index_Id, Loc), + Right_Opnd => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Index_Type, Loc), + Attribute_Name => Name_Last)), + Then_Statements => New_List (Incr)); + + -- Avoid using the same iterator definition in both loops by + -- creating a new iterator for each loop and mapping it over + -- the original iterator references. + + One_Loop := + Make_Implicit_Loop_Statement (N, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Iterator_Specification => + New_Copy_Tree (Iter, + Map => New_Elmt_List (Iter_Id, New_Copy (Iter_Id)))), + Statements => New_List (New_Comp, Incr)); + + Append (One_Loop, Aggr_Code); + Next (Assoc); + end loop; + + return Aggr_Code; + end Build_Two_Pass_Aggr_Code; + ------------------ -- Check_Bounds -- ------------------ @@ -5596,214 +5819,98 @@ package body Exp_Aggr is -- Two_Pass_Aggregate_Expansion -- ---------------------------------- - procedure Two_Pass_Aggregate_Expansion (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Comp_Type : constant Entity_Id := Etype (N); - Index_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N); - Index_Type : constant Entity_Id := Etype (First_Index (Etype (N))); - Index_Base : constant Entity_Id := Base_Type (Index_Type); - Size_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N); - Size_Type : constant Entity_Id := - Integer_Type_For - (Esize (Index_Base), Is_Unsigned_Type (Index_Base)); - TmpE : constant Entity_Id := Make_Temporary (Loc, 'A', N); - - Assoc : Node_Id := First (Component_Associations (N)); - Incr : Node_Id; - Iter : Node_Id; - New_Comp : Node_Id; - One_Loop : Node_Id; - Iter_Id : Entity_Id; - - Size_Expr_Code : List_Id; - Insertion_Code : List_Id := New_List; + procedure Two_Pass_Aggregate_Expansion is + Aggr_Code : List_Id; + Aggr_Typ : Entity_Id; + Lhs : Node_Id; + Obj_Id : Entity_Id; + Par : Node_Id; begin - Size_Expr_Code := New_List ( - Make_Object_Declaration (Loc, - Defining_Identifier => Size_Id, - Object_Definition => New_Occurrence_Of (Size_Type, Loc), - Expression => Make_Integer_Literal (Loc, 0))); - - -- First pass: execute the iterators to count the number of elements - -- that will be generated. - - while Present (Assoc) loop - Iter := Iterator_Specification (Assoc); - Iter_Id := Defining_Identifier (Iter); - Incr := Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Size_Id, Loc), - Expression => - Make_Op_Add (Loc, - Left_Opnd => New_Occurrence_Of (Size_Id, Loc), - Right_Opnd => Make_Integer_Literal (Loc, 1))); - - -- Avoid using the same iterator definition in both loops by - -- creating a new iterator for each loop and mapping it over the - -- original iterator references. - - One_Loop := Make_Implicit_Loop_Statement (N, - Iteration_Scheme => - Make_Iteration_Scheme (Loc, - Iterator_Specification => - New_Copy_Tree (Iter, - Map => New_Elmt_List (Iter_Id, New_Copy (Iter_Id)))), - Statements => New_List (Incr)); - - Append (One_Loop, Size_Expr_Code); - Next (Assoc); + Par := Parent (N); + while Nkind (Par) = N_Qualified_Expression loop + Par := Parent (Par); end loop; - Insert_Actions (N, Size_Expr_Code); - - -- Build a constrained subtype with the bounds deduced from - -- the size computed above and declare the aggregate object. - -- The index type is some discrete type, so the bounds of the - -- constrained subtype are computed as T'Val (integer bounds). - - declare - -- Pos_Lo := Index_Type'Pos (Index_Type'First) - - Pos_Lo : constant Node_Id := - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Index_Type, Loc), - Attribute_Name => Name_Pos, - Expressions => New_List ( - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Index_Type, Loc), - Attribute_Name => Name_First))); - - -- Corresponding index value, i.e. Index_Type'First + -- If the aggregate is the initialization expression of an object + -- declaration, we always build the aggregate in place, although + -- this is required only for immutably limited types and types + -- that need finalization, see RM 7.6(17.2/3-17.3/3). - Aggr_Lo : constant Node_Id := - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Index_Type, Loc), - Attribute_Name => Name_First); - - -- Pos_Hi := Pos_Lo + Size - 1 - - Pos_Hi : constant Node_Id := - Make_Op_Add (Loc, - Left_Opnd => Pos_Lo, - Right_Opnd => - Make_Op_Subtract (Loc, - Left_Opnd => New_Occurrence_Of (Size_Id, Loc), - Right_Opnd => Make_Integer_Literal (Loc, 1))); - - -- Corresponding index value - - Aggr_Hi : constant Node_Id := - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Index_Type, Loc), - Attribute_Name => Name_Val, - Expressions => New_List (Pos_Hi)); - - SubE : constant Entity_Id := Make_Temporary (Loc, 'T'); - SubD : constant Node_Id := - Make_Subtype_Declaration (Loc, - Defining_Identifier => SubE, - Subtype_Indication => - Make_Subtype_Indication (Loc, - Subtype_Mark => - New_Occurrence_Of (Etype (Comp_Type), Loc), - Constraint => - Make_Index_Or_Discriminant_Constraint - (Loc, - Constraints => - New_List (Make_Range (Loc, Aggr_Lo, Aggr_Hi))))); - - -- Create a temporary array of the above subtype which - -- will be used to capture the aggregate assignments. - - TmpD : constant Node_Id := - Make_Object_Declaration (Loc, - Defining_Identifier => TmpE, - Object_Definition => New_Occurrence_Of (SubE, Loc)); - - begin - Insert_Actions (N, New_List (SubD, TmpD)); - end; - - -- Second pass: use the iterators to generate the elements of the - -- aggregate. Insertion index starts at Index_Type'First. We - -- assume that the second evaluation of each iterator generates - -- the same number of elements as the first pass, and consider - -- that the execution is erroneous (even if the RM does not state - -- this explicitly) if the number of elements generated differs - -- between first and second pass. - - Assoc := First (Component_Associations (N)); + if Nkind (Par) = N_Object_Declaration then + Obj_Id := Defining_Identifier (Par); + Lhs := New_Occurrence_Of (Obj_Id, Loc); + Set_Assignment_OK (Lhs); + Aggr_Code := Build_Two_Pass_Aggr_Code (Lhs, Aggr_Typ); - -- Initialize insertion position to first array component. + -- Save the last assignment statement associated with the + -- aggregate when building a controlled object. This last + -- assignment is used by the finalization machinery when + -- marking an object as successfully initialized. - Insertion_Code := New_List ( - Make_Object_Declaration (Loc, - Defining_Identifier => Index_Id, - Object_Definition => - New_Occurrence_Of (Index_Type, Loc), - Expression => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Index_Type, Loc), - Attribute_Name => Name_First))); + if Needs_Finalization (Typ) then + Mutate_Ekind (Obj_Id, E_Variable); + Set_Last_Aggregate_Assignment (Obj_Id, Last (Aggr_Code)); + end if; - while Present (Assoc) loop - Iter := Iterator_Specification (Assoc); - Iter_Id := Defining_Identifier (Iter); - New_Comp := Make_Assignment_Statement (Loc, - Name => - Make_Indexed_Component (Loc, - Prefix => New_Occurrence_Of (TmpE, Loc), - Expressions => - New_List (New_Occurrence_Of (Index_Id, Loc))), - Expression => Copy_Separate_Tree (Expression (Assoc))); + -- If a transient scope has been created around the declaration, + -- we need to attach the code to it so that finalization actions + -- of the declaration will be inserted after it; otherwise, we + -- directly insert it after the declaration. In both cases, the + -- code will be analyzed after the declaration is processed, i.e. + -- once the actual subtype of the object is established. - -- Advance index position for insertion. + if Scope_Is_Transient and then Par = Node_To_Be_Wrapped then + Store_After_Actions_In_Scope_Without_Analysis (Aggr_Code); + else + Insert_List_After (Par, Aggr_Code); + end if; - Incr := Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Index_Id, Loc), - Expression => - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Index_Type, Loc), - Attribute_Name => Name_Succ, - Expressions => - New_List (New_Occurrence_Of (Index_Id, Loc)))); + Set_Etype (N, Aggr_Typ); + Set_No_Initialization (Par); - -- Add guard to skip last increment when upper bound is reached. + -- Likewise if it is the qualified expression of an allocator but, + -- in this case, we wait until after Expand_Allocator_Expression + -- rewrites the allocator as the initialization expression of an + -- object declaration, so that we have the left-hand side. - Incr := Make_If_Statement (Loc, - Condition => - Make_Op_Ne (Loc, - Left_Opnd => New_Occurrence_Of (Index_Id, Loc), - Right_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Index_Type, Loc), - Attribute_Name => Name_Last)), - Then_Statements => New_List (Incr)); + elsif Nkind (Par) = N_Allocator then + if Nkind (Parent (Par)) = N_Object_Declaration + and then + not Comes_From_Source (Defining_Identifier (Parent (Par))) + then + Obj_Id := Defining_Identifier (Parent (Par)); + Lhs := + Make_Explicit_Dereference (Loc, + Prefix => New_Occurrence_Of (Obj_Id, Loc)); + Set_Assignment_OK (Lhs); + Aggr_Code := Build_Two_Pass_Aggr_Code (Lhs, Aggr_Typ); - -- Avoid using the same iterator definition in both loops by - -- creating a new iterator for each loop and mapping it over the - -- original iterator references. + Insert_Actions_After (Parent (Par), Aggr_Code); - One_Loop := Make_Implicit_Loop_Statement (N, - Iteration_Scheme => - Make_Iteration_Scheme (Loc, - Iterator_Specification => - New_Copy_Tree (Iter, - Map => New_Elmt_List (Iter_Id, New_Copy (Iter_Id)))), - Statements => New_List (New_Comp, Incr)); + Set_Expression (Par, New_Occurrence_Of (Aggr_Typ, Loc)); + Set_No_Initialization (Par); + end if; - Append (One_Loop, Insertion_Code); - Next (Assoc); - end loop; + -- Otherwise we create a temporary for the anonymous object and + -- replace the aggregate with the temporary. - Insert_Actions (N, Insertion_Code); + else + Obj_Id := Make_Temporary (Loc, 'A', N); + Lhs := New_Occurrence_Of (Obj_Id, Loc); + Set_Assignment_OK (Lhs); - -- Depending on context this may not work for build-in-place - -- arrays ??? + Aggr_Code := Build_Two_Pass_Aggr_Code (Lhs, Aggr_Typ); + Prepend_To (Aggr_Code, + Make_Object_Declaration (Loc, + Defining_Identifier => Obj_Id, + Object_Definition => New_Occurrence_Of (Aggr_Typ, Loc))); - Rewrite (N, New_Occurrence_Of (TmpE, Loc)); + Insert_Actions (N, Aggr_Code); + Rewrite (N, Lhs); + Analyze_And_Resolve (N, Aggr_Typ); + end if; end Two_Pass_Aggregate_Expansion; -- Local variables @@ -5829,7 +5936,7 @@ package body Exp_Aggr is -- Aggregates that require a two-pass expansion are handled separately elsif Is_Two_Pass_Aggregate (N) then - Two_Pass_Aggregate_Expansion (N); + Two_Pass_Aggregate_Expansion; return; -- Do not attempt expansion if error already detected. We may reach this @@ -6002,12 +6109,11 @@ package body Exp_Aggr is -- static type imposed by the context. declare - Itype : constant Entity_Id := Etype (N); Index : Node_Id; Needs_Type : Boolean := False; begin - Index := First_Index (Itype); + Index := First_Index (Typ); while Present (Index) loop if not Is_OK_Static_Subtype (Etype (Index)) then Needs_Type := True; @@ -6019,7 +6125,7 @@ package body Exp_Aggr is if Needs_Type then Build_Constrained_Type (Positional => True); - Rewrite (N, Unchecked_Convert_To (Itype, N)); + Rewrite (N, Unchecked_Convert_To (Typ, N)); Analyze (N); end if; end; @@ -6147,7 +6253,7 @@ package body Exp_Aggr is then Tmp := Name (Parent_Node); - if Etype (Tmp) /= Etype (N) then + if Etype (Tmp) /= Typ then Apply_Length_Check (N, Etype (Tmp)); if Nkind (N) = N_Raise_Constraint_Error then @@ -7362,7 +7468,7 @@ package body Exp_Aggr is -- Likewise if the aggregate is the qualified expression of an allocator -- but, in this case, we wait until after Expand_Allocator_Expression -- rewrites the allocator as the initialization expression of an object - -- declaration to have the left hand side. + -- declaration, so that we have the left-hand side. elsif Nkind (Par) = N_Allocator then if Nkind (Parent (Par)) = N_Object_Declaration diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index b896228..4e0052e 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -88,8 +88,10 @@ package body Exp_Attr is function Attribute_Op_Hash (Id : Entity_Id) return Header_Num is (Header_Num (Id mod Map_Size)); - -- Cache used to avoid building duplicate subprograms for a single - -- type/streaming-attribute pair. + -- Caches used to avoid building duplicate subprograms for a single + -- type/attribute pair (where the attribute is either Put_Image or + -- one of the four streaming attributes). The type used as a key in + -- in accessing these maps should not be the entity of a subtype. package Read_Map is new GNAT.HTable.Simple_HTable (Header_Num => Header_Num, @@ -282,8 +284,8 @@ package body Exp_Attr is (In_Same_Extended_Unit (Subp_Unit, Attr_Ref_Unit) -- If subp declared in unit body, then we don't want to refer -- to it from within unit spec so return False in that case. - and then not (Body_Required (Attr_Ref_Unit) - and not Body_Required (Subp_Unit))); + and then not (not Is_Body (Unit (Attr_Ref_Unit)) + and Is_Body (Unit (Subp_Unit)))); -- Returns True if it is ok to refer to a cached subprogram declared in -- Subp_Unit from the point of an attribute reference occurring in -- Attr_Ref_Unit. Both arguments are usually N_Compilation_Nodes, @@ -4669,7 +4671,7 @@ package body Exp_Attr is end if; if not Is_Tagged_Type (P_Type) then - Cached_Attribute_Ops.Input_Map.Set (P_Type, Fname); + Cached_Attribute_Ops.Input_Map.Set (U_Type, Fname); end if; end Input; @@ -5750,7 +5752,7 @@ package body Exp_Attr is Rewrite_Attribute_Proc_Call (Pname); if not Is_Tagged_Type (P_Type) then - Cached_Attribute_Ops.Output_Map.Set (P_Type, Pname); + Cached_Attribute_Ops.Output_Map.Set (U_Type, Pname); end if; end Output; @@ -6669,7 +6671,7 @@ package body Exp_Attr is Rewrite_Attribute_Proc_Call (Pname); if not Is_Tagged_Type (P_Type) then - Cached_Attribute_Ops.Read_Map.Set (P_Type, Pname); + Cached_Attribute_Ops.Read_Map.Set (U_Type, Pname); end if; end Read; @@ -8349,7 +8351,7 @@ package body Exp_Attr is Rewrite_Attribute_Proc_Call (Pname); if not Is_Tagged_Type (P_Type) then - Cached_Attribute_Ops.Write_Map.Set (P_Type, Pname); + Cached_Attribute_Ops.Write_Map.Set (U_Type, Pname); end if; end Write; @@ -8951,15 +8953,22 @@ package body Exp_Attr is return Empty; end if; - if Nam = TSS_Stream_Read then - Ent := Cached_Attribute_Ops.Read_Map.Get (Typ); - elsif Nam = TSS_Stream_Write then - Ent := Cached_Attribute_Ops.Write_Map.Get (Typ); - elsif Nam = TSS_Stream_Input then - Ent := Cached_Attribute_Ops.Input_Map.Get (Typ); - elsif Nam = TSS_Stream_Output then - Ent := Cached_Attribute_Ops.Output_Map.Get (Typ); - end if; + declare + function U_Base return Entity_Id is + (Underlying_Type (Base_Type (Typ))); + -- Return the right type node for use in a C_A_O map lookup. + -- In particular, we do not want the entity for a subtype. + begin + if Nam = TSS_Stream_Read then + Ent := Cached_Attribute_Ops.Read_Map.Get (U_Base); + elsif Nam = TSS_Stream_Write then + Ent := Cached_Attribute_Ops.Write_Map.Get (U_Base); + elsif Nam = TSS_Stream_Input then + Ent := Cached_Attribute_Ops.Input_Map.Get (U_Base); + elsif Nam = TSS_Stream_Output then + Ent := Cached_Attribute_Ops.Output_Map.Get (U_Base); + end if; + end; Cached_Attribute_Ops.Validate_Cached_Candidate (Subp => Ent, Attr_Ref => Attr_Ref); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index bc46fd3..fa87149 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5423,18 +5423,12 @@ package body Exp_Ch3 is -- with an initial value, its Init_Proc will never be called. The -- initial value itself may have been expanded into assignments, -- in which case the declaration has the No_Initialization flag. - -- The exception is when the initial value is a 2-pass aggregate, - -- because the special expansion used for it creates a temporary - -- that needs a fully-fledged initialization. if Is_Itype (Base) and then Nkind (Associated_Node_For_Itype (Base)) = N_Object_Declaration and then - ((Present (Expression (Associated_Node_For_Itype (Base))) - and then not - Is_Two_Pass_Aggregate - (Expression (Associated_Node_For_Itype (Base)))) + (Present (Expression (Associated_Node_For_Itype (Base))) or else No_Initialization (Associated_Node_For_Itype (Base))) then null; @@ -8293,12 +8287,15 @@ package body Exp_Ch3 is -- where the object has been initialized by a call to a function -- returning on the primary stack (see Expand_Ctrl_Function_Call) -- since no copy occurred, given that the type is by-reference. + -- Likewise if it is initialized by a 2-pass aggregate, since the + -- actual initialization will only occur during the second pass. -- Similarly, no adjustment is needed if we are going to rewrite -- the object declaration into a renaming declaration. if Needs_Finalization (Typ) and then not Is_Inherently_Limited_Type (Typ) and then Nkind (Expr_Q) /= N_Function_Call + and then not Is_Two_Pass_Aggregate (Expr_Q) and then not Rewrite_As_Renaming then Adj_Call := diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 82978c7..eb9fb6b 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -769,7 +769,6 @@ package body Exp_Ch4 is -- Local variables Aggr_In_Place : Boolean; - Container_Aggr : Boolean; Delayed_Cond_Expr : Boolean; TagT : Entity_Id := Empty; @@ -865,13 +864,15 @@ package body Exp_Ch4 is Aggr_In_Place := Is_Delayed_Aggregate (Exp); Delayed_Cond_Expr := Is_Delayed_Conditional_Expression (Exp); - Container_Aggr := Nkind (Exp) = N_Aggregate - and then Has_Aspect (T, Aspect_Aggregate); - -- An allocator with a container aggregate as qualified expression must - -- be rewritten into the form expected by Expand_Container_Aggregate. + -- An allocator with a container aggregate, resp. a 2-pass aggregate, + -- as qualified expression must be rewritten into the form expected by + -- Expand_Container_Aggregate, resp. Two_Pass_Aggregate_Expansion. - if Container_Aggr then + if Nkind (Exp) = N_Aggregate + and then (Has_Aspect (T, Aspect_Aggregate) + or else Is_Two_Pass_Aggregate (Exp)) + then Temp := Make_Temporary (Loc, 'P', N); Set_Analyzed (Exp, False); Insert_Action (N, @@ -15035,10 +15036,11 @@ package body Exp_Ch4 is -- Handle entities from the limited view - Orig_Right_Type : constant Entity_Id := Available_View (Etype (Right)); + Orig_Right_Type : constant Entity_Id := + Base_Type (Available_View (Etype (Right))); Full_R_Typ : Entity_Id; - Left_Type : Entity_Id := Available_View (Etype (Left)); + Left_Type : Entity_Id := Base_Type (Available_View (Etype (Left))); Right_Type : Entity_Id := Orig_Right_Type; Obj_Tag : Node_Id; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 7e46454..f85d977 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2470,11 +2470,6 @@ package body Exp_Ch6 is -- (and ensure that we have an activation chain defined for tasks -- and a Master variable). - -- Currently we limit such functions to those with inherently - -- limited result subtypes, but eventually we plan to expand the - -- functions that are treated as build-in-place to include other - -- composite result types. - -- But do not do it here for intrinsic subprograms since this will -- be done properly after the subprogram is expanded. @@ -8562,12 +8557,10 @@ package body Exp_Ch6 is procedure Make_Build_In_Place_Call_In_Anonymous_Context (Function_Call : Node_Id) is - Loc : constant Source_Ptr := Sloc (Function_Call); - Func_Call : constant Node_Id := Unqual_Conv (Function_Call); - Function_Id : Entity_Id; - Result_Subt : Entity_Id; - Return_Obj_Id : Entity_Id; - Return_Obj_Decl : Entity_Id; + Loc : constant Source_Ptr := Sloc (Function_Call); + Func_Call : constant Node_Id := Unqual_Conv (Function_Call); + Function_Id : Entity_Id; + Result_Subt : Entity_Id; begin -- If the call has already been processed to add build-in-place actuals @@ -8580,10 +8573,6 @@ package body Exp_Ch6 is return; end if; - -- Mark the call as processed as a build-in-place call - - Set_Is_Expanded_Build_In_Place_Call (Func_Call); - if Is_Entity_Name (Name (Func_Call)) then Function_Id := Entity (Name (Func_Call)); @@ -8601,8 +8590,13 @@ package body Exp_Ch6 is -- If the build-in-place function returns a controlled object, then the -- object needs to be finalized immediately after the context. Since -- this case produces a transient scope, the servicing finalizer needs - -- to name the returned object. Create a temporary which is initialized - -- with the function call: + -- to name the returned object. + + -- If the build-in-place function returns a definite subtype, then an + -- object also needs to be created and an access value designating it + -- passed as an actual. + + -- Create a temporary which is initialized with the function call: -- -- Temp_Id : Func_Type := BIP_Func_Call; -- @@ -8610,75 +8604,25 @@ package body Exp_Ch6 is -- the expander using the appropriate mechanism in Make_Build_In_Place_ -- Call_In_Object_Declaration. - if Needs_Finalization (Result_Subt) then + if Needs_Finalization (Result_Subt) + or else Caller_Known_Size (Func_Call, Result_Subt) + then declare Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'R'); - Temp_Decl : Node_Id; - - begin - -- Reset the guard on the function call since the following does - -- not perform actual call expansion. - - Set_Is_Expanded_Build_In_Place_Call (Func_Call, False); - - Temp_Decl := + Temp_Decl : constant Node_Id := Make_Object_Declaration (Loc, Defining_Identifier => Temp_Id, - Object_Definition => - New_Occurrence_Of (Result_Subt, Loc), - Expression => - New_Copy_Tree (Function_Call)); + Aliased_Present => True, + Object_Definition => New_Occurrence_Of (Result_Subt, Loc), + Expression => Relocate_Node (Function_Call)); + begin + Set_Assignment_OK (Temp_Decl); Insert_Action (Function_Call, Temp_Decl); - Rewrite (Function_Call, New_Occurrence_Of (Temp_Id, Loc)); Analyze (Function_Call); end; - -- When the result subtype is definite, an object of the subtype is - -- declared and an access value designating it is passed as an actual. - - elsif Caller_Known_Size (Func_Call, Result_Subt) then - - -- Create a temporary object to hold the function result - - Return_Obj_Id := Make_Temporary (Loc, 'R'); - Set_Etype (Return_Obj_Id, Result_Subt); - - Return_Obj_Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Return_Obj_Id, - Aliased_Present => True, - Object_Definition => New_Occurrence_Of (Result_Subt, Loc)); - - Set_No_Initialization (Return_Obj_Decl); - - Insert_Action (Func_Call, Return_Obj_Decl); - - -- When the function has a controlling result, an allocation-form - -- parameter must be passed indicating that the caller is allocating - -- the result object. This is needed because such a function can be - -- called as a dispatching operation and must be treated similarly - -- to functions with unconstrained result subtypes. - - Add_Unconstrained_Actuals_To_Build_In_Place_Call - (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); - - Add_Collection_Actual_To_Build_In_Place_Call - (Func_Call, Function_Id); - - Add_Task_Actuals_To_Build_In_Place_Call - (Func_Call, Function_Id, Make_Identifier (Loc, Name_uMaster)); - - -- Add an implicit actual to the function call that provides access - -- to the caller's return object. - - Add_Access_Actual_To_Build_In_Place_Call - (Func_Call, Function_Id, New_Occurrence_Of (Return_Obj_Id, Loc)); - - pragma Assert (Check_Number_Of_Actuals (Func_Call, Function_Id)); - pragma Assert (Check_BIP_Actuals (Func_Call, Function_Id)); - -- When the result subtype is unconstrained, the function must allocate -- the return object in the secondary stack, so appropriate implicit -- parameters are added to the call to indicate that. A transient @@ -8703,6 +8647,10 @@ package body Exp_Ch6 is Add_Access_Actual_To_Build_In_Place_Call (Func_Call, Function_Id, Empty); + -- Mark the call as processed as a build-in-place call + + Set_Is_Expanded_Build_In_Place_Call (Func_Call); + pragma Assert (Check_Number_Of_Actuals (Func_Call, Function_Id)); pragma Assert (Check_BIP_Actuals (Func_Call, Function_Id)); end if; @@ -9909,6 +9857,13 @@ package body Exp_Ch6 is return Skip; end if; + -- Skip calls placed in unexpanded initialization expressions + + when N_Object_Declaration => + if No_Initialization (Nod) then + return Skip; + end if; + -- Skip calls placed in subprogram specifications since function -- calls initializing default parameter values will be processed -- when the call to the subprogram is found (if the default actual diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 67af1d7..905094c 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -2783,16 +2783,31 @@ package body Exp_Ch7 is Master_Node_Id := Make_Defining_Identifier (Master_Node_Loc, Chars => New_External_Name (Chars (Obj_Id), Suffix => "MN")); + Master_Node_Decl := Make_Master_Node_Declaration (Master_Node_Loc, Master_Node_Id, Obj_Id); Push_Scope (Scope (Obj_Id)); + + -- Avoid generating duplicate names for master nodes + + if Ekind (Obj_Id) = E_Loop_Parameter + and then + Present (Current_Entity_In_Scope (Chars (Master_Node_Id))) + then + Set_Chars (Master_Node_Id, + New_External_Name (Chars (Obj_Id), + Suffix => "MN", + Suffix_Index => -1)); + end if; + if not Has_Strict_Ctrl_Objs or else Count = 1 then Prepend_To (Decls, Master_Node_Decl); else Insert_Before (Decl, Master_Node_Decl); end if; + Analyze (Master_Node_Decl); Pop_Scope; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 97469d7..54830b8 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -12360,9 +12360,9 @@ which changes element (1,2) to 20 and (3,4) to 30. @geindex Valid_Value The @code{'Valid_Value} attribute is defined for enumeration types other than -those in package Standard. This attribute is a function that takes -a String, and returns Boolean. @code{T'Valid_Value (S)} returns True -if and only if @code{T'Value (S)} would not raise Constraint_Error. +those in package Standard or types derived from those types. This attribute is +a function that takes a String, and returns Boolean. @code{T'Valid_Value (S)} +returns True if and only if @code{T'Value (S)} would not raise Constraint_Error. @node Attribute Valid_Scalars,Attribute VADS_Size,Attribute Valid_Value,Implementation Defined Attributes @anchor{gnat_rm/implementation_defined_attributes attribute-valid-scalars}@anchor{1c5} diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index af08fdb..08da29a 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -7511,13 +7511,14 @@ package body Sem_Attr is Set_Etype (N, Standard_Boolean); Validate_Non_Static_Attribute_Function_Call; - if P_Type in Standard_Boolean + if Root_Type (P_Type) in Standard_Boolean | Standard_Character | Standard_Wide_Character | Standard_Wide_Wide_Character then Error_Attr_P - ("prefix of % attribute must not be a type in Standard"); + ("prefix of % attribute must not be a type originating from " & + "Standard"); end if; if Discard_Names (First_Subtype (P_Type)) then diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 74eac9c..4b5c5b1 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4991,7 +4991,7 @@ package body Sem_Ch3 is if Is_Array_Type (T) and then No_Initialization (N) - and then Nkind (Original_Node (E)) = N_Aggregate + and then Nkind (Unqualify (Original_Node (E))) = N_Aggregate then Act_T := Etype (E); @@ -5137,10 +5137,7 @@ package body Sem_Ch3 is elsif Is_Array_Type (T) and then No_Initialization (N) - and then (Nkind (Original_Node (E)) = N_Aggregate - or else (Nkind (Original_Node (E)) = N_Qualified_Expression - and then Nkind (Original_Node (Expression - (Original_Node (E)))) = N_Aggregate)) + and then Nkind (Unqualify (Original_Node (E))) = N_Aggregate then if not Is_Entity_Name (Object_Definition (N)) then Act_T := Etype (E); @@ -6633,8 +6630,6 @@ package body Sem_Ch3 is end; end if; - -- Constrained array case - if No (T) then -- We might be creating more than one itype with the same Related_Id, -- e.g. for an array object definition and its initial value. Give @@ -6644,6 +6639,8 @@ package body Sem_Ch3 is T := Create_Itype (E_Void, P, Related_Id, 'T', Suffix_Index => -1); end if; + -- Constrained array case + if Nkind (Def) = N_Constrained_Array_Definition then Index := First (Discrete_Subtype_Definitions (Def)); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index b73b947..0df6c27 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6101,6 +6101,8 @@ package body Sem_Res is elsif Is_Fixed_Point_Type (It.Typ) then if Analyzed (N) then Error_Msg_N ("ambiguous operand in fixed operation", N); + elsif It.Typ = Any_Fixed then + Resolve (N, B_Typ); else Resolve (N, It.Typ); end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 0e1505b..7757e04 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -3025,7 +3025,7 @@ package body Sem_Util is -- For an array aggregate, a discrete_choice_list that has -- a nonstatic range is considered as two or more separate - -- occurrences of the expression (RM 6.4.1(20/3)). + -- occurrences of the expression (RM 6.4.1(6.20/3)). elsif Is_Array_Type (Etype (N)) and then Nkind (N) = N_Aggregate @@ -3110,48 +3110,105 @@ package body Sem_Util is end loop; end if; - -- Handle discrete associations + -- Handle named associations if Present (Component_Associations (N)) then Assoc := First (Component_Associations (N)); while Present (Assoc) loop - if not Box_Present (Assoc) then - Choice := First (Choices (Assoc)); - while Present (Choice) loop + Handle_Association : declare - -- For now we skip discriminants since it requires - -- performing the analysis in two phases: first one - -- analyzing discriminants and second one analyzing - -- the rest of components since discriminants are - -- evaluated prior to components: too much extra - -- work to detect a corner case??? + procedure Collect_Expression_Ids (Expr : Node_Id); + -- Collect identifiers in association expression Expr - if Nkind (Choice) in N_Has_Entity - and then Present (Entity (Choice)) - and then Ekind (Entity (Choice)) = E_Discriminant - then - null; + procedure Handle_Association_Choices + (Choices : List_Id; Expr : Node_Id); + -- Collect identifiers in an association expression + -- Expr for each choice in Choices. - elsif Box_Present (Assoc) then - null; + ---------------------------- + -- Collect_Expression_Ids -- + ---------------------------- + procedure Collect_Expression_Ids (Expr : Node_Id) is + Comp_Expr : Node_Id; + + begin + if not Analyzed (Expr) then + Comp_Expr := New_Copy_Tree (Expr); + Set_Parent (Comp_Expr, Parent (N)); + Preanalyze_Without_Errors (Comp_Expr); else - if not Analyzed (Expression (Assoc)) then - Comp_Expr := - New_Copy_Tree (Expression (Assoc)); - Set_Parent (Comp_Expr, Parent (N)); - Preanalyze_Without_Errors (Comp_Expr); + Comp_Expr := Expr; + end if; + + Collect_Identifiers (Comp_Expr); + end Collect_Expression_Ids; + + -------------------------------- + -- Handle_Association_Choices -- + -------------------------------- + + procedure Handle_Association_Choices + (Choices : List_Id; Expr : Node_Id) + is + Choice : Node_Id := First (Choices); + + begin + while Present (Choice) loop + + -- For now skip discriminants since it requires + -- performing analysis in two phases: first one + -- analyzing discriminants and second analyzing + -- the rest of components since discriminants + -- are evaluated prior to components: too much + -- extra work to detect a corner case??? + + if Nkind (Choice) in N_Has_Entity + and then Present (Entity (Choice)) + and then + Ekind (Entity (Choice)) = E_Discriminant + then + null; + else - Comp_Expr := Expression (Assoc); + Collect_Expression_Ids (Expr); end if; - Collect_Identifiers (Comp_Expr); - end if; + Next (Choice); + end loop; + end Handle_Association_Choices; - Next (Choice); - end loop; - end if; + begin + if not Box_Present (Assoc) then + if Nkind (Assoc) = N_Component_Association then + Handle_Association_Choices + (Choices (Assoc), Expression (Assoc)); + + elsif + Nkind (Assoc) = N_Iterated_Component_Association + and then Present (Defining_Identifier (Assoc)) + then + Handle_Association_Choices + (Discrete_Choices (Assoc), Expression (Assoc)); + + -- Nkind (Assoc) = N_Iterated_Component_Association + -- with iterator_specification, or + -- Nkind (Assoc) = N_Iterated_Element_Association + -- with loop_parameter_specification + -- or iterator_specification + -- + -- It seems that we might also need to deal with + -- iterable/iterator_names and iterator_filters + -- within iterator_specifications, and range bounds + -- within loop_parameter_specifications, but the + -- utility of doing that seems very low. ??? + + else + Collect_Expression_Ids (Expression (Assoc)); + end if; + end if; + end Handle_Association; Next (Assoc); end loop; @@ -8063,12 +8120,20 @@ package body Sem_Util is loop Ren := Renamed_Object (Id); + -- The reference renames a function result. Check the original + -- node in case expansion relocates the function call. + + -- Ren : ... renames Func_Call; + + if Nkind (Original_Node (Ren)) = N_Function_Call then + exit; + -- The reference renames an abstract state or a whole object -- Obj : ...; -- Ren : ... renames Obj; - if Is_Entity_Name (Ren) then + elsif Is_Entity_Name (Ren) then -- Do not follow a renaming that goes through a generic formal, -- because these entities are hidden and must not be referenced @@ -8081,14 +8146,6 @@ package body Sem_Util is Id := Entity (Ren); end if; - -- The reference renames a function result. Check the original - -- node in case expansion relocates the function call. - - -- Ren : ... renames Func_Call; - - elsif Nkind (Original_Node (Ren)) = N_Function_Call then - exit; - -- Otherwise the reference renames something which does not yield -- an abstract state or a whole object. Treat the reference as not -- having a proper entity for SPARK legality purposes. @@ -12368,9 +12425,14 @@ package body Sem_Util is while Present (Node) loop case Nkind (Node) is - when N_Null_Statement | N_Call_Marker | N_Raise_xxx_Error => + when N_Null_Statement | N_Call_Marker => null; + when N_Raise_xxx_Error => + if Comes_From_Source (Node) then + return False; + end if; + when N_Object_Declaration => if Present (Expression (Node)) and then not Side_Effect_Free (Expression (Node)) diff --git a/gcc/builtins.def b/gcc/builtins.def index ff47005..6794109 100644 --- a/gcc/builtins.def +++ b/gcc/builtins.def @@ -217,6 +217,8 @@ along with GCC; see the file COPYING3. If not see DEF_BUILTIN (ENUM, "__builtin_" NAME, BUILT_IN_NORMAL, TYPE, TYPE, \ false, true, true, ATTRS, false, \ flag_openacc) +/* Set NONANSI_P = false to enable the builtins also with -fno-nonansi-builtins, + esp. as -std=c++../c.. imply that flag and -fopenacc should be othogonal. */ #undef DEF_GOACC_BUILTIN_COMPILER #define DEF_GOACC_BUILTIN_COMPILER(ENUM, NAME, TYPE, ATTRS) \ DEF_BUILTIN (ENUM, "__builtin_" NAME, BUILT_IN_NORMAL, TYPE, TYPE, \ @@ -232,10 +234,12 @@ along with GCC; see the file COPYING3. If not see (flag_openacc \ || flag_openmp \ || flag_tree_parallelize_loops > 1)) +/* Set NONANSI_P = false to enable the builtins also with -fno-nonansi-builtins, + esp. as -std=c++../c.. imply that flag and -fopenmp should be othogonal. */ #undef DEF_GOMP_BUILTIN_COMPILER #define DEF_GOMP_BUILTIN_COMPILER(ENUM, NAME, TYPE, ATTRS) \ DEF_BUILTIN (ENUM, "__builtin_" NAME, BUILT_IN_NORMAL, TYPE, TYPE, \ - flag_openmp, true, true, ATTRS, false, flag_openmp) + flag_openmp, true, false, ATTRS, false, flag_openmp) /* Builtin used by the implementation of GNU TM. These functions are mapped to the actual implementation of the STM library. */ diff --git a/gcc/c/ChangeLog.omp b/gcc/c/ChangeLog.omp index ff881b5..d3e1d0e 100644 --- a/gcc/c/ChangeLog.omp +++ b/gcc/c/ChangeLog.omp @@ -1,3 +1,12 @@ +2025-06-05 Sandra Loosemore <sloosemore@baylibre.com> + + Backported from master: + 2025-06-02 Sandra Loosemore <sloosemore@baylibre.com> + + * c-parser.cc (c_parser_omp_context_selector): Call + convert_lvalue_to_rvalue and c_objc_common_truthvalue_conversion + on the expression for OMP_TRAIT_PROPERTY_BOOL_EXPR. + 2025-05-15 waffl3x <waffl3x@baylibre.com> PR c++/119659 diff --git a/gcc/config.gcc b/gcc/config.gcc index 40b50dc..5725704 100644 --- a/gcc/config.gcc +++ b/gcc/config.gcc @@ -4598,15 +4598,13 @@ case "${target}" in for which in arch tune; do eval "val=\$with_$which" - case ${val} in - "" | gfx900 | gfx906 | gfx908 | gfx90a | gfx90c | gfx1030 | gfx1036 | gfx1100 | gfx1103) - # OK - ;; - *) + if test x"$val" != x \ + && ! grep -q "GCN_DEVICE($val," \ + "${srcdir}/config/gcn/gcn-devices.def"; + then echo "Unknown cpu used in --with-$which=$val." 1>&2 exit 1 - ;; - esac + fi done [ "x$with_arch" = x ] && with_arch=gfx900 diff --git a/gcc/config/i386/i386.cc b/gcc/config/i386/i386.cc index 38df84f..a6f0a58 100644 --- a/gcc/config/i386/i386.cc +++ b/gcc/config/i386/i386.cc @@ -25545,14 +25545,10 @@ ix86_vector_costs::finish_cost (const vector_costs *scalar_costs) /* When X86_TUNE_AVX512_TWO_EPILOGUES is enabled arrange for both a AVX2 and a SSE epilogue for AVX512 vectorized loops. */ if (loop_vinfo + && LOOP_VINFO_EPILOGUE_P (loop_vinfo) + && GET_MODE_SIZE (loop_vinfo->vector_mode) == 32 && ix86_tune_features[X86_TUNE_AVX512_TWO_EPILOGUES]) - { - if (GET_MODE_SIZE (loop_vinfo->vector_mode) == 64) - m_suggested_epilogue_mode = V32QImode; - else if (LOOP_VINFO_EPILOGUE_P (loop_vinfo) - && GET_MODE_SIZE (loop_vinfo->vector_mode) == 32) - m_suggested_epilogue_mode = V16QImode; - } + m_suggested_epilogue_mode = V16QImode; /* When a 128bit SSE vectorized epilogue still has a VF of 16 or larger enable a 64bit SSE epilogue. */ if (loop_vinfo diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 8983abf..2534339 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,9 @@ +2025-06-02 Jason Merrill <jason@redhat.com> + + PR c++/120123 + * lambda.cc (nonlambda_method_basetype): Look through lambdas + even when current_class_ref is null. + 2025-05-30 Sandra Loosemore <sloosemore@baylibre.com> Backported from master: diff --git a/gcc/cp/ChangeLog.omp b/gcc/cp/ChangeLog.omp index 3f2574a..c9026b4 100644 --- a/gcc/cp/ChangeLog.omp +++ b/gcc/cp/ChangeLog.omp @@ -1,3 +1,15 @@ +2025-06-05 Sandra Loosemore <sloosemore@baylibre.com> + + Backported from master: + 2025-06-02 Sandra Loosemore <sloosemore@baylibre.com> + + * cp-tree.h (maybe_convert_cond): Declare. + * parser.cc (cp_parser_omp_context_selector): Call + maybe_convert_cond and fold_build_cleanup_point_expr on the + expression for OMP_TRAIT_PROPERTY_BOOL_EXPR. + * pt.cc (tsubst_omp_context_selector): Likewise. + * semantics.cc (maybe_convert_cond): Remove static declaration. + 2025-05-15 Sandra Loosemore <sloosemore@baylibre.com> Tobias Burnus <tburnus@baylibre.com> diff --git a/gcc/cp/lambda.cc b/gcc/cp/lambda.cc index b2e0ecd..352e1b9 100644 --- a/gcc/cp/lambda.cc +++ b/gcc/cp/lambda.cc @@ -1033,12 +1033,9 @@ current_nonlambda_function (void) tree nonlambda_method_basetype (void) { - if (!current_class_ref) - return NULL_TREE; - tree type = current_class_type; if (!type || !LAMBDA_TYPE_P (type)) - return type; + return current_class_ref ? type : NULL_TREE; while (true) { diff --git a/gcc/doc/install.texi b/gcc/doc/install.texi index 1af0082..3e9e09b 100644 --- a/gcc/doc/install.texi +++ b/gcc/doc/install.texi @@ -1342,9 +1342,13 @@ default set of libraries is selected based on the value of @item amdgcn*-*-* @var{list} is a comma separated list of ISA names (allowed values: -@code{gfx900}, @code{gfx906}, @code{gfx908}, @code{gfx90a}, @code{gfx90c}, -@code{gfx1030}, @code{gfx1036}, @code{gfx1100}, @code{gfx1103}). -It ought not include the name of the default +@code{gfx900}, @code{gfx902}, @code{gfx904}, @code{gfx906}, @code{gfx908}, +@code{gfx909}, @code{gfx90a}, @code{gfx90c}, @code{gfx9-generic}, +@code{gfx1030}, @code{gfx1031}, @code{gfx1032}, @code{gfx1033}, +@code{gfx1034}, @code{gfx1035}, @code{gfx1036}, @code{gfx10-3-generic}, +@code{gfx1100}, @code{gfx1101}, @code{gfx1102}, @code{gfx1103}, +@code{gfx1150}, @code{gfx1151}, @code{gfx1152}, @code{gfx1153}, +@code{gfx11-generic}). It ought not include the name of the default ISA, specified via @option{--with-arch}. If @var{list} is empty, then there will be no multilibs and only the default run-time library will be built. If @var{list} is @code{default} or @option{--with-multilib-list=} is not @@ -1190,7 +1190,10 @@ canon_address (rtx mem, address = strip_offset_and_add (address, offset); if (ADDR_SPACE_GENERIC_P (MEM_ADDR_SPACE (mem)) - && const_or_frame_p (address)) + && const_or_frame_p (address) + /* Literal addresses can alias any base, avoid creating a + group for them. */ + && ! CONST_SCALAR_INT_P (address)) { group_info *group = get_group_info (address); diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2f9f5c9..c470df3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,74 @@ +2025-06-04 Harald Anlauf <anlauf@gmx.de> + + Backported from master: + 2025-06-03 Harald Anlauf <anlauf@gmx.de> + + PR fortran/99838 + * data.cc (gfc_assign_data_value): For a new initializer use the + location from the constructor as fallback. + +2025-06-03 Harald Anlauf <anlauf@gmx.de> + + Backported from master: + 2025-05-30 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102599 + PR fortran/114022 + * expr.cc (simplify_complex_array_inquiry_ref): Helper function for + simplification of inquiry references (%re/%im) of constant complex + arrays. + (find_inquiry_ref): Use it for handling %re/%im inquiry references + of complex arrays. + (scalarize_intrinsic_call): Fix frontend memleak. + * primary.cc (gfc_match_varspec): When the reference is NULL, the + previous simplification has succeeded in evaluating inquiry + references also of arrays. + +2025-06-03 Harald Anlauf <anlauf@gmx.de> + + Backported from master: + 2025-05-27 Harald Anlauf <anlauf@gmx.de> + + PR fortran/101735 + * primary.cc (gfc_match_varspec): Correct order of logic. + +2025-06-03 Harald Anlauf <anlauf@gmx.de> + + Backported from master: + 2025-05-27 Harald Anlauf <anlauf@gmx.de> + + PR fortran/101735 + * expr.cc (find_inquiry_ref): If an inquiry reference applies to + a substring, use that, and calculate substring length if needed. + * primary.cc (extend_ref): Also handle attaching to end of + reference chain for appending. + (gfc_match_varspec): Discrimate between arrays of character and + substrings of them. If a substring is taken from a character + component of a derived type, get the proper typespec so that + inquiry references work correctly. + (gfc_match_rvalue): Handle corner case where we hit a seemingly + dangling '%' and missed an inquiry reference. Try another match. + +2025-06-02 Jakub Jelinek <jakub@redhat.com> + + Backported from master: + 2025-05-10 Jakub Jelinek <jakub@redhat.com> + + PR fortran/120193 + * trans-types.cc (gfc_init_types): For flag_unsigned use + build_distinct_type_copy or build_variant_type_copy from + gfc_character_types[index_char] if index_char > -1 instead of + gfc_character_types[index_char] or + gfc_build_unsigned_type (&gfc_unsigned_kinds[index]). + +2025-06-02 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + Backported from master: + 2025-05-28 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/119856 + * io.cc: Set missing comma error checks to STD_STD_LEGACY. + 2025-05-31 Jerry DeLisle <jvdelisle@gcc.gnu.org> Backported from master: diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp index 05c8e3f..7c5eee2 100644 --- a/gcc/fortran/ChangeLog.omp +++ b/gcc/fortran/ChangeLog.omp @@ -1,3 +1,16 @@ +2025-06-06 Tobias Burnus <tburnus@baylibre.com> + + Backported from master: + 2025-06-06 Tobias Burnus <tburnus@baylibre.com> + Sandra Loosemore <sloosemore@baylibre.com> + + * f95-lang.cc (ATTR_PURE_NOTHROW_LIST): Define. + * trans-expr.cc (get_builtin_fn): Handle omp_get_num_devices + and omp_get_intrinsic_device. + * gfortran.h (gfc_option_t): Add disable_omp_... for them. + * options.cc (gfc_handle_option): Handle them with + -fno-builtin-. + 2025-05-15 Sandra Loosemore <sloosemore@baylibre.com> Tobias Burnus <tburnus@baylibre.com> diff --git a/gcc/fortran/data.cc b/gcc/fortran/data.cc index 5c83f69..a438c26 100644 --- a/gcc/fortran/data.cc +++ b/gcc/fortran/data.cc @@ -593,7 +593,13 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, { /* Point the container at the new expression. */ if (last_con == NULL) - symbol->value = expr; + { + symbol->value = expr; + /* For a new initializer use the location from the + constructor as fallback. */ + if (!GFC_LOCUS_IS_SET(expr->where) && con != NULL) + symbol->value->where = con->where; + } else last_con->expr = expr; } diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index 827e199..95ea055 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -1838,6 +1838,55 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp) } +/* Simplify inquiry references (%re/%im) of constant complex arrays. + Used by find_inquiry_ref. */ + +static gfc_expr * +simplify_complex_array_inquiry_ref (gfc_expr *p, inquiry_type inquiry) +{ + gfc_expr *e, *r, *result; + gfc_constructor_base base; + gfc_constructor *c; + + if ((inquiry != INQUIRY_RE && inquiry != INQUIRY_IM) + || p->expr_type != EXPR_ARRAY + || p->ts.type != BT_COMPLEX + || p->rank <= 0 + || p->value.constructor == NULL + || !gfc_is_constant_array_expr (p)) + return NULL; + + /* Simplify array sections. */ + gfc_simplify_expr (p, 0); + + result = gfc_get_array_expr (BT_REAL, p->ts.kind, &p->where); + result->rank = p->rank; + result->shape = gfc_copy_shape (p->shape, p->rank); + + base = p->value.constructor; + for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c)) + { + e = c->expr; + if (e->expr_type != EXPR_CONSTANT) + goto fail; + + r = gfc_get_constant_expr (BT_REAL, e->ts.kind, &e->where); + if (inquiry == INQUIRY_RE) + mpfr_set (r->value.real, mpc_realref (e->value.complex), GFC_RND_MODE); + else + mpfr_set (r->value.real, mpc_imagref (e->value.complex), GFC_RND_MODE); + + gfc_constructor_append_expr (&result->value.constructor, r, &e->where); + } + + return result; + +fail: + gfc_free_expr (result); + return NULL; +} + + /* Pull an inquiry result out of an expression. */ static bool @@ -1846,7 +1895,9 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp) gfc_ref *ref; gfc_ref *inquiry = NULL; gfc_ref *inquiry_head; + gfc_ref *ref_ss = NULL; gfc_expr *tmp; + bool nofail = false; tmp = gfc_copy_expr (p); @@ -1862,6 +1913,9 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp) { inquiry = ref->next; ref->next = NULL; + if (ref->type == REF_SUBSTRING) + ref_ss = ref; + break; } } @@ -1891,6 +1945,28 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp) if (!gfc_notify_std (GFC_STD_F2003, "LEN part_ref at %C")) goto cleanup; + /* Inquire length of substring? */ + if (ref_ss) + { + if (ref_ss->u.ss.start->expr_type == EXPR_CONSTANT + && ref_ss->u.ss.end->expr_type == EXPR_CONSTANT) + { + HOST_WIDE_INT istart, iend, length; + istart = gfc_mpz_get_hwi (ref_ss->u.ss.start->value.integer); + iend = gfc_mpz_get_hwi (ref_ss->u.ss.end->value.integer); + + if (istart <= iend) + length = iend - istart + 1; + else + length = 0; + *newp = gfc_get_int_expr (gfc_default_integer_kind, + NULL, length); + break; + } + else + goto cleanup; + } + if (tmp->ts.u.cl->length && tmp->ts.u.cl->length->expr_type == EXPR_CONSTANT) *newp = gfc_copy_expr (tmp->ts.u.cl->length); @@ -1921,24 +1997,50 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp) break; case INQUIRY_RE: - if (tmp->ts.type != BT_COMPLEX || tmp->expr_type != EXPR_CONSTANT) + if (tmp->ts.type != BT_COMPLEX) goto cleanup; if (!gfc_notify_std (GFC_STD_F2008, "RE part_ref at %C")) goto cleanup; + if (tmp->expr_type == EXPR_ARRAY) + { + *newp = simplify_complex_array_inquiry_ref (tmp, INQUIRY_RE); + if (*newp != NULL) + { + nofail = true; + break; + } + } + + if (tmp->expr_type != EXPR_CONSTANT) + goto cleanup; + *newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where); mpfr_set ((*newp)->value.real, mpc_realref (tmp->value.complex), GFC_RND_MODE); break; case INQUIRY_IM: - if (tmp->ts.type != BT_COMPLEX || tmp->expr_type != EXPR_CONSTANT) + if (tmp->ts.type != BT_COMPLEX) goto cleanup; if (!gfc_notify_std (GFC_STD_F2008, "IM part_ref at %C")) goto cleanup; + if (tmp->expr_type == EXPR_ARRAY) + { + *newp = simplify_complex_array_inquiry_ref (tmp, INQUIRY_IM); + if (*newp != NULL) + { + nofail = true; + break; + } + } + + if (tmp->expr_type != EXPR_CONSTANT) + goto cleanup; + *newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where); mpfr_set ((*newp)->value.real, mpc_imagref (tmp->value.complex), GFC_RND_MODE); @@ -1951,7 +2053,7 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp) if (!(*newp)) goto cleanup; - else if ((*newp)->expr_type != EXPR_CONSTANT) + else if ((*newp)->expr_type != EXPR_CONSTANT && !nofail) { gfc_free_expr (*newp); goto cleanup; @@ -2523,7 +2625,7 @@ scalarize_intrinsic_call (gfc_expr *e, bool init_flag) rank[n] = a->expr->rank; else rank[n] = 1; - ctor = gfc_constructor_copy (a->expr->value.constructor); + ctor = a->expr->value.constructor; args[n] = gfc_constructor_first (ctor); } else diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc index 3808fed..3b6610e 100644 --- a/gcc/fortran/f95-lang.cc +++ b/gcc/fortran/f95-lang.cc @@ -571,7 +571,7 @@ gfc_builtin_function (tree decl) return decl; } -/* So far we need just these 10 attribute types. */ +/* So far we need just these 12 attribute types. */ #define ATTR_NULL 0 #define ATTR_LEAF_LIST (ECF_LEAF) #define ATTR_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF) @@ -587,6 +587,7 @@ gfc_builtin_function (tree decl) #define ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST \ (ECF_COLD | ECF_NORETURN | \ ECF_NOTHROW | ECF_LEAF) +#define ATTR_PURE_NOTHROW_LIST (ECF_PURE | ECF_NOTHROW) static void gfc_define_builtin (const char *name, tree type, enum built_in_function code, diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 903712a..aa44571 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3338,8 +3338,10 @@ typedef struct int flag_init_logical; int flag_init_character; char flag_init_character_value; - bool disable_omp_is_initial_device; - bool disable_acc_on_device; + bool disable_omp_is_initial_device:1; + bool disable_omp_get_initial_device:1; + bool disable_omp_get_num_devices:1; + bool disable_acc_on_device:1; int fpe; int fpe_summary; diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc index ddddc1c..d3c9066 100644 --- a/gcc/fortran/options.cc +++ b/gcc/fortran/options.cc @@ -883,6 +883,10 @@ gfc_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value, return false; /* Not supported. */ if (!strcmp ("omp_is_initial_device", arg)) gfc_option.disable_omp_is_initial_device = true; + else if (!strcmp ("omp_get_initial_device", arg)) + gfc_option.disable_omp_get_initial_device = true; + else if (!strcmp ("omp_get_num_devices", arg)) + gfc_option.disable_omp_get_num_devices = true; else if (!strcmp ("acc_on_device", arg)) gfc_option.disable_acc_on_device = true; else diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 72ecc7c..b5dddde 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -2102,10 +2102,18 @@ extend_ref (gfc_expr *primary, gfc_ref *tail) { if (primary->ref == NULL) primary->ref = tail = gfc_get_ref (); + else if (tail == NULL) + { + /* Set tail to end of reference chain. */ + for (gfc_ref *ref = primary->ref; ref; ref = ref->next) + if (ref->next == NULL) + { + tail = ref; + break; + } + } else { - if (tail == NULL) - gfc_internal_error ("extend_ref(): Bad tail"); tail->next = gfc_get_ref (); tail = tail->next; } @@ -2302,9 +2310,22 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, gfc_array_spec *as; bool coarray_only = sym->attr.codimension && !sym->attr.dimension && sym->ts.type == BT_CHARACTER; + gfc_ref *ref, *strarr = NULL; tail = extend_ref (primary, tail); - tail->type = REF_ARRAY; + if (sym->ts.type == BT_CHARACTER && tail->type == REF_SUBSTRING) + { + gcc_assert (sym->attr.dimension); + /* Find array reference for substrings of character arrays. */ + for (ref = primary->ref; ref && ref->next; ref = ref->next) + if (ref->type == REF_ARRAY && ref->next->type == REF_SUBSTRING) + { + strarr = ref; + break; + } + } + else + tail->type = REF_ARRAY; /* In EQUIVALENCE, we don't know yet whether we are seeing an array, character variable or array of character @@ -2317,7 +2338,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, else as = sym->as; - m = gfc_match_array_ref (&tail->u.ar, as, equiv_flag, as ? as->corank : 0, + ref = strarr ? strarr : tail; + m = gfc_match_array_ref (&ref->u.ar, as, equiv_flag, as ? as->corank : 0, coarray_only); if (m != MATCH_YES) return m; @@ -2483,6 +2505,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, { bool t; gfc_symtree *tbp; + gfc_typespec *ts = &primary->ts; m = gfc_match_name (name); if (m == MATCH_NO) @@ -2490,8 +2513,18 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, if (m != MATCH_YES) return MATCH_ERROR; + /* For derived type components find typespec of ultimate component. */ + if (ts->type == BT_DERIVED && primary->ref) + { + for (gfc_ref *ref = primary->ref; ref; ref = ref->next) + { + if (ref->type == REF_COMPONENT && ref->u.c.component) + ts = &ref->u.c.component->ts; + } + } + intrinsic = false; - if (primary->ts.type != BT_CLASS && primary->ts.type != BT_DERIVED) + if (ts->type != BT_CLASS && ts->type != BT_DERIVED) { inquiry = is_inquiry_ref (name, &tmp); if (inquiry) @@ -2564,7 +2597,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, return MATCH_ERROR; } else if (tmp->u.i == INQUIRY_LEN - && primary->ts.type != BT_CHARACTER) + && ts->type != BT_CHARACTER) { gfc_error ("The LEN part_ref at %C must be applied " "to a CHARACTER expression"); @@ -2659,6 +2692,11 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, primary->ref = tmp; else { + /* Find end of reference chain if inquiry reference and tail not + set. */ + if (tail == NULL && inquiry && tmp) + tail = extend_ref (primary, tail); + /* Set by the for loop below for the last component ref. */ gcc_assert (tail != NULL); tail->next = tmp; @@ -2678,6 +2716,9 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, if (primary->expr_type == EXPR_CONSTANT) goto check_done; + if (primary->ref == NULL) + goto check_done; + switch (tmp->u.i) { case INQUIRY_RE: @@ -2828,6 +2869,7 @@ check_substring: if (substring) primary->ts.u.cl = NULL; + gfc_gobble_whitespace (); if (gfc_peek_ascii_char () == '(') { gfc_error_now ("Unexpected array/substring ref at %C"); @@ -4271,6 +4313,16 @@ gfc_match_rvalue (gfc_expr **result) return MATCH_ERROR; } + /* Scan for possible inquiry references. */ + if (m == MATCH_YES + && e->expr_type == EXPR_VARIABLE + && gfc_peek_ascii_char () == '%') + { + m = gfc_match_varspec (e, 0, false, false); + if (m == MATCH_NO) + m = MATCH_YES; + } + if (m == MATCH_YES) { e->where = where; diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 7031a829..d72545e 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -4627,6 +4627,16 @@ get_builtin_fn (gfc_symbol * sym) && !strcmp (sym->name, "omp_is_initial_device")) return builtin_decl_explicit (BUILT_IN_OMP_IS_INITIAL_DEVICE); + if (!gfc_option.disable_omp_get_initial_device + && flag_openmp && sym->attr.function && sym->ts.type == BT_INTEGER + && !strcmp (sym->name, "omp_get_initial_device")) + return builtin_decl_explicit (BUILT_IN_OMP_GET_INITIAL_DEVICE); + + if (!gfc_option.disable_omp_get_num_devices + && flag_openmp && sym->attr.function && sym->ts.type == BT_INTEGER + && !strcmp (sym->name, "omp_get_num_devices")) + return builtin_decl_explicit (BUILT_IN_OMP_GET_NUM_DEVICES); + if (!gfc_option.disable_acc_on_device && flag_openacc && sym->attr.function && sym->ts.type == BT_LOGICAL && !strcmp (sym->name, "acc_on_device_h")) diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 3374778..f898075 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -1140,11 +1140,6 @@ gfc_init_types (void) } gfc_character1_type_node = gfc_character_types[0]; - /* The middle end only recognizes a single unsigned type. For - compatibility of existing test cases, let's just use the - character type. The reader of tree dumps is expected to be able - to deal with this. */ - if (flag_unsigned) { for (index = 0; gfc_unsigned_kinds[index].kind != 0;++index) @@ -1159,18 +1154,26 @@ gfc_init_types (void) break; } } - if (index_char > 0) + if (index_char > -1) { - gfc_unsigned_types[index] = gfc_character_types[index_char]; + type = gfc_character_types[index_char]; + if (TYPE_STRING_FLAG (type)) + { + type = build_distinct_type_copy (type); + TYPE_CANONICAL (type) + = TYPE_CANONICAL (gfc_character_types[index_char]); + } + else + type = build_variant_type_copy (type); + TYPE_NAME (type) = NULL_TREE; + TYPE_STRING_FLAG (type) = 0; } else - { - type = gfc_build_unsigned_type (&gfc_unsigned_kinds[index]); - gfc_unsigned_types[index] = type; - snprintf (name_buf, sizeof(name_buf), "unsigned(kind=%d)", - gfc_integer_kinds[index].kind); - PUSH_TYPE (name_buf, type); - } + type = gfc_build_unsigned_type (&gfc_unsigned_kinds[index]); + gfc_unsigned_types[index] = type; + snprintf (name_buf, sizeof(name_buf), "unsigned(kind=%d)", + gfc_integer_kinds[index].kind); + PUSH_TYPE (name_buf, type); } } diff --git a/gcc/gimple-fold.cc b/gcc/gimple-fold.cc index a64922a..b867d66 100644 --- a/gcc/gimple-fold.cc +++ b/gcc/gimple-fold.cc @@ -4224,6 +4224,40 @@ gimple_fold_builtin_omp_is_initial_device (gimple_stmt_iterator *gsi) return false; } +/* omp_get_initial_device was in OpenMP 5.0/5.1 explicitly and in + 5.0 implicitly the same as omp_get_num_devices; since 6.0 it is + unspecified whether -1 or omp_get_num_devices() is returned. For + better backward compatibility, use omp_get_num_devices() on the + host - and -1 on the device (where the result is unspecified). */ + +static bool +gimple_fold_builtin_omp_get_initial_device (gimple_stmt_iterator *gsi) +{ +#if ACCEL_COMPILER + replace_call_with_value (gsi, build_int_cst (integer_type_node, -1)); +#else + if (!ENABLE_OFFLOADING) + replace_call_with_value (gsi, integer_zero_node); + else + { + tree fn = builtin_decl_explicit (BUILT_IN_OMP_GET_NUM_DEVICES); + gcall *repl = gimple_build_call (fn, 0); + replace_call_with_call_and_fold (gsi, repl); + } +#endif + return true; +} + +static bool +gimple_fold_builtin_omp_get_num_devices (gimple_stmt_iterator *gsi) +{ + if (!ENABLE_OFFLOADING) + { + replace_call_with_value (gsi, integer_zero_node); + return true; + } + return false; +} /* Fold a call to __builtin_acc_on_device. */ @@ -5468,6 +5502,12 @@ gimple_fold_builtin (gimple_stmt_iterator *gsi) case BUILT_IN_OMP_IS_INITIAL_DEVICE: return gimple_fold_builtin_omp_is_initial_device (gsi); + case BUILT_IN_OMP_GET_INITIAL_DEVICE: + return gimple_fold_builtin_omp_get_initial_device (gsi); + + case BUILT_IN_OMP_GET_NUM_DEVICES: + return gimple_fold_builtin_omp_get_num_devices (gsi); + case BUILT_IN_REALLOC: return gimple_fold_builtin_realloc (gsi); diff --git a/gcc/omp-builtins.def b/gcc/omp-builtins.def index 97e8b6a..cfc2fd8 100644 --- a/gcc/omp-builtins.def +++ b/gcc/omp-builtins.def @@ -71,7 +71,12 @@ DEF_GOACC_BUILTIN_ONLY (BUILT_IN_GOACC_SINGLE_COPY_END, "GOACC_single_copy_end", DEF_GOMP_BUILTIN_COMPILER (BUILT_IN_OMP_IS_INITIAL_DEVICE, "omp_is_initial_device", BT_FN_INT, - ATTR_CONST_NOTHROW_LEAF_LIST) + ATTR_CONST_NOTHROW_LIST) +DEF_GOMP_BUILTIN_COMPILER (BUILT_IN_OMP_GET_INITIAL_DEVICE, + "omp_get_initial_device", BT_FN_INT, + ATTR_PURE_NOTHROW_LIST) +DEF_GOMP_BUILTIN_COMPILER (BUILT_IN_OMP_GET_NUM_DEVICES, "omp_get_num_devices", + BT_FN_INT, ATTR_PURE_NOTHROW_LIST) DEF_GOMP_BUILTIN (BUILT_IN_OMP_GET_THREAD_NUM, "omp_get_thread_num", BT_FN_INT, ATTR_NOTHROW_LEAF_LIST) DEF_GOMP_BUILTIN (BUILT_IN_OMP_GET_NUM_THREADS, "omp_get_num_threads", @@ -88,8 +93,6 @@ DEF_GOMP_BUILTIN (BUILT_IN_OMP_SET_DEFAULT_DEVICE, "omp_set_default_device", BT_FN_INT, ATTR_NOTHROW_LEAF_LIST) DEF_GOMP_BUILTIN (BUILT_IN_OMP_GET_INTEROP_INT, "omp_get_interop_int", BT_FN_PTRMODE_PTR_INT_PTR, ATTR_NOTHROW_LEAF_LIST) -DEF_GOMP_BUILTIN (BUILT_IN_OMP_GET_NUM_DEVICES, "omp_get_num_devices", - BT_FN_INT, ATTR_NOTHROW_LEAF_LIST) DEF_GOMP_BUILTIN (BUILT_IN_OMP_INIT_ALLOCATOR, "omp_init_allocator", BT_FN_PTRMODE_PTRMODE_INT_PTR, ATTR_NOTHROW_LEAF_LIST) DEF_GOMP_BUILTIN (BUILT_IN_OMP_DESTROY_ALLOCATOR, "omp_destroy_allocator", diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5b94c72..1175523 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,66 @@ +2025-06-05 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/specs/opt7.ads: New test. + * gnat.dg/specs/opt7_pkg.ads: New helper. + * gnat.dg/specs/opt7_pkg.adb: Likewise. + +2025-06-04 Harald Anlauf <anlauf@gmx.de> + + Backported from master: + 2025-06-03 Harald Anlauf <anlauf@gmx.de> + + PR fortran/99838 + * gfortran.dg/coarray_data_2.f90: New test. + +2025-06-03 Harald Anlauf <anlauf@gmx.de> + + Backported from master: + 2025-05-30 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102599 + PR fortran/114022 + * gfortran.dg/inquiry_type_ref_8.f90: New test. + +2025-06-03 Harald Anlauf <anlauf@gmx.de> + + Backported from master: + 2025-05-27 Harald Anlauf <anlauf@gmx.de> + + PR fortran/101735 + * gfortran.dg/inquiry_type_ref_7.f90: New test. + +2025-06-02 Jason Merrill <jason@redhat.com> + + PR c++/120123 + * g++.dg/cpp2a/concepts-lambda24.C: New test. + +2025-06-02 Jakub Jelinek <jakub@redhat.com> + + Backported from master: + 2025-05-10 Jakub Jelinek <jakub@redhat.com> + + PR fortran/120193 + * gfortran.dg/guality/pr120193.f90: New test. + +2025-06-02 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + Backported from master: + 2025-06-01 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR libfortran/119856 + * gfortran.dg/pr119856.f90: New test. + +2025-06-02 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + Backported from master: + 2025-05-28 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/119856 + * gfortran.dg/comma_format_extension_1.f: Update dg-options to + "-std=legacy". + * gfortran.dg/comma_format_extension_3.f: Likewise. + * gfortran.dg/continuation_13.f90: Likewise. + 2025-05-31 Jerry DeLisle <jvdelisle@gcc.gnu.org> Backported from master: diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp index 621a45d..1684f7a 100644 --- a/gcc/testsuite/ChangeLog.omp +++ b/gcc/testsuite/ChangeLog.omp @@ -1,3 +1,27 @@ +2025-06-06 Tobias Burnus <tburnus@baylibre.com> + + Backported from master: + 2025-06-06 Tobias Burnus <tburnus@baylibre.com> + Sandra Loosemore <sloosemore@baylibre.com> + + * c-c++-common/gomp/omp_get_num_devices_initial_device-2.c: New test. + * c-c++-common/gomp/omp_get_num_devices_initial_device.c: New test. + * gfortran.dg/gomp/omp_get_num_devices_initial_device-2.f90: New test. + * gfortran.dg/gomp/omp_get_num_devices_initial_device.f90: New test. + +2025-06-05 Sandra Loosemore <sloosemore@baylibre.com> + + Backported from master: + 2025-06-02 Sandra Loosemore <sloosemore@baylibre.com> + + * c-c++-common/gomp/declare-variant-2.c: Update expected output. + * c-c++-common/gomp/metadirective-condition-constexpr.c: New. + * c-c++-common/gomp/metadirective-condition.c: New. + * c-c++-common/gomp/metadirective-error-recovery.c: Update expected + output. + * g++.dg/gomp/metadirective-condition-class.C: New. + * g++.dg/gomp/metadirective-condition-template.C: New. + 2025-05-22 Thomas Schwinge <tschwinge@baylibre.com> Backported from master: diff --git a/gcc/testsuite/c-c++-common/gomp/omp_get_num_devices_initial_device-2.c b/gcc/testsuite/c-c++-common/gomp/omp_get_num_devices_initial_device-2.c new file mode 100644 index 0000000..891f5cf --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/omp_get_num_devices_initial_device-2.c @@ -0,0 +1,29 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-O1 -fdump-tree-optimized -fno-builtin-omp_get_num_devices -fno-builtin-omp_get_initial_device" } */ + +#ifdef __cplusplus +extern "C" { +#endif +extern int omp_get_initial_device (); +extern int omp_get_num_devices (); +#ifdef __cplusplus +} +#endif + +int f() +{ +/* The following assumes that omp_get_initial_device () will not return + omp_initial_device (== -1), which is also permitted since OpenMP 6.0. */ + if (omp_get_initial_device () != omp_get_num_devices ()) __builtin_abort (); + + if (omp_get_num_devices () != omp_get_num_devices ()) __builtin_abort (); + + if (omp_get_initial_device () != omp_get_initial_device ()) __builtin_abort (); + + return omp_get_num_devices (); +} + +/* { dg-final { scan-tree-dump-times "abort" 3 "optimized" } } */ + +/* { dg-final { scan-tree-dump-times "omp_get_num_devices" 4 "optimized" } } */ +/* { dg-final { scan-tree-dump-times "omp_get_initial_device" 3 "optimized" } } */ diff --git a/gcc/testsuite/c-c++-common/gomp/omp_get_num_devices_initial_device.c b/gcc/testsuite/c-c++-common/gomp/omp_get_num_devices_initial_device.c new file mode 100644 index 0000000..4b17143 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/omp_get_num_devices_initial_device.c @@ -0,0 +1,32 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-O1 -fdump-tree-optimized" } */ + +#ifdef __cplusplus +extern "C" { +#endif +extern int omp_get_initial_device (); +extern int omp_get_num_devices (); +#ifdef __cplusplus +} +#endif + +int f() +{ +/* The following assumes that omp_get_initial_device () will not return + omp_initial_device (== -1), which is also permitted since OpenMP 6.0. */ + if (omp_get_initial_device () != omp_get_num_devices ()) __builtin_abort (); + + if (omp_get_num_devices () != omp_get_num_devices ()) __builtin_abort (); + + if (omp_get_initial_device () != omp_get_initial_device ()) __builtin_abort (); + + return omp_get_num_devices (); +} + +/* { dg-final { scan-tree-dump-not "abort" "optimized" } } */ + +/* { dg-final { scan-tree-dump-not "omp_get_num_devices;" "optimized" { target { ! offloading_enabled } } } } */ +/* { dg-final { scan-tree-dump "return 0;" "optimized" { target { ! offloading_enabled } } } } */ + +/* { dg-final { scan-tree-dump-times "omp_get_num_devices;" 1 "optimized" { target offloading_enabled } } } */ +/* { dg-final { scan-tree-dump "_1 = __builtin_omp_get_num_devices \\(\\);\[\\r\\n\]+\[ \]+return _1;" "optimized" { target offloading_enabled } } } */ diff --git a/gcc/testsuite/g++.dg/cpp2a/concepts-lambda24.C b/gcc/testsuite/g++.dg/cpp2a/concepts-lambda24.C new file mode 100644 index 0000000..28f56ca --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp2a/concepts-lambda24.C @@ -0,0 +1,13 @@ +// PR c++/120123 +// { dg-do compile { target c++20 } } + +struct H { + void member(int) {} + void call() { + [this]() { + [this](const auto& v) + requires requires { /*this->*/member(v); } + { return member(v); }(0); + }; + } +}; diff --git a/gcc/testsuite/gcc.dg/torture/pr120182.c b/gcc/testsuite/gcc.dg/torture/pr120182.c new file mode 100644 index 0000000..5e2d171 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr120182.c @@ -0,0 +1,42 @@ +/* { dg-do run { target { { *-*-linux* *-*-gnu* *-*-uclinux* } && mmap } } } */ + +#include <unistd.h> +#include <stdlib.h> +#include <sys/mman.h> + +struct S +{ + struct S *next; +}; + +static void __attribute__((noipa)) +allocate(void *addr, unsigned long long size) +{ + void *ptr = mmap((void *)addr, size, + PROT_READ | PROT_WRITE, + MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED_NOREPLACE, + -1, 0); + if(ptr != addr) + exit(0); +} + +int main (void) +{ + int size = 0x8000; + char *ptr = (char *)0x288000ull; + allocate((void *)ptr, size); + + struct S *s1 = (struct S *)ptr; + struct S *s2 = (struct S *)256; + for (int i = 0; i < 3; i++) + { + for(char *addr = (char *)s1; addr < (char *)s1 + sizeof(*s1); ++addr) + *addr = 0; + + if(s1->next) + s1->next = s1->next->next = s2; + else + s1->next = s2; + } + return 0; +} diff --git a/gcc/testsuite/gcc.dg/torture/pr120341-1.c b/gcc/testsuite/gcc.dg/torture/pr120341-1.c new file mode 100644 index 0000000..e23185b --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr120341-1.c @@ -0,0 +1,11 @@ +/* { dg-do run } */ +/* { dg-additional-options "-fallow-store-data-races" } */ + +char a, *b; +int main() +{ + b = "0"; + if (a) + b[0]++; + return 0; +} diff --git a/gcc/testsuite/gcc.dg/torture/pr120341-2.c b/gcc/testsuite/gcc.dg/torture/pr120341-2.c new file mode 100644 index 0000000..7bcc96f --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr120341-2.c @@ -0,0 +1,13 @@ +/* { dg-do run } */ +/* { dg-additional-options "-fallow-store-data-races" } */ + +char a, *b; +int main() +{ + while (a) + { + b = "0"; + b[0]++; + } + return 0; +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-7.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-7.c index d84acee..59891f2 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-7.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-7.c @@ -11,7 +11,7 @@ to change decisions in switch expansion which in turn can expose new jump threading opportunities. Skip the later tests on aarch64. */ /* { dg-final { scan-tree-dump-not "Jumps threaded" "dom3" { target { ! aarch64*-*-* } } } } */ -/* { dg-final { scan-tree-dump "Jumps threaded: 9" "thread2" { target { ! aarch64*-*-* } } } } */ +/* { dg-final { scan-tree-dump "Jumps threaded: 10" "thread2" { target { ! aarch64*-*-* } } } } */ /* { dg-final { scan-tree-dump "Jumps threaded: 17" "thread2" { target { aarch64*-*-* } } } } */ enum STATE { diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-thread-23.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-thread-23.c new file mode 100644 index 0000000..930360a --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-thread-23.c @@ -0,0 +1,19 @@ +/* PR120003 */ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-cddce3-details" } */ + +extern _Bool g(int); + +_Bool f() +{ + _Bool retval = 0; + for(int i=0; i<1000000; ++i) + retval = retval || g(i); + return retval; +} + +/* Jump threading after loop optimization should get the counting loop + separated from the loop until retval is true and CD-DCE elide it. + It's difficult to check for the fact that a true retval terminates + the loop so check CD-DCE eliminates one loop instead. */ +/* { dg-final { scan-tree-dump "fix_loop_structure: removing loop" "cddce3" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/bb-slp-pr119960-1.c b/gcc/testsuite/gcc.dg/vect/bb-slp-pr119960-1.c new file mode 100644 index 0000000..955fc7e --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/bb-slp-pr119960-1.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-require-effective-target vect_double } */ + +double foo (double *dst, double *src, int b) +{ + double y = src[1]; + if (b) + { + dst[0] = src[0]; + dst[1] = y; + } + return y; +} + +/* { dg-final { scan-tree-dump "optimized: basic block part vectorized" "slp2" { target vect_double } } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-early-break_136-pr120357.c b/gcc/testsuite/gcc.dg/vect/vect-early-break_136-pr120357.c new file mode 100644 index 0000000..8a51cfc --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/vect-early-break_136-pr120357.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ +/* { dg-add-options vect_early_break } */ +/* { dg-additional-options "-O3" } */ + +char a; +unsigned long long t[2][22]; +int u[22]; +void f(void) +{ + for (int v = 0; v < 22; v++) + for (_Bool w = 0; w < (u[v] < 0) + 1; w = 1) + a *= 0 != t[w][v]; +} diff --git a/gcc/testsuite/gcc.target/i386/vect-epilogues-1.c b/gcc/testsuite/gcc.target/i386/vect-epilogues-1.c new file mode 100644 index 0000000..a7f5f12 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/vect-epilogues-1.c @@ -0,0 +1,14 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -mavx2 -mno-avx512f -mtune=generic -fdump-tree-vect-optimized" } */ + +int test (signed char *data, int n) +{ + int sum = 0; + for (int i = 0; i < n; ++i) + sum += data[i]; + return sum; +} + +/* { dg-final { scan-tree-dump "loop vectorized using 32 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump "loop vectorized using 16 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump "loop vectorized using 8 byte vectors" "vect" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/vect-epilogues-2.c b/gcc/testsuite/gcc.target/i386/vect-epilogues-2.c new file mode 100644 index 0000000..d6c06ed --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/vect-epilogues-2.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -mavx512bw -mtune=generic -fdump-tree-vect-optimized" } */ + +int test (signed char *data, int n) +{ + int sum = 0; + for (int i = 0; i < n; ++i) + sum += data[i]; + return sum; +} + +/* { dg-final { scan-tree-dump "loop vectorized using 64 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump "loop vectorized using 32 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump-not "loop vectorized using 16 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump-not "loop vectorized using 8 byte vectors" "vect" } } */ diff --git a/gcc/testsuite/gcc.target/i386/vect-epilogues-3.c b/gcc/testsuite/gcc.target/i386/vect-epilogues-3.c new file mode 100644 index 0000000..0ee610f --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/vect-epilogues-3.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -mavx512bw -mtune=znver4 -fdump-tree-vect-optimized" } */ + +int test (signed char *data, int n) +{ + int sum = 0; + for (int i = 0; i < n; ++i) + sum += data[i]; + return sum; +} + +/* { dg-final { scan-tree-dump "loop vectorized using 64 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump "loop vectorized using 32 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump "loop vectorized using 16 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump "loop vectorized using 8 byte vectors" "vect" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/vect-epilogues-4.c b/gcc/testsuite/gcc.target/i386/vect-epilogues-4.c new file mode 100644 index 0000000..498db6b --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/vect-epilogues-4.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -mavx512bw -mtune=generic --param vect-partial-vector-usage=1 -fdump-tree-vect-optimized" } */ + +int test (signed char *data, int n) +{ + int sum = 0; + for (int i = 0; i < n; ++i) + sum += data[i]; + return sum; +} + +/* { dg-final { scan-tree-dump-times "loop vectorized using 64 byte vectors" 2 "vect" } } */ +/* { dg-final { scan-tree-dump-not "loop vectorized using 32 byte vectors" "vect" } } */ diff --git a/gcc/testsuite/gcc.target/i386/vect-epilogues-5.c b/gcc/testsuite/gcc.target/i386/vect-epilogues-5.c new file mode 100644 index 0000000..6772cab --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/vect-epilogues-5.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -mavx512bw -mtune=znver4 --param vect-partial-vector-usage=1 -fdump-tree-vect-optimized" } */ + +int test (signed char *data, int n) +{ + int sum = 0; + for (int i = 0; i < n; ++i) + sum += data[i]; + return sum; +} + +/* { dg-final { scan-tree-dump-times "loop vectorized using 64 byte vectors" 2 "vect" } } */ +/* { dg-final { scan-tree-dump-not "loop vectorized using 32 byte vectors" "vect" } } */ diff --git a/gcc/testsuite/gfortran.dg/coarray_data_2.f90 b/gcc/testsuite/gfortran.dg/coarray_data_2.f90 new file mode 100644 index 0000000..bda57f3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_data_2.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! { dg-additional-options "-fcoarray=lib -Warray-temporaries" } +! +! PR fortran/99838 - ICE due to missing locus with data statement for coarray +! +! Contributed by Gerhard Steinmetz + +program p + type t + integer :: a + end type + type(t) :: x(3)[*] + data x%a /1, 2, 3/ ! { dg-warning "Creating array temporary" } +end diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_get_num_devices_initial_device-2.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_get_num_devices_initial_device-2.f90 new file mode 100644 index 0000000..18613d4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/omp_get_num_devices_initial_device-2.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-additional-options "-O1 -fdump-tree-optimized -fno-builtin-omp_get_num_devices -fno-builtin-omp_get_initial_device" } +integer function f() result(ret) + interface + integer function omp_get_initial_device (); end + integer function omp_get_num_devices (); end + end interface + + if (omp_get_initial_device () /= omp_get_num_devices ()) error stop + + if (omp_get_num_devices () /= omp_get_num_devices ()) error stop + + if (omp_get_initial_device () /= omp_get_initial_device ()) error stop + + ret = omp_get_num_devices () +end + +! { dg-final { scan-tree-dump-times "error_stop" 3 "optimized" } } + +! { dg-final { scan-tree-dump-times "omp_get_num_devices" 4 "optimized" } } +! { dg-final { scan-tree-dump-times "omp_get_initial_device" 3 "optimized" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_get_num_devices_initial_device.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_get_num_devices_initial_device.f90 new file mode 100644 index 0000000..5409f12 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/omp_get_num_devices_initial_device.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! { dg-additional-options "-O1 -fdump-tree-optimized" } +integer function f() result(ret) + interface + integer function omp_get_initial_device (); end + integer function omp_get_num_devices (); end + end interface + + if (omp_get_initial_device () /= omp_get_num_devices ()) error stop + + if (omp_get_num_devices () /= omp_get_num_devices ()) error stop + + if (omp_get_initial_device () /= omp_get_initial_device ()) error stop + + ret = omp_get_num_devices () +end + +! { dg-final { scan-tree-dump-not "error_stop" "optimized" } } + +! { dg-final { scan-tree-dump-not "omp_get_num_devices;" "optimized" { target { ! offloading_enabled } } } } +! { dg-final { scan-tree-dump "return 0;" "optimized" { target { ! offloading_enabled } } } } + +! { dg-final { scan-tree-dump-times "omp_get_num_devices;" 1 "optimized" { target offloading_enabled } } } +! { dg-final { scan-tree-dump "_1 = __builtin_omp_get_num_devices \\(\\);\[\\r\\n\]+\[ \]+return _1;" "optimized" { target offloading_enabled } } } diff --git a/gcc/testsuite/gfortran.dg/guality/pr120193.f90 b/gcc/testsuite/gfortran.dg/guality/pr120193.f90 new file mode 100644 index 0000000..e65febf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/guality/pr120193.f90 @@ -0,0 +1,26 @@ +! PR fortran/120193 +! { dg-do run } +! { dg-options "-g -funsigned" } +! { dg-skip-if "" { *-*-* } { "*" } { "-O0" } } + +program foo + unsigned(kind=1) :: a(2), e + unsigned(kind=2) :: b(2), f + unsigned(kind=4) :: c(2), g + unsigned(kind=8) :: d(2), h + character(kind=1, len=1) :: i(2), j + character(kind=4, len=1) :: k(2), l + a = 97u_1 ! { dg-final { gdb-test 24 "a" "d" } } + b = 97u_2 ! { dg-final { gdb-test 24 "b" "c" } } + c = 97u_4 ! { dg-final { gdb-test 24 "c" "b" } } + d = 97u_8 ! { dg-final { gdb-test 24 "d" "a" } } + e = 97u_1 ! { dg-final { gdb-test 24 "e" "97" } } + f = 97u_2 ! { dg-final { gdb-test 24 "f" "97" } } + g = 97u_4 ! { dg-final { gdb-test 24 "g" "97" } } + h = 97u_8 ! { dg-final { gdb-test 24 "h" "97" } } + i = 'a' ! { dg-final { gdb-test 24 "i" "('a', 'a')" } } + j = 'b' ! { dg-final { gdb-test 24 "j" "'b'" } } + k = 'c' + l = 'd' + print *, a +end program diff --git a/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90 b/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90 new file mode 100644 index 0000000..534225a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90 @@ -0,0 +1,62 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } +! +! PR fortran/101735 - substrings and parsing of type parameter inquiries + +program p + implicit none + integer, parameter :: ck = 4 + character(len=5) :: str = "" + character(len=5) :: str2(4) + character(len=5,kind=ck) :: str4 = ck_"" + type t + character(len=5) :: str(4) + end type t + type(t) :: var + integer :: x, y + + integer, parameter :: i1 = kind (str(1:3)) + integer, parameter :: j1 = str (1:3) % kind + integer, parameter :: k1 = (str(1:3) % kind) + integer, parameter :: kk = str (1:3) % kind % kind + + integer, parameter :: i4 = kind (str4(1:3)) + integer, parameter :: j4 = str4 (1:3) % kind + integer, parameter :: ll = str4 (1:3) % len + + integer, parameter :: i2 = len (str(1:3)) + integer, parameter :: j2 = str (1:3) % len + integer, parameter :: k2 = (str(1:3) % len) + integer, parameter :: lk = str (1:3) % len % kind + + integer, parameter :: l4 = str2 (:) (2:3) % len + integer, parameter :: l5 = var % str (:) (2:4) % len + integer, parameter :: k4 = str2 (:) (2:3) % kind + integer, parameter :: k5 = var % str (:) (2:4) % kind + integer, parameter :: k6 = str2 (:) (2:3) % len % kind + integer, parameter :: k7 = var % str (:) (2:4) % len % kind + + if (i1 /= 1) stop 1 + if (j1 /= 1) stop 2 + if (k1 /= 1) stop 3 + + if (i4 /= ck) stop 4 + if (j4 /= ck) stop 5 + if (ll /= 3) stop 6 + + if (kk /= 4) stop 7 + if (lk /= 4) stop 8 + + if (i2 /= 3) stop 9 + if (j2 /= 3) stop 10 + if (k2 /= 3) stop 11 + + if (l4 /= 2) stop 12 + if (l5 /= 3) stop 13 + if (k4 /= 1) stop 14 + if (k5 /= 1) stop 15 + if (k6 /= 4) stop 16 + if (k7 /= 4) stop 17 +end + +! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } } diff --git a/gcc/testsuite/gfortran.dg/inquiry_type_ref_8.f90 b/gcc/testsuite/gfortran.dg/inquiry_type_ref_8.f90 new file mode 100644 index 0000000..70ef621 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/inquiry_type_ref_8.f90 @@ -0,0 +1,214 @@ +! { dg-do compile } +! { dg-additional-options "-O0 -fdump-tree-original -std=f2018" } +! +! PR fortran/102599 - type parameter inquiries and constant complex arrays +! PR fortran/114022 - likewise +! +! Everything below shall be simplified at compile time. + +module mod + implicit none + public :: wp, c0, z0, y, test1 + private + + integer :: j + integer, parameter :: n = 5 + integer, parameter :: wp = 8 + type :: cx + real(wp) :: re + real(wp) :: im + end type cx + type(cx), parameter :: c0(*) = [(cx (j,-j), j=1,n)] + complex(wp), parameter :: z0(*) = [(cmplx(j,-j,wp),j=1,n)] + + type :: my_type + complex(wp) :: z(n) = z0 + type(cx) :: c(n) = c0 + end type my_type + type(my_type), parameter :: y = my_type() + +contains + + ! Check simplification for inquiries of host-associated variables + subroutine test1 () + ! Inquiries and full arrays + real(wp), parameter :: r0(*) = real (z0) + real(wp), parameter :: i0(*) = aimag (z0) + real(wp), parameter :: r1(*) = c0 % re + real(wp), parameter :: i1(*) = c0 % im + real(wp), parameter :: r2(*) = z0 % re + real(wp), parameter :: i2(*) = z0 % im + real(wp), parameter :: r3(*) = y % c % re + real(wp), parameter :: i3(*) = y % c % im + real(wp), parameter :: r4(*) = y % z % re + real(wp), parameter :: i4(*) = y % z % im + + logical, parameter :: l1 = all (r1 == r0) + logical, parameter :: l2 = all (i1 == i0) + logical, parameter :: l3 = all (r1 == r2) + logical, parameter :: l4 = all (i1 == i2) + logical, parameter :: l5 = all (r3 == r4) + logical, parameter :: l6 = all (i3 == i4) + logical, parameter :: l7 = all (r1 == r3) + logical, parameter :: l8 = all (i1 == i3) + + ! Inquiries and array sections + real(wp), parameter :: p0(*) = real (z0(::2)) + real(wp), parameter :: q0(*) = aimag (z0(::2)) + real(wp), parameter :: p1(*) = c0(::2) % re + real(wp), parameter :: q1(*) = c0(::2) % im + real(wp), parameter :: p2(*) = z0(::2) % re + real(wp), parameter :: q2(*) = z0(::2) % im + real(wp), parameter :: p3(*) = y % c(::2) % re + real(wp), parameter :: q3(*) = y % c(::2) % im + real(wp), parameter :: p4(*) = y % z(::2) % re + real(wp), parameter :: q4(*) = y % z(::2) % im + + logical, parameter :: m1 = all (p1 == p0) + logical, parameter :: m2 = all (q1 == q0) + logical, parameter :: m3 = all (p1 == p2) + logical, parameter :: m4 = all (q1 == q2) + logical, parameter :: m5 = all (p3 == p4) + logical, parameter :: m6 = all (q3 == q4) + logical, parameter :: m7 = all (p1 == p3) + logical, parameter :: m8 = all (q1 == q3) + + ! Inquiries and vector subscripts + real(wp), parameter :: v0(*) = real (z0([3,2])) + real(wp), parameter :: w0(*) = aimag (z0([3,2])) + real(wp), parameter :: v1(*) = c0([3,2]) % re + real(wp), parameter :: w1(*) = c0([3,2]) % im + real(wp), parameter :: v2(*) = z0([3,2]) % re + real(wp), parameter :: w2(*) = z0([3,2]) % im + real(wp), parameter :: v3(*) = y % c([3,2]) % re + real(wp), parameter :: w3(*) = y % c([3,2]) % im + real(wp), parameter :: v4(*) = y % z([3,2]) % re + real(wp), parameter :: w4(*) = y % z([3,2]) % im + + logical, parameter :: o1 = all (v1 == v0) + logical, parameter :: o2 = all (w1 == w0) + logical, parameter :: o3 = all (v1 == v2) + logical, parameter :: o4 = all (w1 == w2) + logical, parameter :: o5 = all (v3 == v4) + logical, parameter :: o6 = all (w3 == w4) + logical, parameter :: o7 = all (v1 == v3) + logical, parameter :: o8 = all (w1 == w3) + + ! Miscellaneous + complex(wp), parameter :: x(-1:*) = cmplx (r1,i1,kind=wp) + real(x%re%kind), parameter :: r(*) = x % re + real(x%im%kind), parameter :: i(*) = x % im + real(x%re%kind), parameter :: s(*) = [ x(:) % re ] + real(x%im%kind), parameter :: t(*) = [ x(:) % im ] + + integer, parameter :: kr = x % re % kind + integer, parameter :: ki = x % im % kind + integer, parameter :: kx = x % kind + + if (kr /= wp .or. ki /= wp .or. kx /= wp) stop 1 + if (any (r /= r1)) stop 2 + if (any (i /= i1)) stop 3 + if (any (s /= r1)) stop 4 + if (any (t /= i1)) stop 5 + + if (.not. all ([l1,l2,l3,l4,l5,l6,l7,l8])) stop 6 + if (.not. all ([m1,m2,m3,m4,m5,m6,m7,m8])) stop 7 + if (.not. all ([o1,o2,o3,o4,o5,o6,o7,o8])) stop 8 + end subroutine test1 +end + +program p + use mod, only: wp, c0, z0, y, test1 + implicit none + call test1 () + call test2 () +contains + ! Check simplification for inquiries of use-associated variables + subroutine test2 () + ! Inquiries and full arrays + real(wp), parameter :: r0(*) = real (z0) + real(wp), parameter :: i0(*) = aimag (z0) + real(wp), parameter :: r1(*) = c0 % re + real(wp), parameter :: i1(*) = c0 % im + real(wp), parameter :: r2(*) = z0 % re + real(wp), parameter :: i2(*) = z0 % im + real(wp), parameter :: r3(*) = y % c % re + real(wp), parameter :: i3(*) = y % c % im + real(wp), parameter :: r4(*) = y % z % re + real(wp), parameter :: i4(*) = y % z % im + + logical, parameter :: l1 = all (r1 == r0) + logical, parameter :: l2 = all (i1 == i0) + logical, parameter :: l3 = all (r1 == r2) + logical, parameter :: l4 = all (i1 == i2) + logical, parameter :: l5 = all (r3 == r4) + logical, parameter :: l6 = all (i3 == i4) + logical, parameter :: l7 = all (r1 == r3) + logical, parameter :: l8 = all (i1 == i3) + + ! Inquiries and array sections + real(wp), parameter :: p0(*) = real (z0(::2)) + real(wp), parameter :: q0(*) = aimag (z0(::2)) + real(wp), parameter :: p1(*) = c0(::2) % re + real(wp), parameter :: q1(*) = c0(::2) % im + real(wp), parameter :: p2(*) = z0(::2) % re + real(wp), parameter :: q2(*) = z0(::2) % im + real(wp), parameter :: p3(*) = y % c(::2) % re + real(wp), parameter :: q3(*) = y % c(::2) % im + real(wp), parameter :: p4(*) = y % z(::2) % re + real(wp), parameter :: q4(*) = y % z(::2) % im + + logical, parameter :: m1 = all (p1 == p0) + logical, parameter :: m2 = all (q1 == q0) + logical, parameter :: m3 = all (p1 == p2) + logical, parameter :: m4 = all (q1 == q2) + logical, parameter :: m5 = all (p3 == p4) + logical, parameter :: m6 = all (q3 == q4) + logical, parameter :: m7 = all (p1 == p3) + logical, parameter :: m8 = all (q1 == q3) + + ! Inquiries and vector subscripts + real(wp), parameter :: v0(*) = real (z0([3,2])) + real(wp), parameter :: w0(*) = aimag (z0([3,2])) + real(wp), parameter :: v1(*) = c0([3,2]) % re + real(wp), parameter :: w1(*) = c0([3,2]) % im + real(wp), parameter :: v2(*) = z0([3,2]) % re + real(wp), parameter :: w2(*) = z0([3,2]) % im + real(wp), parameter :: v3(*) = y % c([3,2]) % re + real(wp), parameter :: w3(*) = y % c([3,2]) % im + real(wp), parameter :: v4(*) = y % z([3,2]) % re + real(wp), parameter :: w4(*) = y % z([3,2]) % im + + logical, parameter :: o1 = all (v1 == v0) + logical, parameter :: o2 = all (w1 == w0) + logical, parameter :: o3 = all (v1 == v2) + logical, parameter :: o4 = all (w1 == w2) + logical, parameter :: o5 = all (v3 == v4) + logical, parameter :: o6 = all (w3 == w4) + logical, parameter :: o7 = all (v1 == v3) + logical, parameter :: o8 = all (w1 == w3) + + ! Miscellaneous + complex(wp), parameter :: x(-1:*) = cmplx (r1,i1,kind=wp) + real(x%re%kind), parameter :: r(*) = x % re + real(x%im%kind), parameter :: i(*) = x % im + real(x%re%kind), parameter :: s(*) = [ x(:) % re ] + real(x%im%kind), parameter :: t(*) = [ x(:) % im ] + + integer, parameter :: kr = x % re % kind + integer, parameter :: ki = x % im % kind + integer, parameter :: kx = x % kind + + if (kr /= wp .or. ki /= wp .or. kx /= wp) stop 11 + if (any (r /= r1)) stop 12 + if (any (i /= i1)) stop 13 + if (any (s /= r1)) stop 14 + if (any (t /= i1)) stop 15 + + if (.not. all ([l1,l2,l3,l4,l5,l6,l7,l8])) stop 16 + if (.not. all ([m1,m2,m3,m4,m5,m6,m7,m8])) stop 17 + if (.not. all ([o1,o2,o3,o4,o5,o6,o7,o8])) stop 18 + end subroutine test2 +end + +! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } } diff --git a/gcc/testsuite/gnat.dg/specs/opt7.ads b/gcc/testsuite/gnat.dg/specs/opt7.ads new file mode 100644 index 0000000..ee151f0 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/opt7.ads @@ -0,0 +1,15 @@ +-- { dg-do compile } +-- { dg-options "-O2 -gnatn" } + +with Opt7_Pkg; use Opt7_Pkg; + +package Opt7 is + + type Rec is record + E : Enum; + end record; + + function Image (R : Rec) return String is + (if R.E = A then Image (R.E) else ""); + +end Opt7; diff --git a/gcc/testsuite/gnat.dg/specs/opt7_pkg.adb b/gcc/testsuite/gnat.dg/specs/opt7_pkg.adb new file mode 100644 index 0000000..1c9d79b --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/opt7_pkg.adb @@ -0,0 +1,15 @@ +package body Opt7_Pkg is + + type Constant_String_Access is access constant String; + + type Enum_Name is array (Enum) of Constant_String_Access; + + Enum_Name_Table : constant Enum_Name := + (A => new String'("A"), B => new String'("B")); + + function Image (E : Enum) return String is + begin + return Enum_Name_Table (E).all; + end Image; + +end Opt7_Pkg; diff --git a/gcc/testsuite/gnat.dg/specs/opt7_pkg.ads b/gcc/testsuite/gnat.dg/specs/opt7_pkg.ads new file mode 100644 index 0000000..2dd271b --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/opt7_pkg.ads @@ -0,0 +1,9 @@ +-- { dg-excess-errors "no code generated" } + +package Opt7_Pkg is + + type Enum is (A, B); + + function Image (E : Enum) return String with Inline; + +end Opt7_Pkg; diff --git a/gcc/tree-ssa-loop-im.cc b/gcc/tree-ssa-loop-im.cc index 225964c..71a46f7 100644 --- a/gcc/tree-ssa-loop-im.cc +++ b/gcc/tree-ssa-loop-im.cc @@ -3293,7 +3293,8 @@ can_sm_ref_p (class loop *loop, im_mem_ref *ref) explicitly. */ base = get_base_address (ref->mem.ref); if ((tree_could_trap_p (ref->mem.ref) - || (DECL_P (base) && TREE_READONLY (base))) + || (DECL_P (base) && TREE_READONLY (base)) + || TREE_CODE (base) == STRING_CST) /* ??? We can at least use false here, allowing loads? We are forcing conditional stores if the ref is not always stored to later anyway. So this would only guard diff --git a/gcc/tree-ssa-phiopt.cc b/gcc/tree-ssa-phiopt.cc index 7f3390b..aaebae6 100644 --- a/gcc/tree-ssa-phiopt.cc +++ b/gcc/tree-ssa-phiopt.cc @@ -3565,8 +3565,9 @@ cond_store_replacement (basic_block middle_bb, basic_block join_bb, /* tree_could_trap_p is a predicate for rvalues, so check for readonly memory explicitly. */ || ((base = get_base_address (lhs)) - && DECL_P (base) - && TREE_READONLY (base))) + && ((DECL_P (base) + && TREE_READONLY (base)) + || TREE_CODE (base) == STRING_CST))) return false; } diff --git a/gcc/tree-ssa-threadbackward.cc b/gcc/tree-ssa-threadbackward.cc index d0b74b2..3adb83e 100644 --- a/gcc/tree-ssa-threadbackward.cc +++ b/gcc/tree-ssa-threadbackward.cc @@ -349,9 +349,6 @@ back_threader::find_paths_to_names (basic_block bb, bitmap interesting, unsigned overall_paths, back_threader_profitability &profit) { - if (m_visited_bbs.add (bb)) - return; - m_path.safe_push (bb); // Try to resolve the path without looking back. Avoid resolving paths @@ -377,7 +374,8 @@ back_threader::find_paths_to_names (basic_block bb, bitmap interesting, // Continue looking for ways to extend the path but limit the // search space along a branch else if ((overall_paths = overall_paths * EDGE_COUNT (bb->preds)) - <= (unsigned)param_max_jump_thread_paths) + <= (unsigned)param_max_jump_thread_paths + && !m_visited_bbs.add (bb)) { // For further greedy searching we want to remove interesting // names defined in BB but add ones on the PHI edges for the @@ -489,6 +487,7 @@ back_threader::find_paths_to_names (basic_block bb, bitmap interesting, backtracking we have to restore it. */ for (int j : new_imports) bitmap_clear_bit (m_imports, j); + m_visited_bbs.remove (bb); } else if (dump_file && (dump_flags & TDF_DETAILS)) fprintf (dump_file, " FAIL: Search space limit %d reached.\n", @@ -496,7 +495,6 @@ back_threader::find_paths_to_names (basic_block bb, bitmap interesting, // Reset things to their original state. m_path.pop (); - m_visited_bbs.remove (bb); } // Search backwards from BB looking for paths where the final diff --git a/gcc/tree-vect-data-refs.cc b/gcc/tree-vect-data-refs.cc index d6cd93a..aaeb522 100644 --- a/gcc/tree-vect-data-refs.cc +++ b/gcc/tree-vect-data-refs.cc @@ -7165,7 +7165,8 @@ vect_can_force_dr_alignment_p (const_tree decl, poly_uint64 alignment) return false; if (decl_in_symtab_p (decl) - && !symtab_node::get (decl)->can_increase_alignment_p ()) + && (!symtab_node::get (decl) + || !symtab_node::get (decl)->can_increase_alignment_p ())) return false; if (TREE_STATIC (decl)) diff --git a/gcc/tree-vect-loop.cc b/gcc/tree-vect-loop.cc index 2d35fa1..c824b5a 100644 --- a/gcc/tree-vect-loop.cc +++ b/gcc/tree-vect-loop.cc @@ -6189,7 +6189,8 @@ vect_create_epilog_for_reduction (loop_vec_info loop_vinfo, /* Create an induction variable. */ gimple_stmt_iterator incr_gsi; bool insert_after; - vect_iv_increment_position (loop_exit, &incr_gsi, &insert_after); + vect_iv_increment_position (LOOP_VINFO_IV_EXIT (loop_vinfo), + &incr_gsi, &insert_after); create_iv (series_vect, PLUS_EXPR, vec_step, NULL_TREE, loop, &incr_gsi, insert_after, &indx_before_incr, &indx_after_incr); diff --git a/gcc/tree-vect-slp.cc b/gcc/tree-vect-slp.cc index 958f000..f5286e6 100644 --- a/gcc/tree-vect-slp.cc +++ b/gcc/tree-vect-slp.cc @@ -2616,13 +2616,14 @@ out: if (oprnds_info[0]->def_stmts[0] && is_a<gassign *> (oprnds_info[0]->def_stmts[0]->stmt)) code = gimple_assign_rhs_code (oprnds_info[0]->def_stmts[0]->stmt); + basic_block bb = nullptr; for (unsigned j = 0; j < group_size; ++j) { FOR_EACH_VEC_ELT (oprnds_info, i, oprnd_info) { stmt_vec_info stmt_info = oprnd_info->def_stmts[j]; - if (!stmt_info || !stmt_info->stmt + if (!stmt_info || !is_a<gassign *> (stmt_info->stmt) || gimple_assign_rhs_code (stmt_info->stmt) != code || skip_args[i]) @@ -2630,6 +2631,14 @@ out: success = false; break; } + /* Avoid mixing lanes with defs in different basic-blocks. */ + if (!bb) + bb = gimple_bb (vect_orig_stmt (stmt_info)->stmt); + else if (gimple_bb (vect_orig_stmt (stmt_info)->stmt) != bb) + { + success = false; + break; + } bool exists; unsigned &stmt_idx @@ -7833,21 +7842,70 @@ vect_slp_analyze_node_operations_1 (vec_info *vinfo, slp_tree node, node, node_instance, cost_vec); } +static int +sort_ints (const void *a_, const void *b_) +{ + int a = *(const int *)a_; + int b = *(const int *)b_; + return a - b; +} + /* Verify if we can externalize a set of internal defs. */ static bool vect_slp_can_convert_to_external (const vec<stmt_vec_info> &stmts) { + /* Constant generation uses get_later_stmt which can only handle + defs from the same BB or a set of defs that can be ordered + with a dominance query. */ basic_block bb = NULL; + bool all_same = true; + auto_vec<int> bbs; + bbs.reserve_exact (stmts.length ()); for (stmt_vec_info stmt : stmts) - if (!stmt) - return false; - /* Constant generation uses get_later_stmt which can only handle - defs from the same BB. */ - else if (!bb) - bb = gimple_bb (stmt->stmt); - else if (gimple_bb (stmt->stmt) != bb) + { + if (!stmt) + return false; + else if (!bb) + bb = gimple_bb (stmt->stmt); + else if (gimple_bb (stmt->stmt) != bb) + all_same = false; + bbs.quick_push (gimple_bb (stmt->stmt)->index); + } + if (all_same) + return true; + + /* Produce a vector of unique BB indexes for the defs. */ + bbs.qsort (sort_ints); + unsigned i, j; + for (i = 1, j = 1; i < bbs.length (); ++i) + if (bbs[i] != bbs[j-1]) + bbs[j++] = bbs[i]; + gcc_assert (j >= 2); + bbs.truncate (j); + + if (bbs.length () == 2) + return (dominated_by_p (CDI_DOMINATORS, + BASIC_BLOCK_FOR_FN (cfun, bbs[0]), + BASIC_BLOCK_FOR_FN (cfun, bbs[1])) + || dominated_by_p (CDI_DOMINATORS, + BASIC_BLOCK_FOR_FN (cfun, bbs[1]), + BASIC_BLOCK_FOR_FN (cfun, bbs[0]))); + + /* ??? For more than two BBs we can sort the vector and verify the + result is a total order. But we can't use vec::qsort with a + compare function using a dominance query since there's no way to + signal failure and any fallback for an unordered pair would + fail qsort_chk later. + For now simply hope that ordering after BB index provides the + best candidate total order. If required we can implement our + own mergesort or export an entry without checking. */ + for (unsigned i = 1; i < bbs.length (); ++i) + if (!dominated_by_p (CDI_DOMINATORS, + BASIC_BLOCK_FOR_FN (cfun, bbs[i]), + BASIC_BLOCK_FOR_FN (cfun, bbs[i-1]))) return false; + return true; } @@ -11162,9 +11220,14 @@ vect_schedule_slp_node (vec_info *vinfo, == cycle_phi_info_type); gphi *phi = as_a <gphi *> (vect_find_last_scalar_stmt_in_slp (child)->stmt); - if (!last_stmt - || vect_stmt_dominates_stmt_p (last_stmt, phi)) + if (!last_stmt) last_stmt = phi; + else if (vect_stmt_dominates_stmt_p (last_stmt, phi)) + last_stmt = phi; + else if (vect_stmt_dominates_stmt_p (phi, last_stmt)) + ; + else + gcc_unreachable (); } /* We are emitting all vectorized stmts in the same place and the last one is the last. @@ -11175,9 +11238,14 @@ vect_schedule_slp_node (vec_info *vinfo, FOR_EACH_VEC_ELT (SLP_TREE_VEC_DEFS (child), j, vdef) { gimple *vstmt = SSA_NAME_DEF_STMT (vdef); - if (!last_stmt - || vect_stmt_dominates_stmt_p (last_stmt, vstmt)) + if (!last_stmt) + last_stmt = vstmt; + else if (vect_stmt_dominates_stmt_p (last_stmt, vstmt)) last_stmt = vstmt; + else if (vect_stmt_dominates_stmt_p (vstmt, last_stmt)) + ; + else + gcc_unreachable (); } } else if (!SLP_TREE_VECTYPE (child)) @@ -11190,9 +11258,14 @@ vect_schedule_slp_node (vec_info *vinfo, && !SSA_NAME_IS_DEFAULT_DEF (def)) { gimple *stmt = SSA_NAME_DEF_STMT (def); - if (!last_stmt - || vect_stmt_dominates_stmt_p (last_stmt, stmt)) + if (!last_stmt) + last_stmt = stmt; + else if (vect_stmt_dominates_stmt_p (last_stmt, stmt)) last_stmt = stmt; + else if (vect_stmt_dominates_stmt_p (stmt, last_stmt)) + ; + else + gcc_unreachable (); } } else @@ -11213,9 +11286,14 @@ vect_schedule_slp_node (vec_info *vinfo, && !SSA_NAME_IS_DEFAULT_DEF (vdef)) { gimple *vstmt = SSA_NAME_DEF_STMT (vdef); - if (!last_stmt - || vect_stmt_dominates_stmt_p (last_stmt, vstmt)) + if (!last_stmt) last_stmt = vstmt; + else if (vect_stmt_dominates_stmt_p (last_stmt, vstmt)) + last_stmt = vstmt; + else if (vect_stmt_dominates_stmt_p (vstmt, last_stmt)) + ; + else + gcc_unreachable (); } } } diff --git a/gcc/tree-vectorizer.h b/gcc/tree-vectorizer.h index 01d19c7..94cbfde6 100644 --- a/gcc/tree-vectorizer.h +++ b/gcc/tree-vectorizer.h @@ -1870,11 +1870,25 @@ vect_orig_stmt (stmt_vec_info stmt_info) inline stmt_vec_info get_later_stmt (stmt_vec_info stmt1_info, stmt_vec_info stmt2_info) { - if (gimple_uid (vect_orig_stmt (stmt1_info)->stmt) - > gimple_uid (vect_orig_stmt (stmt2_info)->stmt)) + gimple *stmt1 = vect_orig_stmt (stmt1_info)->stmt; + gimple *stmt2 = vect_orig_stmt (stmt2_info)->stmt; + if (gimple_bb (stmt1) == gimple_bb (stmt2)) + { + if (gimple_uid (stmt1) > gimple_uid (stmt2)) + return stmt1_info; + else + return stmt2_info; + } + /* ??? We should be really calling this function only with stmts + in the same BB but we can recover if there's a domination + relationship between them. */ + else if (dominated_by_p (CDI_DOMINATORS, + gimple_bb (stmt1), gimple_bb (stmt2))) return stmt1_info; - else + else if (dominated_by_p (CDI_DOMINATORS, + gimple_bb (stmt2), gimple_bb (stmt1))) return stmt2_info; + gcc_unreachable (); } /* If STMT_INFO has been replaced by a pattern statement, return the |