https://gcc.gnu.org/g:d63b964d7985ea297ecc11b99c616ac5cfb193fa
commit d63b964d7985ea297ecc11b99c616ac5cfb193fa
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Fri Apr 4 11:42:19 2025 +0200
Correction régression y compris PR100094
Diff:
---
gcc/fortran/trans-array.cc | 6 +++---
gcc/fortran/trans-descriptor.cc | 2 +-
gcc/fortran/trans-expr.cc | 4 +++-
gcc/fortran/trans-intrinsic.cc | 16 ++++++++++++----
gcc/fortran/trans-io.cc | 4 +++-
gcc/fortran/trans-openmp.cc | 16 ++++++++++++----
gcc/fortran/trans-stmt.cc | 32 ++++++++++++++++----------------
gcc/fortran/trans-types.cc | 2 +-
8 files changed, 51 insertions(+), 31 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 717176c01056..fa7afc938e58 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1727,7 +1727,7 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
tmp = gfc_conv_descriptor_data_get (desc);
tmp = build_fold_indirect_ref_loc (input_location,
tmp);
- tmp = gfc_build_array_ref (tmp, *poffset, NULL_TREE, NULL_TREE);
+ tmp = gfc_build_array_ref (tmp, *poffset, true);
tmp = gfc_build_addr_expr (NULL_TREE, tmp);
init = gfc_build_addr_expr (NULL_TREE, init);
@@ -8860,13 +8860,13 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
/* Build the body of the loop. */
gfc_init_block (&loopbody);
- vref = gfc_build_array_ref (var, index, NULL_TREE, NULL_TREE);
+ vref = gfc_build_array_ref (var, index, true);
if (purpose == COPY_ALLOC_COMP || purpose == COPY_ONLY_ALLOC_COMP)
{
tmp = build_fold_indirect_ref_loc (input_location,
gfc_conv_array_data (dest));
- dref = gfc_build_array_ref (tmp, index, NULL_TREE, NULL_TREE);
+ dref = gfc_build_array_ref (tmp, index, true);
tmp = structure_alloc_comps (der_type, vref, dref, rank,
COPY_ALLOC_COMP, caf_mode, args,
no_finalization);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 1f35b6722998..747e98d05df5 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -3104,7 +3104,7 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
gfc_conv_descriptor_span_set (block, dest, tmp);
tree eltype = gfc_get_element_type (TREE_TYPE (dest));
- gfc_conv_descriptor_align_set (block, dest, TYPE_ALIGN (eltype));
+ gfc_conv_descriptor_align_set (block, dest, TYPE_ALIGN_UNIT (eltype));
/* The following can be somewhat confusing. We have two
descriptors, a new one and the original array.
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 2c0961888e84..0da3bf971a27 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1629,7 +1629,9 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems,
bool unlimited)
tmp = gfc_conv_array_data (to);
tmp = build_fold_indirect_ref_loc (input_location, tmp);
to_ref = gfc_build_addr_expr (NULL_TREE,
- gfc_build_array_ref (tmp, index, to));
+ gfc_build_array_ref (tmp, index, false,
+
GFC_TYPE_ARRAY_SPACING (to, 0),
+
GFC_TYPE_ARRAY_ALIGN (to)));
}
vec_safe_push (args, to_ref);
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 9b8874910cee..ca61dcda5ff4 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2154,7 +2154,9 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
thus we need explicitly check this - and return 0 if they are exceeded.
*/
lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[rank+corank-1]);
- tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[corank-1], NULL);
+ tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[corank-1], false,
+ GFC_TYPE_ARRAY_SPACING (subse.expr, 0),
+ GFC_TYPE_ARRAY_ALIGN (subse.expr));
invalid_bound = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
fold_convert (gfc_array_index_type, tmp),
lbound);
@@ -2163,7 +2165,9 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
{
lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[codim]);
ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[codim]);
- tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[codim-rank], NULL);
+ tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[codim-rank], false,
+ GFC_TYPE_ARRAY_SPACING (subse.expr, 0),
+ GFC_TYPE_ARRAY_ALIGN (subse.expr));
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
fold_convert (gfc_array_index_type, tmp),
lbound);
@@ -2183,7 +2187,9 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
/* coindex = sub(corank) - lcobound(n). */
coindex = fold_convert (gfc_array_index_type,
gfc_build_array_ref (subdesc, gfc_rank_cst[corank-1],
- NULL));
+ false,
+ GFC_TYPE_ARRAY_SPACING
(subse.expr, 0),
+ GFC_TYPE_ARRAY_ALIGN
(subse.expr)));
lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[rank+corank-1]);
coindex = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
fold_convert (gfc_array_index_type, coindex),
@@ -2201,7 +2207,9 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
gfc_array_index_type, coindex, extent);
/* coindex += sub(codim). */
- tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[codim-rank], NULL);
+ tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[codim-rank], false,
+ GFC_TYPE_ARRAY_SPACING (subse.expr, 0),
+ GFC_TYPE_ARRAY_ALIGN (subse.expr));
coindex = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, coindex,
fold_convert (gfc_array_index_type, tmp));
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 52b011217e55..44e65d9e01d2 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -1655,7 +1655,9 @@ nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
tmp = gfc_build_addr_expr (NULL_TREE, tmp);
if (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
- tmp = gfc_build_array_ref (tmp, gfc_index_zero_node, NULL_TREE,
NULL_TREE);
+ tmp = gfc_build_array_ref (tmp, gfc_index_zero_node, false,
+ GFC_TYPE_ARRAY_SPACING (tmp, 0),
+ GFC_TYPE_ARRAY_ALIGN (tmp));
if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref_loc (input_location,
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 96b23a4fde77..4e27816c1f5a 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -593,13 +593,17 @@ gfc_walk_alloc_comps (tree decl, tree dest, tree var,
gfc_init_block (&tmpblock);
tem = gfc_conv_array_data (decl);
tree declvar = build_fold_indirect_ref_loc (input_location, tem);
- tree declvref = gfc_build_array_ref (declvar, index, NULL);
+ tree declvref = gfc_build_array_ref (declvar, index, false,
+ GFC_TYPE_ARRAY_SPACING (declvar, 0),
+ GFC_TYPE_ARRAY_ALIGN (declvar));
tree destvar, destvref = NULL_TREE;
if (dest)
{
tem = gfc_conv_array_data (dest);
destvar = build_fold_indirect_ref_loc (input_location, tem);
- destvref = gfc_build_array_ref (destvar, index, NULL);
+ destvref = gfc_build_array_ref (destvar, index, false,
+ GFC_TYPE_ARRAY_SPACING (declvar, 0),
+ GFC_TYPE_ARRAY_ALIGN (declvar));
}
gfc_add_expr_to_block (&tmpblock,
gfc_walk_alloc_comps (declvref, destvref,
@@ -1232,8 +1236,12 @@ gfc_omp_linear_clause_add_loop (stmtblock_t *block, tree
dest, tree src,
gfc_init_block (&tmpblock);
if (TREE_CODE (TREE_TYPE (dest)) == ARRAY_TYPE)
{
- desta = gfc_build_array_ref (dest, index, NULL);
- srca = gfc_build_array_ref (src, index, NULL);
+ desta = gfc_build_array_ref (dest, index, false,
+ GFC_TYPE_ARRAY_SPACING (dest, 0),
+ GFC_TYPE_ARRAY_ALIGN (dest));
+ srca = gfc_build_array_ref (src, index, false,
+ GFC_TYPE_ARRAY_SPACING (src, 0),
+ GFC_TYPE_ARRAY_ALIGN (src));
}
else
{
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index c31602e0fed6..fdcc92555c9c 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -506,7 +506,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check,
{
/* Form the mask expression according to the mask. */
index = count1;
- maskexpr = gfc_build_array_ref (mask, index, NULL);
+ maskexpr = gfc_build_array_ref (mask, index, true);
if (invert)
maskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
TREE_TYPE (maskexpr), maskexpr);
@@ -4272,7 +4272,7 @@ gfc_trans_nested_forall_loop (forall_info *
nested_forall_info, tree body,
/* If a mask was specified make the assignment conditional. */
if (mask)
{
- tmp = gfc_build_array_ref (mask, maskindex, NULL);
+ tmp = gfc_build_array_ref (mask, maskindex, true);
body = build3_v (COND_EXPR, tmp, body,
build_empty_stmt (input_location));
}
@@ -4349,7 +4349,7 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1,
tree count3,
{
gfc_init_block (&body1);
gfc_conv_expr (&lse, expr);
- rse.expr = gfc_build_array_ref (tmp1, count1, NULL);
+ rse.expr = gfc_build_array_ref (tmp1, count1, true);
}
else
{
@@ -4383,7 +4383,7 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1,
tree count3,
/* Form the mask expression according to the mask tree list. */
if (wheremask)
{
- wheremaskexpr = gfc_build_array_ref (wheremask, count3, NULL);
+ wheremaskexpr = gfc_build_array_ref (wheremask, count3, true);
if (invert)
wheremaskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
TREE_TYPE (wheremaskexpr),
@@ -4454,7 +4454,7 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree
tmp1, tree count3,
{
gfc_init_block (&body1);
gfc_conv_expr (&rse, expr2);
- lse.expr = gfc_build_array_ref (tmp1, count1, NULL);
+ lse.expr = gfc_build_array_ref (tmp1, count1, true);
}
else
{
@@ -4489,7 +4489,7 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree
tmp1, tree count3,
/* Form the mask expression according to the mask tree list. */
if (wheremask)
{
- wheremaskexpr = gfc_build_array_ref (wheremask, count3, NULL);
+ wheremaskexpr = gfc_build_array_ref (wheremask, count3, true);
if (invert)
wheremaskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
TREE_TYPE (wheremaskexpr),
@@ -4895,7 +4895,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1,
gfc_expr * expr2,
inner_size, NULL, block, &ptemp1);
gfc_start_block (&body);
gfc_init_se (&lse, NULL);
- lse.expr = gfc_build_array_ref (tmp1, count, NULL);
+ lse.expr = gfc_build_array_ref (tmp1, count, true);
gfc_init_se (&rse, NULL);
rse.want_pointer = 1;
gfc_conv_expr (&rse, expr2);
@@ -4922,7 +4922,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1,
gfc_expr * expr2,
gfc_start_block (&body);
gfc_init_se (&lse, NULL);
gfc_init_se (&rse, NULL);
- rse.expr = gfc_build_array_ref (tmp1, count, NULL);
+ rse.expr = gfc_build_array_ref (tmp1, count, true);
lse.want_pointer = 1;
gfc_conv_expr (&lse, expr1);
gfc_add_block_to_block (&body, &lse.pre);
@@ -4965,7 +4965,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1,
gfc_expr * expr2,
inner_size, NULL, block, &ptemp1);
gfc_start_block (&body);
gfc_init_se (&lse, NULL);
- lse.expr = gfc_build_array_ref (tmp1, count, NULL);
+ lse.expr = gfc_build_array_ref (tmp1, count, true);
lse.direct_byref = 1;
gfc_conv_expr_descriptor (&lse, expr2);
@@ -4987,7 +4987,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1,
gfc_expr * expr2,
/* Reset count. */
gfc_add_modify (block, count, gfc_index_zero_node);
- parm = gfc_build_array_ref (tmp1, count, NULL);
+ parm = gfc_build_array_ref (tmp1, count, true);
gfc_init_se (&lse, NULL);
gfc_conv_expr_descriptor (&lse, expr1);
gfc_add_modify (&lse.pre, lse.expr, parm);
@@ -5249,7 +5249,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info *
nested_forall_info)
/* Store the mask. */
se.expr = convert (mask_type, se.expr);
- tmp = gfc_build_array_ref (mask, maskindex, NULL);
+ tmp = gfc_build_array_ref (mask, maskindex, true);
gfc_add_modify (&body, tmp, se.expr);
/* Advance to the next mask element. */
@@ -5501,7 +5501,7 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info *
nested_forall_info,
if (mask && (cmask || pmask))
{
- tmp = gfc_build_array_ref (mask, count, NULL);
+ tmp = gfc_build_array_ref (mask, count, true);
if (invert)
tmp = fold_build1_loc (input_location, TRUTH_NOT_EXPR, mask_type, tmp);
gfc_add_modify (&body1, mtmp, tmp);
@@ -5509,7 +5509,7 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info *
nested_forall_info,
if (cmask)
{
- tmp1 = gfc_build_array_ref (cmask, count, NULL);
+ tmp1 = gfc_build_array_ref (cmask, count, true);
tmp = cond;
if (mask)
tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, mask_type,
@@ -5519,7 +5519,7 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info *
nested_forall_info,
if (pmask)
{
- tmp1 = gfc_build_array_ref (pmask, count, NULL);
+ tmp1 = gfc_build_array_ref (pmask, count, true);
tmp = fold_build1_loc (input_location, TRUTH_NOT_EXPR, mask_type, cond);
if (mask)
tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, mask_type, mtmp,
@@ -5678,7 +5678,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
/* Form the mask expression according to the mask. */
index = count1;
- maskexpr = gfc_build_array_ref (mask, index, NULL);
+ maskexpr = gfc_build_array_ref (mask, index, true);
if (invert)
maskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
TREE_TYPE (maskexpr), maskexpr);
@@ -5732,7 +5732,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
/* Form the mask expression according to the mask tree list. */
index = count2;
- maskexpr = gfc_build_array_ref (mask, index, NULL);
+ maskexpr = gfc_build_array_ref (mask, index, true);
if (invert)
maskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
TREE_TYPE (maskexpr), maskexpr);
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 696faa434e93..d07d8e4183ae 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2232,7 +2232,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
wide_int align = wi::uhwi (TYPE_ALIGN_UNIT (etype), index_precision);
wide_int index_one = wi::one (index_precision);
GFC_TYPE_ARRAY_ALIGN (fat_type) = wide_int_to_tree (gfc_array_index_type,
- wi::lshift (index_one,
align));
+ align);
GFC_TYPE_ARRAY_RANK (fat_type) = dimen;
GFC_TYPE_ARRAY_CORANK (fat_type) = codimen;
GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE;
