https://gcc.gnu.org/g:55ab3ee1158fd34891cb60b79528d47d635a70f1
commit 55ab3ee1158fd34891cb60b79528d47d635a70f1
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Thu Apr 3 20:38:00 2025 +0200
Correction régressions, y compris aliasing_dummy_1.f90
Diff:
---
gcc/fortran/trans-array.cc | 24 +++++++++++++---------
gcc/fortran/trans-expr.cc | 50 +---------------------------------------------
gcc/fortran/trans-types.cc | 45 +++++++++++++++++++++++++----------------
3 files changed, 44 insertions(+), 75 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8d48d8e05a95..f09a1f6130dd 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1248,9 +1248,9 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
dealloc);
gfc_set_temporary_descriptor (pre, desc, class_expr, elemsize,
- GFC_TYPE_ARRAY_ALIGN (desc), data_ptr,
- from, to, spacing, total_dim, !bounds_known,
- rank_changer, shift_bounds);
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)),
+ data_ptr, from, to, spacing, total_dim,
+ !bounds_known, rank_changer, shift_bounds);
while (ss->parent)
ss = ss->parent;
@@ -1396,7 +1396,7 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree
desc,
/* Store the value. */
tmp = build_fold_indirect_ref_loc (input_location,
gfc_conv_descriptor_data_get (desc));
- tmp = gfc_build_array_ref (tmp, offset, NULL_TREE, NULL_TREE);
+ tmp = gfc_build_array_ref (tmp, offset, true);
if (expr->expr_type == EXPR_FUNCTION && expr->ts.type == BT_DERIVED
&& expr->ts.u.derived->attr.alloc_comp)
@@ -3637,7 +3637,8 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref
* ar,
bool non_negative_stride = tmp_array
|| non_negative_strides_array_p (info->descriptor);
se->expr = gfc_build_array_ref (base, index, non_negative_stride,
- gfc_index_one_node, info->align);
+ tmp_array ? NULL_TREE : gfc_index_one_node,
+ tmp_array ? NULL_TREE : info->align);
}
@@ -6224,9 +6225,11 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym,
tree * poffset,
as = IS_CLASS_COARRAY_OR_ARRAY (sym) ? CLASS_DATA (sym)->as : sym->as;
tree eltype = gfc_get_element_type (type);
+ tree elem_len = fold_convert_loc (input_location, gfc_array_index_type,
+ TYPE_SIZE_UNIT (eltype));
size = fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type,
- TYPE_SIZE_UNIT (eltype), GFC_TYPE_ARRAY_ALIGN (type));
+ elem_len, GFC_TYPE_ARRAY_ALIGN (type));
offset = gfc_index_zero_node;
for (dim = 0; dim < as->rank; dim++)
{
@@ -6619,10 +6622,13 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
if (no_repack)
{
/* Set the first stride. */
- spacing = gfc_conv_descriptor_spacing_get (dumdesc, gfc_rank_cst[0]);
- tmp = gfc_evaluate_now (spacing, &init);
spacing = GFC_TYPE_ARRAY_SPACING (type, 0);
- gfc_add_modify (&init, spacing, tmp);
+ if (!INTEGER_CST_P (spacing))
+ {
+ tmp = gfc_conv_descriptor_spacing_get (dumdesc, gfc_rank_cst[0]);
+ tmp = gfc_evaluate_now (tmp, &init);
+ gfc_add_modify (&init, spacing, tmp);
+ }
/* Allow the user to disable array repacking. */
stmt_unpacked = NULL_TREE;
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index acd6ee937d28..2c0961888e84 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5337,8 +5337,6 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr,
int g77,
gfc_loopinfo loop;
gfc_loopinfo loop2;
gfc_array_info *info;
- tree offset;
- tree tmp_index;
tree tmp;
tree base_type;
stmtblock_t body;
@@ -5493,55 +5491,9 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr,
int g77,
gfc_mark_ss_chain_used (lss, 1);
gfc_mark_ss_chain_used (loop.temp_ss, 1);
- /* Declare the variable to hold the temporary offset and start the
- scalarized loop body. */
- offset = gfc_create_var (gfc_array_index_type, NULL);
gfc_start_scalarized_body (&loop2, &body);
- /* Build the offsets for the temporary from the loop variables. The
- temporary array has lbounds of zero and strides of one in all
- dimensions, so this is very simple. The offset is only computed
- outside the innermost loop, so the overall transfer could be
- optimized further. */
- info = &rse.ss->info->data.array;
-
- tmp_index = gfc_index_zero_node;
- for (n = dimen - 1; n > 0; n--)
- {
- tree tmp_str;
- tmp = rse.loop->loopvar[n];
- tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- tmp, rse.loop->from[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- tmp, tmp_index);
-
- tmp_str = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- rse.loop->to[n-1], rse.loop->from[n-1]);
- tmp_str = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- tmp_str, gfc_index_one_node);
-
- tmp_index = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, tmp, tmp_str);
- }
-
- tmp_index = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- tmp_index, rse.loop->from[0]);
- gfc_add_modify (&rse.loop->code[0], offset, tmp_index);
-
- tmp_index = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- rse.loop->loopvar[0], offset);
-
- /* Now use the offset for the reference. */
- tmp = build_fold_indirect_ref_loc (input_location,
- info->data);
- rse.expr = gfc_build_array_ref (tmp, tmp_index, NULL);
-
- if (expr->ts.type == BT_CHARACTER)
- rse.string_length = expr->ts.u.cl->backend_decl;
+ gfc_conv_tmp_array_ref (&rse);
gfc_conv_expr (&lse, expr);
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 648a09fc2a7d..696faa434e93 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1663,7 +1663,7 @@ gfc_get_desc_dim_type (void)
/* Consists of the sm, lbound and ubound members. */
decl = gfc_add_field_to_struct_1 (type,
- get_identifier ("sm"),
+ get_identifier ("spacing"),
gfc_array_index_type, &chain);
suppress_warning (decl);
@@ -1851,7 +1851,6 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
tree type;
tree tmp;
int n;
- int known_stride;
int known_offset;
mpz_t offset;
mpz_t stride;
@@ -1861,12 +1860,18 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
mpz_init_set_ui (offset, 0);
mpz_init_set_ui (stride, 1);
- wide_int elem_len = wi::to_wide (TYPE_SIZE_UNIT (etype));
+ mpz_init (spacing);
wide_int align = wi::uhwi (TYPE_ALIGN_UNIT (etype),
TYPE_PRECISION (gfc_array_index_type));
- wide_int aligned_len = wi::udiv_trunc (elem_len, align);
- gcc_assert (wi::fits_shwi_p (aligned_len));
- mpz_init_set_ui (spacing, aligned_len.to_shwi ());
+
+ bool known_spacing = INTEGER_CST_P (TYPE_SIZE_UNIT (etype));
+ if (known_spacing)
+ {
+ wide_int elem_len = wi::to_wide (TYPE_SIZE_UNIT (etype));
+ wide_int len_align = wi::udiv_trunc (elem_len, align);
+ gcc_assert (wi::fits_uhwi_p (len_align));
+ mpz_set_ui (spacing, len_align.to_uhwi ());
+ }
mpz_init (delta);
/* We don't use build_array_type because this does not include
@@ -1880,12 +1885,12 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
GFC_ARRAY_TYPE_P (type) = 1;
TYPE_LANG_SPECIFIC (type) = ggc_cleared_alloc<struct lang_type> ();
- known_stride = (packed != PACKED_NO);
+ bool known_stride = (packed != PACKED_NO);
known_offset = 1;
for (n = 0; n < as->rank; n++)
{
/* Fill in the spacing and bound components of the type. */
- if (known_stride)
+ if (known_spacing)
tmp = gfc_conv_mpz_to_tree (spacing, gfc_index_integer_kind);
else
tmp = NULL_TREE;
@@ -1899,12 +1904,13 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
}
else
{
- known_stride = 0;
+ known_stride = false;
+ known_spacing = false;
tmp = NULL_TREE;
}
GFC_TYPE_ARRAY_LBOUND (type, n) = tmp;
- if (known_stride)
+ if (known_spacing)
{
/* Calculate the offset. */
mpz_mul (delta, spacing, as->lower[n]->value.integer);
@@ -1922,23 +1928,29 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
else
{
tmp = NULL_TREE;
- known_stride = 0;
+ known_stride = false;
+ known_spacing = false;
}
GFC_TYPE_ARRAY_UBOUND (type, n) = tmp;
- if (known_stride)
+ if (known_spacing || known_stride)
{
/* Calculate the stride. */
mpz_sub (delta, as->upper[n]->value.integer,
as->lower[n]->value.integer);
mpz_add_ui (delta, delta, 1);
- mpz_mul (stride, stride, delta);
- mpz_mul (spacing, spacing, delta);
+ if (known_stride)
+ mpz_mul (stride, stride, delta);
+ if (known_spacing)
+ mpz_mul (spacing, spacing, delta);
}
/* Only the first stride is known for partial packed arrays. */
if (packed == PACKED_NO || packed == PACKED_PARTIAL)
- known_stride = 0;
+ {
+ known_stride = 0;
+ known_spacing = 0;
+ }
}
for (n = as->rank; n < as->rank + as->corank; n++)
{
@@ -1980,8 +1992,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
GFC_TYPE_ARRAY_ELEM_LEN (type) = TYPE_SIZE_UNIT (etype);
wide_int index_one = wi::one (TYPE_PRECISION (gfc_array_index_type));
- GFC_TYPE_ARRAY_ALIGN (type) = wide_int_to_tree (gfc_array_index_type,
- wi::lshift (index_one,
align));
+ GFC_TYPE_ARRAY_ALIGN (type) = wide_int_to_tree (gfc_array_index_type, align);
GFC_TYPE_ARRAY_RANK (type) = as->rank;
GFC_TYPE_ARRAY_CORANK (type) = as->corank;
GFC_TYPE_ARRAY_DTYPE (type) = NULL_TREE;
