https://gcc.gnu.org/g:d0a146dfc5c751e579264d1b9d01705b3dbb99fb
commit d0a146dfc5c751e579264d1b9d01705b3dbb99fb
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Apr 30 14:38:54 2025 +0200
Correction régression class_array_23
Diff:
---
gcc/fortran/trans-array.cc | 21 +++------------------
gcc/fortran/trans-array.h | 3 ++-
gcc/fortran/trans-descriptor.cc | 25 ++++++++++++++++++++++++-
gcc/fortran/trans-descriptor.h | 7 +++++--
gcc/fortran/trans-stmt.cc | 3 ++-
5 files changed, 36 insertions(+), 23 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 85711ac6c341..bc30c83f4ac1 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5771,7 +5771,7 @@ bool
gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
tree errlen, tree label_finish, tree expr3_elem_size,
gfc_expr *expr3, tree e3_arr_desc, bool e3_has_nodescriptor,
- gfc_omp_namelist *omp_alloc, bool explicit_ts)
+ gfc_omp_namelist *omp_alloc, gfc_typespec * explicit_ts)
{
tree tmp;
tree pointer;
@@ -10303,7 +10303,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
stmtblock_t realloc_block;
stmtblock_t alloc_block;
stmtblock_t fblock;
- stmtblock_t loop_pre_block;
gfc_ref *ref;
gfc_ss *rss;
gfc_ss *lss;
@@ -10400,22 +10399,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
tree guard = gfc_create_var (logical_type_node,
"unallocated_init_guard");
gfc_add_modify (&unalloc_init_block, guard, logical_false_node);
- gfc_start_block (&loop_pre_block);
- for (n = 0; n < expr1->rank; n++)
- {
- gfc_conv_descriptor_lbound_set (&loop_pre_block, desc,
- gfc_rank_cst[n],
- gfc_index_one_node);
- gfc_conv_descriptor_ubound_set (&loop_pre_block, desc,
- gfc_rank_cst[n],
- gfc_index_zero_node);
- gfc_conv_descriptor_spacing_set (&loop_pre_block, desc,
- gfc_rank_cst[n],
- gfc_index_zero_node);
- }
-
- gfc_conv_descriptor_offset_set (&loop_pre_block, desc,
- gfc_index_zero_node);
+ stmtblock_t loop_pre_block;
+ gfc_set_empty_descriptor (&loop_pre_block, desc, expr1->rank);
tmp = fold_build2_loc (input_location, EQ_EXPR,
logical_type_node, array1,
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 79d70f3451d5..c2ca3b55bea6 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -21,7 +21,8 @@ along with GCC; see the file COPYING3. If not see
/* Generate code to initialize and allocate an array. Statements are added to
se, which should contain an expression for the array descriptor. */
bool gfc_array_allocate (gfc_se *, gfc_expr *, tree, tree, tree, tree, tree,
- gfc_expr *, tree, bool, gfc_omp_namelist *, bool);
+ gfc_expr *, tree, bool, gfc_omp_namelist *,
+ gfc_typespec *);
/* Allow the bounds of a loop to be set from a callee's array spec. */
void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 2e25a022655b..559016eb9ae7 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -3208,7 +3208,7 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
stmtblock_t * descriptor_block, tree * overflow,
tree expr3_elem_size, gfc_expr *expr3, tree expr3_desc,
bool e3_has_nodescriptor, gfc_expr *expr,
- tree element_size, bool explicit_ts,
+ tree element_size, gfc_typespec * explicit_ts,
tree *empty_array_cond)
{
tree type;
@@ -3259,6 +3259,12 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
tree dtype_value = gfc_get_dtype_rank_type (rank, type);
gfc_conv_descriptor_dtype_set (pblock, descriptor, dtype_value);
}
+ else if (explicit_ts)
+ {
+ type = gfc_typenode_for_spec (explicit_ts);
+ tree dtype_value = gfc_get_dtype_rank_type (rank, type);
+ gfc_conv_descriptor_dtype_set (pblock, descriptor, dtype_value);
+ }
else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc)))
{
tree dtype_value = gfc_conv_descriptor_dtype_get (expr3_desc);
@@ -3805,6 +3811,23 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t
*block, gfc_loopinfo *loop,
}
+void
+gfc_set_empty_descriptor (stmtblock_t *block, tree descr, int rank)
+{
+ for (int n = 0; n < rank; n++)
+ {
+ gfc_conv_descriptor_lbound_set (block, descr, gfc_rank_cst[n],
+ gfc_index_one_node);
+ gfc_conv_descriptor_ubound_set (block, descr, gfc_rank_cst[n],
+ gfc_index_zero_node);
+ gfc_conv_descriptor_spacing_set (block, descr, gfc_rank_cst[n],
+ gfc_index_zero_node);
+ }
+
+ gfc_conv_descriptor_offset_set (block, descr, gfc_index_zero_node);
+}
+
+
tree
gfc_set_pdt_array_descriptor (stmtblock_t *block, tree desc,
gfc_array_spec *as,
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 5556ed6ae12b..176fc1492daf 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -98,8 +98,8 @@ void gfc_set_descriptor (stmtblock_t *, tree, tree, gfc_expr
*, int, int,
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, bool,
- tree *);
+ gfc_expr *, tree, bool, gfc_expr *, tree,
+ gfc_typespec *, tree *);
void
gfc_copy_descriptor_info (stmtblock_t *, tree, tree, int, gfc_ss *);
void
@@ -115,6 +115,9 @@ void
gfc_set_descriptor_for_assign_realloc (stmtblock_t *, gfc_loopinfo *,
gfc_expr *, gfc_expr *, tree, tree,
tree, tree);
+
+void gfc_set_empty_descriptor (stmtblock_t *, tree, int);
+
tree
gfc_set_pdt_array_descriptor (stmtblock_t *, tree, gfc_array_spec *,
gfc_actual_arglist *);
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index a2dff516f6ff..f0617ae9aab1 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -7234,7 +7234,8 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
tmp, e3rhs ? e3rhs : code->expr3,
e3_is == E3_DESC ? expr3 : NULL_TREE,
e3_has_nodescriptor, omp_alloc_item,
- code->ext.alloc.ts.type != BT_UNKNOWN))
+ code->ext.alloc.ts.type != BT_UNKNOWN
+ ? &code->ext.alloc.ts : nullptr))
{
/* A scalar or derived type. First compute the size to
allocate.
