[gcc(refs/users/mikael/heads/refactor_descriptor_v05)] Correction régression partparm.f90
Mikael Morin
mikael@gcc.gnu.org
Fri Jun 13 14:57:10 GMT 2025
https://gcc.gnu.org/g:e0dc7c867a949f73b4815d8a4f55351086aec976
commit e0dc7c867a949f73b4815d8a4f55351086aec976
Author: Mikael Morin <mikael@gcc.gnu.org>
Date: Sun Apr 20 18:46:54 2025 +0200
Correction régression partparm.f90
Diff:
---
gcc/fortran/trans-array.cc | 12 ++++--------
gcc/fortran/trans-array.h | 2 +-
gcc/fortran/trans-descriptor.cc | 17 +++++++++--------
gcc/fortran/trans-expr.cc | 2 +-
gcc/fortran/trans.cc | 11 +++++++++--
5 files changed, 24 insertions(+), 20 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 80afbfdbf0a1..91a0379f7336 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3529,10 +3529,8 @@ build_array_ref_dim (gfc_ss *ss, tree index, tree spacing,
|| ss_type == GFC_SS_INTRINSIC
|| tmp_array
|| non_negative_strides_array_p (info->descriptor);
- return gfc_build_array_ref (base, index,
- non_negative_stride
- && (!offset || integer_zerop (offset)),
- NULL_TREE, spacing, offset);
+ return gfc_build_array_ref (base, index, non_negative_stride, NULL_TREE,
+ spacing, offset);
}
@@ -6772,7 +6770,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
/* Calculate the overall offset, including subreferences. */
void
-gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc,
+gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
bool subref, gfc_expr *expr)
{
tree field;
@@ -6782,15 +6780,13 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc,
gfc_se start;
int n;
- tree offset = gfc_index_zero_node;
-
bool non_negative_strides = non_negative_strides_array_p (desc);
tree tmp = gfc_conv_array_data (desc);
tree array = build_fold_indirect_ref_loc (input_location, tmp);
tmp = gfc_build_array_ref (array, gfc_index_zero_node, non_negative_strides,
- gfc_index_zero_node, NULL_TREE);
+ gfc_index_zero_node, NULL_TREE, offset);
/* Offset the data pointer for pointer assignments from arrays with
subreferences; e.g. my_integer => my_type(:)%integer_component. */
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 73322a227a5f..d52c1a859459 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -147,7 +147,7 @@ void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
void gfc_conv_tmp_array_ref (gfc_se * se);
/* Calculate the overall offset, including subreferences. */
-void gfc_get_dataptr_offset (stmtblock_t*, tree, tree, bool, gfc_expr*);
+void gfc_get_dataptr_offset (stmtblock_t*, tree, tree, tree, bool, gfc_expr*);
/* Obtain the span of an array. */
tree gfc_get_array_span (tree, gfc_expr *);
/* Evaluate an array expression. */
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index cb2dd86f6522..3e65b5ad93a3 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2481,7 +2481,7 @@ gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src,
/* Add any offsets from subreferences. */
if (subref)
- gfc_get_dataptr_offset (block, dest, src, subref, src_expr);
+ gfc_get_dataptr_offset (block, dest, src, NULL_TREE, subref, src_expr);
/* ....and set the span field. */
tree tmp2;
@@ -3055,12 +3055,13 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr,
dtype = gfc_get_dtype (TREE_TYPE (src), &rank);
gfc_conv_descriptor_dtype_set (block, dest, dtype);
- /* The offset from the 1st element in the section. */
- tree offset = gfc_index_zero_node;
-
/* The 1st element in the section. */
+ tree base = gfc_index_zero_node;
if (src_expr->ts.type == BT_CHARACTER && src_expr->rank == 0 && corank)
- offset = gfc_conv_descriptor_elem_len_get (dest);
+ base = gfc_conv_descriptor_elem_len_get (dest);
+
+ /* The offset from the 1st element in the section. */
+ tree offset = gfc_index_zero_node;
for (int n = 0; n < ndim; n++)
{
@@ -3087,8 +3088,8 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr,
start, tmp);
tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
tmp, spacing);
- offset = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp),
- offset, tmp);
+ base = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp),
+ base, tmp);
if (info->ref
&& info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
@@ -3150,7 +3151,7 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr,
if (data_needed)
/* Point the data pointer at the 1st element in the section. */
- gfc_get_dataptr_offset (block, dest, src, subref, src_expr);
+ gfc_get_dataptr_offset (block, dest, src, base, subref, src_expr);
else
gfc_conv_descriptor_data_set (block, dest,
gfc_index_zero_node);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 1830ebaa5ce7..536b46fcfef6 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5956,7 +5956,7 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
if (POINTER_TYPE_P (TREE_TYPE (gfc)))
gfc = build_fold_indirect_ref_loc (input_location, gfc);
else if (is_subref_array (e) && e->ts.type != BT_CHARACTER)
- gfc_get_dataptr_offset (&se.pre, gfc, gfc, true, e);
+ gfc_get_dataptr_offset (&se.pre, gfc, gfc, NULL_TREE, true, e);
}
if (e->ts.type == BT_CHARACTER)
{
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index e7e53a1b7f16..180d57026317 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -435,8 +435,15 @@ gfc_build_array_ref (tree type, tree base, tree index, bool non_negative_offset,
build_int_cst (gfc_array_index_type,
elt_align));
}
- return build4_loc (input_location, ARRAY_REF, type, base, index,
- min_idx, spacing);
+ tree ref = build4_loc (input_location, ARRAY_REF, type, base, index,
+ min_idx, spacing);
+ if (!offset || integer_zerop (offset))
+ return ref;
+
+ tree addr = gfc_build_addr_expr (NULL_TREE, ref);
+
+ tree ptr = fold_build_pointer_plus_loc (input_location, addr, offset);
+ return build_fold_indirect_ref_loc (input_location, ptr);
}
/* Otherwise use pointer arithmetic. */
else
More information about the Gcc-cvs
mailing list