https://gcc.gnu.org/g:fc5a344ab5b2d47d193b4cd9e351984c5949e837
commit fc5a344ab5b2d47d193b4cd9e351984c5949e837
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Sat May 31 13:23:01 2025 +0200
Correction régression contiguous_15
Diff:
---
gcc/fortran/trans-array.cc | 20 +++++++-----------
gcc/fortran/trans-descriptor.cc | 46 +++++++++++++++++++++++++++--------------
gcc/fortran/trans-descriptor.h | 5 ++---
3 files changed, 40 insertions(+), 31 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c1f74e9fd1e2..3035545f889d 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8477,25 +8477,19 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
{
tmp = build_fold_indirect_ref_loc (input_location, desc);
- gfc_ss * ss = gfc_walk_expr (expr);
- if (!transposed_dims (ss))
+ if (!ctree)
{
- if (!ctree)
- gfc_conv_descriptor_data_set (&se->pre, tmp, ptr);
- }
- else if (!ctree)
- {
- /* The original descriptor has transposed dims so we can't reuse
- it directly; we have to create a new one. */
+ gfc_ss * ss = gfc_walk_expr (expr);
+
tree old_desc = tmp;
tree new_desc = gfc_create_var (TREE_TYPE (old_desc), "arg_desc");
- gfc_copy_descriptor_info (&se->pre, old_desc, new_desc,
expr->rank, ss);
- gfc_conv_descriptor_data_set (&se->pre, new_desc, ptr);
-
+ gfc_copy_descriptor_to_contiguous (&se->pre, old_desc, new_desc,
+ ptr, expr->rank, ss);
se->expr = gfc_build_addr_expr (NULL_TREE, new_desc);
+
+ gfc_free_ss (ss);
}
- gfc_free_ss (ss);
}
if (gfc_option.rtcheck & GFC_RTCHECK_ARRAY_TEMPS)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 9907aaa7e7a6..23e1cd09a8e9 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -527,14 +527,6 @@ conv_dimension_get (tree desc, tree dim)
return non_lvalue_loc (input_location, get_dimension (desc, dim));
}
-void
-conv_dimension_set (stmtblock_t *block, tree desc, tree dim, tree value)
-{
- location_t loc = input_location;
- tree t = get_dimension (desc, dim);
- gfc_add_modify_loc (loc, block, t, value);
-}
-
tree
get_token_field (tree desc)
@@ -3527,23 +3519,47 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
void
-gfc_copy_descriptor_info (stmtblock_t *block, tree src, tree dest, int rank,
- gfc_ss *ss)
+gfc_copy_descriptor_to_contiguous (stmtblock_t *block, tree src, tree dest,
+ tree cont_ptr, int rank, gfc_ss *ss)
{
tree old_field = gfc_conv_descriptor_dtype_get (src);
gfc_conv_descriptor_dtype_set (block, dest, old_field);
- old_field = gfc_conv_descriptor_offset_get (src);
- gfc_conv_descriptor_offset_set (block, dest, old_field);
+ tree offset = gfc_index_zero_node;
+ tree spacing = gfc_conv_descriptor_span_get (src);
+ spacing = gfc_evaluate_now (spacing, block);
for (int i = 0; i < rank; i++)
{
tree src_dim = gfc_rank_cst[gfc_get_array_ref_dim_for_loop_dim (ss, i)];
- old_field = gfc_conv_descriptor_dimension_get (src, src_dim);
- gfc_descriptor::conv_dimension_set (block, dest, gfc_rank_cst[i],
- old_field);
+
+ tree lbound = gfc_conv_descriptor_lbound_get (src, src_dim);
+ lbound = gfc_evaluate_now (lbound, block);
+ gfc_conv_descriptor_lbound_set (block, dest, gfc_rank_cst[i], lbound);
+
+ tree ubound = gfc_conv_descriptor_ubound_get (src, src_dim);
+ ubound = gfc_evaluate_now (ubound, block);
+ gfc_conv_descriptor_ubound_set (block, dest, gfc_rank_cst[i], ubound);
+
+ gfc_conv_descriptor_spacing_set (block, dest, gfc_rank_cst[i], spacing);
+
+ tree tmp = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, spacing, lbound);
+ offset = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, offset, tmp);
+ if (i < rank - 1)
+ {
+ tree extent = gfc_conv_array_extent_dim (lbound, ubound, nullptr);
+ spacing = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, spacing, extent);
+ spacing = gfc_evaluate_now (spacing, block);
+ }
}
+ gfc_conv_descriptor_offset_set (block, dest, offset);
+
+ gfc_conv_descriptor_data_set (block, dest, cont_ptr);
+
if (flag_coarray == GFC_FCOARRAY_LIB
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (src))
&& GFC_TYPE_ARRAY_AKIND (TREE_TYPE (src))
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 4c4c82d227ab..37dd4ea68243 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -36,7 +36,7 @@ void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *,
tree, tree, tree,
int gfc_descriptor_rank (tree);
void gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src,
- gfc_expr *src_expr, bool subref);
+ gfc_expr *src_expr, bool subref);
tree gfc_conv_descriptor_data_get (tree);
tree gfc_conv_descriptor_offset_get (tree);
@@ -97,8 +97,7 @@ tree gfc_descr_init_count (tree, int, int, gfc_expr **,
gfc_expr **,
stmtblock_t *, stmtblock_t *, tree *, tree,
gfc_expr *, tree, bool, gfc_expr *, tree,
gfc_typespec *, tree *);
-void
-gfc_copy_descriptor_info (stmtblock_t *, tree, tree, int, gfc_ss *);
+void gfc_copy_descriptor_to_contiguous (stmtblock_t *, tree, tree, tree, int,
gfc_ss *);
void
gfc_set_contiguous_array (stmtblock_t *block, tree desc, tree size,
tree data_ptr);
