https://gcc.gnu.org/g:de9ad798184223252248eef64352f22cd4a0a4e4
commit de9ad798184223252248eef64352f22cd4a0a4e4
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Sat May 24 23:19:56 2025 +0200
Correction régression gomp/pr94672
Diff:
---
gcc/fortran/trans-array.cc | 16 ++++++----
gcc/fortran/trans-decl.cc | 48 +++++++++++++++++++++++++++---
gcc/fortran/trans-descriptor.cc | 3 +-
gcc/fortran/trans-expr.cc | 8 +++--
gcc/fortran/trans-intrinsic.cc | 3 +-
gcc/fortran/trans-stmt.cc | 3 +-
gcc/fortran/trans-types.cc | 65 +++++++++++++++++++++++++++++------------
gcc/fortran/trans-types.h | 4 +--
gcc/stor-layout.cc | 10 +++++--
9 files changed, 122 insertions(+), 38 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 43e5e1e756bc..264abd407b46 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1058,7 +1058,9 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
}
type =
gfc_get_array_type_bounds (eltype, total_dim, 0, from, to, 1,
- GFC_ARRAY_UNKNOWN, true);
+ GFC_ARRAY_UNKNOWN, true,
+ ss->info->expr ? ss->info->expr->ts.type
+ : BT_UNKNOWN);
/* Restore the upper bound, for the rest (not type-related) of the descriptor
initialization. */
if (to0)
@@ -2169,7 +2171,8 @@ gfc_build_constant_array_constructor (gfc_expr * expr,
tree type)
NULL, tmp - 1);
}
- tmptype = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC, true);
+ tmptype = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC, true,
+ expr->ts.type);
/* as is not needed anymore. */
for (i = 0; i < as.rank + as.corank; i++)
@@ -7782,7 +7785,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, codim,
loop.from, loop.to, 0,
- GFC_ARRAY_UNKNOWN, false);
+ GFC_ARRAY_UNKNOWN, false,
+ expr->ts.type);
parm = gfc_create_var (parmtype, "parm");
/* When expression is a class object, then add the class' handle to
@@ -9157,7 +9161,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
tree dest,
{
cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node,
&ubound, 1,
- GFC_ARRAY_ALLOCATABLE, false);
+ GFC_ARRAY_ALLOCATABLE, false,
+ c->ts.type);
cdesc = gfc_create_var (cdesc, "cdesc");
DECL_ARTIFICIAL (cdesc) = 1;
@@ -9310,7 +9315,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
tree dest,
cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node,
&ubound, 1,
- GFC_ARRAY_ALLOCATABLE, false);
+ GFC_ARRAY_ALLOCATABLE, false,
+ c->ts.type);
cdesc = gfc_create_var (cdesc, "cdesc");
DECL_ARTIFICIAL (cdesc) = 1;
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 7fcb50fcb685..aae0c26ab8fd 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1260,7 +1260,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
if (! COMPLETE_TYPE_P (type)
&& GFC_TYPE_ARRAY_SIZE (type)
- && GFC_TYPE_PACKED_ARRAY (type))
+ && GFC_TYPE_ARRAY_ELEM_LEN (type))
{
tree size, range;
@@ -1274,7 +1274,47 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
size, lower);
range = build_range_type (gfc_array_index_type, lower, size);
TYPE_DOMAIN (type) = range;
- layout_type (type);
+ if (GFC_TYPE_PACKED_ARRAY (type))
+ layout_type (type);
+ else
+ {
+ tree off = gfc_index_zero_node;
+ for (dim = 0; dim < GFC_TYPE_ARRAY_RANK (type); dim++)
+ {
+ tree lb = GFC_TYPE_ARRAY_LBOUND (type, dim);
+ tree ub = GFC_TYPE_ARRAY_UBOUND (type, dim);
+ tree extent = gfc_conv_array_extent_dim (lb, ub, nullptr);
+ tree extent_m1 = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, extent,
+ gfc_index_one_node);
+ tree spacing = GFC_TYPE_ARRAY_SPACING (type, dim);
+ tree tmp = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type,
+ extent_m1, spacing);
+ tmp = fold_build2_loc (input_location, MAX_EXPR,
+ gfc_array_index_type, tmp,
+ gfc_index_zero_node);
+ off = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, off, tmp);
+ }
+ tree elem_len = GFC_TYPE_ARRAY_ELEM_LEN (type);
+ elem_len = fold_convert_loc (input_location, gfc_array_index_type,
+ elem_len);
+ off = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, off, elem_len);
+ tree size_units = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type,
+ off, elem_len);
+ tree size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size_units,
+ build_int_cst (gfc_array_index_type,
+ BITS_PER_UNIT));
+ size_units = fold_convert_loc (input_location, sizetype, size_units);
+ TYPE_SIZE_UNIT (type) = size_units;
+ size = fold_convert_loc (input_location, sizetype, size);
+ TYPE_SIZE (type) = size;
+ layout_type (type);
+ }
}
}
@@ -1373,8 +1413,8 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
gfc_typenode_for_spec () returns the array descriptor. */
type = is_classarray ? gfc_get_element_type (type)
: gfc_typenode_for_spec (&sym->ts);
- type = gfc_get_nodesc_array_type (type, as, packed,
- !sym->attr.target);
+ type = gfc_get_nodesc_array_type (type, as, packed, !sym->attr.target,
+ sym->ts.type);
}
else
{
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 1bded77e00a9..e41809f0037a 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2590,7 +2590,8 @@ gfc_get_scalar_to_descriptor_type (tree scalar,
symbol_attribute attr)
if (POINTER_TYPE_P (TREE_TYPE (scalar)))
scalar = TREE_TYPE (scalar);
return gfc_get_array_type_bounds (TREE_TYPE (scalar), 0, 0, NULL, NULL, 1,
- akind, !(attr.pointer || attr.target));
+ akind, !(attr.pointer || attr.target),
+ BT_UNKNOWN);
}
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 93420e756361..9845f7fe71d6 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -132,7 +132,8 @@ gfc_conv_null_array_descriptor (gfc_se *se, gfc_symbol
*sym, gfc_expr *expr)
tree elt_type = gfc_typenode_for_spec (&sym->ts);
tree desc_type = gfc_get_array_type_bounds (elt_type, expr->rank, 0,
lower, upper, 0,
- GFC_ARRAY_UNKNOWN, false);
+ GFC_ARRAY_UNKNOWN, false,
+ expr->ts.type);
tree desc = gfc_create_var (desc_type, "desc");
DECL_ARTIFICIAL (desc) = 1;
@@ -4793,7 +4794,7 @@ gfc_get_interface_mapping_array (stmtblock_t * block,
gfc_symbol * sym,
type = gfc_typenode_for_spec (&sym->ts);
type = gfc_get_nodesc_array_type (type, sym->as, packed,
!sym->attr.target && !sym->attr.pointer
- && !sym->attr.proc_pointer);
+ && !sym->attr.proc_pointer, sym->ts.type);
var = gfc_create_var (type, "ifm");
gfc_add_modify (block, var, fold_convert (type, data));
@@ -10866,7 +10867,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1,
gfc_expr * expr2)
tmp = gfc_typenode_for_spec (&expr2->ts);
tmp = gfc_get_array_type_bounds (tmp, expr2->rank, 0,
bound, bound, 0,
- GFC_ARRAY_POINTER_CONT, false);
+ GFC_ARRAY_POINTER_CONT, false,
+ expr2->ts.type);
tmp = gfc_create_var (tmp, "ptrtemp");
rse.descriptor_only = 0;
rse.expr = tmp;
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 9d80ba2af179..e32c476884a9 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5019,7 +5019,8 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
&arrayexpr->where,
arrayexpr->rank - 1);
- tree array = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC, true);
+ tree array = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC, true,
+ BT_INTEGER);
result_var = gfc_create_var (array, "loc_result");
}
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 19272f50e45d..02d3e9e5a397 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -4958,7 +4958,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1,
gfc_expr * expr2,
parmtype = gfc_get_element_type (TREE_TYPE (desc));
parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, 0,
loop.from, loop.to, 1,
- GFC_ARRAY_UNKNOWN, true);
+ GFC_ARRAY_UNKNOWN, true,
+ expr2->ts.type);
/* Allocate temporary for nested forall construct. */
tmp1 = allocate_temp_for_forall_nest (nested_forall_info, parmtype,
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index c7433f11bed7..19e83a8c3b4b 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1586,7 +1586,7 @@ gfc_is_nodesc_array (gfc_symbol * sym)
static tree
gfc_build_array_type (tree type, gfc_array_spec * as,
enum gfc_array_kind akind, bool restricted,
- bool contiguous, int codim)
+ bool contiguous, int codim, bt type_type)
{
tree lbound[GFC_MAX_DIMENSIONS];
tree ubound[GFC_MAX_DIMENSIONS];
@@ -1644,7 +1644,7 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
return gfc_get_array_type_bounds (type, as->rank == -1
? GFC_MAX_DIMENSIONS : as->rank,
corank, lbound, ubound, 0, akind,
- restricted);
+ restricted, type_type);
}
/* Returns the struct descriptor_dimension type. */
@@ -1848,7 +1848,7 @@ gfc_get_dtype (tree type, int * rank)
tree
gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
- bool restricted)
+ bool restricted, bt type_type)
{
tree lbound[GFC_MAX_DIMENSIONS];
tree ubound[GFC_MAX_DIMENSIONS];
@@ -2031,7 +2031,11 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
layout_type (type);
- if (packed != PACKED_NO)
+ if (type_type != BT_UNKNOWN
+ && type_type != BT_CLASS
+ && (type_type != BT_CHARACTER
+ || (TREE_CODE (etype) == ARRAY_TYPE
+ && TYPE_SIZE_UNIT (etype))))
GFC_TYPE_ARRAY_ELEM_LEN (type) = TYPE_SIZE_UNIT (etype);
if (packed == PACKED_FULL || packed == PACKED_STATIC)
@@ -2165,7 +2169,8 @@ gfc_get_array_descriptor_base (int dimen, int codimen,
bool restricted)
tree
gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound,
tree * ubound, int packed,
- enum gfc_array_kind akind, bool restricted)
+ enum gfc_array_kind akind, bool restricted,
+ bt type_type)
{
char name[8 + 2*GFC_RANK_DIGITS + 1 + GFC_MAX_SYMBOL_LEN];
tree fat_type, base_type, arraytype, lower, upper, stride, tmp, rtype;
@@ -2216,21 +2221,29 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE;
GFC_TYPE_ARRAY_AKIND (fat_type) = akind;
+ if (type_type != BT_UNKNOWN
+ && type_type != BT_CLASS
+ && (type_type != BT_CHARACTER
+ || (TREE_CODE (etype) == ARRAY_TYPE
+ && TYPE_SIZE_UNIT (etype) != NULL_TREE)))
+ GFC_TYPE_ARRAY_ELEM_LEN (fat_type) = TYPE_SIZE_UNIT (etype);
+
/* Build an array descriptor record type. */
tree spacing;
- if (packed == 0)
- {
- stride = NULL_TREE;
- spacing = NULL_TREE;
- }
- else
+ if (packed != PACKED_NO
+ && GFC_TYPE_ARRAY_ELEM_LEN (fat_type))
{
stride = gfc_index_one_node;
if (dimen == 0)
spacing = NULL_TREE;
else
spacing = fold_convert_loc (input_location, gfc_array_index_type,
- TYPE_SIZE_UNIT (etype));
+ GFC_TYPE_ARRAY_ELEM_LEN (fat_type));
+ }
+ else
+ {
+ stride = NULL_TREE;
+ spacing = NULL_TREE;
}
for (n = 0; n < dimen + codimen; n++)
{
@@ -2301,10 +2314,21 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
return fat_type;
}
+ bool contiguous = packed == PACKED_FULL
+ || packed == PACKED_STATIC
+ || akind == GFC_ARRAY_ASSUMED_SHAPE_CONT
+ || akind == GFC_ARRAY_ASSUMED_RANK_CONT
+ || akind == GFC_ARRAY_ASSUMED_RANK_ALLOCATABLE
+ || akind == GFC_ARRAY_ASSUMED_RANK_POINTER_CONT
+ || akind == GFC_ARRAY_ALLOCATABLE
+ || akind == GFC_ARRAY_POINTER_CONT;
+ if (contiguous)
+ GFC_TYPE_PACKED_ARRAY (fat_type) = 1;
+
/* We define data as an array with the correct size if possible.
Much better than doing pointer arithmetic. */
bool known_zero_size = false;
- if (stride)
+ if (stride && contiguous)
{
tree range_bound = int_const_binop (MINUS_EXPR, stride,
build_int_cst (TREE_TYPE (stride),
@@ -2315,7 +2339,8 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
known_zero_size = true;
}
else
- rtype = gfc_array_range_type;
+ rtype = build_range_type (gfc_array_index_type, gfc_index_zero_node,
+ NULL_TREE);
if (known_zero_size
&& TREE_CODE (etype) == ARRAY_TYPE
&& TYPE_DOMAIN (etype)
@@ -2610,7 +2635,8 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
type = gfc_get_nodesc_array_type (type, sym->as,
byref ? PACKED_FULL
: PACKED_STATIC,
- restricted);
+ restricted,
+ sym->ts.type);
byref = 0;
}
}
@@ -2623,7 +2649,8 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
else if (sym->attr.allocatable)
akind = GFC_ARRAY_ALLOCATABLE;
type = gfc_build_array_type (type, sym->as, akind, restricted,
- sym->attr.contiguous, sym->as->corank);
+ sym->attr.contiguous, sym->as->corank,
+ sym->ts.type);
}
}
else
@@ -3261,13 +3288,15 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
(
field_type, c->as, akind, !c->attr.target && !c->attr.pointer,
c->attr.contiguous,
- c->attr.codimension || c->attr.pointer ? codimen : 0
+ c->attr.codimension || c->attr.pointer ? codimen : 0,
+ c->ts.type
);
}
else
field_type = gfc_get_nodesc_array_type (field_type, c->as,
PACKED_STATIC,
- !c->attr.target);
+ !c->attr.target,
+ c->ts.type);
}
else if ((c->attr.pointer || c->attr.allocatable || c->attr.pdt_string)
&& !c->attr.proc_pointer
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index 6c981ad2f3d7..5ead5f7aadb9 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -100,8 +100,8 @@ tree gfc_build_uint_type (int);
tree gfc_get_element_type (tree);
tree gfc_get_array_type_bounds (tree, int, int, tree *, tree *, int,
- enum gfc_array_kind, bool);
-tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, gfc_packed, bool);
+ enum gfc_array_kind, bool, bt);
+tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, gfc_packed, bool, bt);
/* Add a field of given name and type to a UNION_TYPE or RECORD_TYPE. */
tree gfc_add_field_to_struct (tree, tree, tree, tree **);
diff --git a/gcc/stor-layout.cc b/gcc/stor-layout.cc
index 18b5af56124d..a3292bbc4d25 100644
--- a/gcc/stor-layout.cc
+++ b/gcc/stor-layout.cc
@@ -2446,7 +2446,7 @@ layout_type (tree type)
type = TYPE_MAIN_VARIANT (type);
/* Do nothing if type has been laid out before. */
- if (TYPE_SIZE (type))
+ if (TYPE_SIZE (type) && TYPE_ALIGN (type))
return;
switch (TREE_CODE (type))
@@ -2660,8 +2660,12 @@ layout_type (tree type)
tree element = TREE_TYPE (type);
/* We need to know both bounds in order to compute the size. */
- if (index && TYPE_MAX_VALUE (index) && TYPE_MIN_VALUE (index)
- && TYPE_SIZE (element))
+ if (index
+ && TYPE_MAX_VALUE (index)
+ && TYPE_MIN_VALUE (index)
+ && TYPE_SIZE (element)
+ && !TYPE_SIZE (type)
+ && !TYPE_SIZE_UNIT (type))
{
tree ub = TYPE_MAX_VALUE (index);
tree lb = TYPE_MIN_VALUE (index);
