diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 13 | ||||
| -rw-r--r-- | gcc/fortran/dependency.cc | 6 | ||||
| -rw-r--r-- | gcc/fortran/openmp.cc | 3 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.cc | 24 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.cc | 29 |
5 files changed, 61 insertions, 14 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 792f3c7..7ca0cb0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2025-10-24 Harald Anlauf <anlauf@gmx.de> + + PR fortran/122386 + * dependency.cc (gfc_ref_needs_temporary_p): Revert r16-518. + * trans-intrinsic.cc (gfc_conv_intrinsic_transfer): Force temporary + for SOURCE not being a simply-contiguous array. + +2025-10-24 Paul-Antoine Arras <parras@baylibre.com> + + PR fortran/121452 + * openmp.cc (resolve_omp_do): Allow CONTINUE as end statement of a + perfectly nested loop. + 2025-10-21 Paul-Antoine Arras <parras@baylibre.com> PR c/120180 diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc index aa8a57a..57c0c49 100644 --- a/gcc/fortran/dependency.cc +++ b/gcc/fortran/dependency.cc @@ -944,12 +944,8 @@ gfc_ref_needs_temporary_p (gfc_ref *ref) types), not in characters. */ return subarray_p; - case REF_INQUIRY: - /* Within an array reference, inquiry references of complex - variables generally need a temporary. */ - return subarray_p; - case REF_COMPONENT: + case REF_INQUIRY: break; } diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 8cea724..357e6a7f 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -12150,7 +12150,8 @@ resolve_omp_do (gfc_code *code) name, i, &code->loc); goto fail; } - else if (next != do_code->block->next || next->next) + else if (next != do_code->block->next + || (next->next && next->next->op != EXEC_CONTINUE)) /* Imperfectly nested loop found. */ { /* Only diagnose violation of imperfect nesting constraints once. */ diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 21f256b..67b60c7 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -11344,21 +11344,33 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) int dim; gcc_assert (remap->u.ar.dimen == expr1->rank); + /* Always set dtype. */ + tree dtype = gfc_conv_descriptor_dtype (desc); + tmp = gfc_get_dtype (TREE_TYPE (desc)); + gfc_add_modify (&block, dtype, tmp); + + /* For unlimited polymorphic LHS use elem_len from RHS. */ + if (UNLIMITED_POLY (expr1) && expr2->ts.type != BT_CLASS) + { + tree elem_len; + tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&expr2->ts)); + elem_len = fold_convert (gfc_array_index_type, tmp); + elem_len = gfc_evaluate_now (elem_len, &block); + tmp = gfc_conv_descriptor_elem_len (desc); + gfc_add_modify (&block, tmp, + fold_convert (TREE_TYPE (tmp), elem_len)); + } + if (rank_remap) { /* Do rank remapping. We already have the RHS's descriptor converted in rse and now have to build the correct LHS descriptor for it. */ - tree dtype, data, span; + tree data, span; tree offs, stride; tree lbound, ubound; - /* Set dtype. */ - dtype = gfc_conv_descriptor_dtype (desc); - tmp = gfc_get_dtype (TREE_TYPE (desc)); - gfc_add_modify (&block, dtype, tmp); - /* Copy data pointer. */ data = gfc_conv_descriptor_data_get (rse.expr); gfc_conv_descriptor_data_set (&block, desc, data); diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index d1c2a80..89a03d8 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -2316,10 +2316,14 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg) int i; tree fncall0; gfc_array_spec *as; + gfc_symbol *sym = NULL; if (arg->ts.type == BT_CLASS) gfc_add_class_array_ref (arg); + if (arg->expr_type == EXPR_VARIABLE) + sym = arg->symtree->n.sym; + ss = gfc_walk_expr (arg); gcc_assert (ss != gfc_ss_terminator); gfc_init_se (&argse, NULL); @@ -2342,7 +2346,7 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg) fncall0 = build_call_expr_loc (input_location, gfor_fndecl_is_contiguous0, 1, desc); se->expr = fncall0; - se->expr = convert (logical_type_node, se->expr); + se->expr = convert (boolean_type_node, se->expr); } else { @@ -2374,6 +2378,22 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg) } se->expr = cond; } + + /* A pointer that does not have the CONTIGUOUS attribute needs to be checked + if it points to an array whose span differs from the element size. */ + if (as && sym && IS_POINTER(sym) && !sym->attr.contiguous) + { + tree span = gfc_conv_descriptor_span_get (desc); + tmp = fold_convert (TREE_TYPE (span), + gfc_conv_descriptor_elem_len (desc)); + cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + span, tmp); + se->expr = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, + boolean_type_node, cond, + convert (boolean_type_node, se->expr)); + } + + gfc_free_ss_chain (ss); } @@ -8728,13 +8748,18 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) } else { + bool simply_contiguous = gfc_is_simply_contiguous (arg->expr, + false, true); argse.want_pointer = 0; + /* A non-contiguous SOURCE needs packing. */ + if (!simply_contiguous) + argse.force_tmp = 1; gfc_conv_expr_descriptor (&argse, arg->expr); source = gfc_conv_descriptor_data_get (argse.expr); source_type = gfc_get_element_type (TREE_TYPE (argse.expr)); /* Repack the source if not simply contiguous. */ - if (!gfc_is_simply_contiguous (arg->expr, false, true)) + if (!simply_contiguous) { tmp = gfc_build_addr_expr (NULL_TREE, argse.expr); |