https://gcc.gnu.org/g:ecdc8da68c9d5419d4c0e6ec9b1b3278076cbdf0
commit ecdc8da68c9d5419d4c0e6ec9b1b3278076cbdf0
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Tue Dec 17 22:37:18 2024 +0100
Appel méthode shift descriptor dans gfc_trans_pointer_assignment
Diff:
---
gcc/fortran/trans-array.cc | 129 +++++++++++++++++++++++++++++++++++++++++++--
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-expr.cc | 28 +---------
3 files changed, 129 insertions(+), 29 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 2fdd15962e49..cdbff27d82ca 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1151,13 +1151,136 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block,
tree desc,
}
+class lb_info
+{
+public:
+ virtual gfc_expr *lower_bound (int dim) const = 0;
+};
+
+
+class unset_lb : public lb_info
+{
+public:
+ virtual gfc_expr *lower_bound (int) const { return nullptr; }
+};
+
+
+class defined_lb : public lb_info
+{
+ int rank;
+ gfc_expr * const * lower_bounds;
+
+public:
+ defined_lb (int arg_rank, gfc_expr * const
arg_lower_bounds[GFC_MAX_DIMENSIONS])
+ : rank(arg_rank), lower_bounds(arg_lower_bounds) { }
+ virtual gfc_expr *lower_bound (int dim) const { return lower_bounds[dim]; }
+};
+
+
static void
-conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
+conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+ const lb_info &info)
{
/* Apply a shift of the lbound when supplied. */
for (int dim = 0; dim < rank; ++dim)
- gfc_conv_shift_descriptor_lbound (block, desc, dim,
- gfc_index_one_node);
+ {
+ gfc_expr *lb_expr = info.lower_bound(dim);
+
+ tree lower_bound;
+ if (lb_expr == nullptr)
+ lower_bound = gfc_index_one_node;
+ else
+ {
+ gfc_se lb_se;
+
+ gfc_init_se (&lb_se, nullptr);
+ gfc_conv_expr (&lb_se, lb_expr);
+
+ gfc_add_block_to_block (block, &lb_se.pre);
+ tree lb_var = gfc_create_var (TREE_TYPE (lb_se.expr), "lower_bound");
+ gfc_add_modify (block, lb_var, lb_se.expr);
+ gfc_add_block_to_block (block, &lb_se.post);
+
+ lower_bound = lb_var;
+ }
+
+ gfc_conv_shift_descriptor_lbound (block, desc, dim, lower_bound);
+ }
+}
+
+
+static void
+conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
+{
+ conv_shift_descriptor (block, desc, rank, unset_lb ());
+}
+
+
+static void
+conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+ gfc_expr * const lower_bounds[GFC_MAX_DIMENSIONS])
+{
+ conv_shift_descriptor (block, desc, rank, defined_lb (rank, lower_bounds));
+}
+
+
+static void
+conv_shift_descriptor (stmtblock_t *block, tree desc,
+ const gfc_array_spec &as)
+{
+ conv_shift_descriptor (block, desc, as.rank, as.lower);
+}
+
+
+static void
+set_type (array_type &type, array_type value)
+{
+ gcc_assert (type == AS_UNKNOWN || type == value);
+ type = value;
+}
+
+
+static void
+array_ref_to_array_spec (const gfc_array_ref &ref, gfc_array_spec &spec)
+{
+ spec.rank = ref.dimen;
+ spec.corank = ref.codimen;
+
+ spec.type = AS_UNKNOWN;
+ spec.cotype = AS_ASSUMED_SIZE;
+
+ for (int dim = 0; dim < spec.rank + spec.corank; dim++)
+ switch (ref.dimen_type[dim])
+ {
+ case DIMEN_ELEMENT:
+ spec.upper[dim] = ref.start[dim];
+ set_type (spec.type, AS_EXPLICIT);
+ break;
+
+ case DIMEN_RANGE:
+ spec.lower[dim] = ref.start[dim];
+ spec.upper[dim] = ref.end[dim];
+ if (spec.upper[dim] == nullptr)
+ set_type (spec.type, AS_DEFERRED);
+ else
+ set_type (spec.type, AS_EXPLICIT);
+ break;
+
+ default:
+ break;
+ }
+}
+
+
+void
+gfc_conv_shift_descriptor (stmtblock_t *block, tree desc,
+ const gfc_array_ref &ar)
+{
+ gfc_array_spec as;
+
+ array_ref_to_array_spec (ar, as);
+
+ conv_shift_descriptor (block, desc, as);
}
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 17e3d08fdba0..3b05a2eb197a 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -214,6 +214,7 @@ tree gfc_get_cfi_dim_sm (tree, tree);
/* Shift lower bound of descriptor, updating ubound and offset. */
void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
+void gfc_conv_shift_descriptor (stmtblock_t*, tree, const gfc_array_ref &);
/* Add pre-loop scalarization code for intrinsic functions which require
special handling. */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e8b229d853e3..1de4a73974d6 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11180,32 +11180,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1,
gfc_expr * expr2)
}
}
else
- {
- /* Bounds remapping. Just shift the lower bounds. */
-
- gcc_assert (expr1->rank == expr2->rank);
-
- for (dim = 0; dim < remap->u.ar.dimen; ++dim)
- {
- gfc_se lbound_se;
-
- gcc_assert (!remap->u.ar.end[dim]);
- gfc_init_se (&lbound_se, NULL);
- if (remap->u.ar.start[dim])
- {
- gfc_conv_expr (&lbound_se, remap->u.ar.start[dim]);
- gfc_add_block_to_block (&block, &lbound_se.pre);
- }
- else
- /* This remap arises from a target that is not a whole
- array. The start expressions will be NULL but we need
- the lbounds to be one. */
- lbound_se.expr = gfc_index_one_node;
- gfc_conv_shift_descriptor_lbound (&block, desc,
- dim, lbound_se.expr);
- gfc_add_block_to_block (&block, &lbound_se.post);
- }
- }
+ /* Bounds remapping. Just shift the lower bounds. */
+ gfc_conv_shift_descriptor (&block, desc, remap->u.ar);
}
/* If rank remapping was done, check with -fcheck=bounds that
