https://gcc.gnu.org/g:2f1b1f398a45d72d35c2275cf94b656a8d761b7d
commit 2f1b1f398a45d72d35c2275cf94b656a8d761b7d
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Sun Aug 10 17:03:28 2025 +0200
Introduction enums pour les champs des structures
Correction régression
Diff:
---
gcc/fortran/trans-array.h | 5 +-
gcc/fortran/trans-descriptor.cc | 199 ++++++++++++++++++++++++++++++++--------
gcc/fortran/trans-types.cc | 141 +++-------------------------
gcc/fortran/trans.h | 6 --
4 files changed, 178 insertions(+), 173 deletions(-)
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 66e8ed332b03..c1886eb1faaf 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -169,8 +169,9 @@ tree gfc_trans_array_bounds (tree, gfc_symbol *, tree *,
stmtblock_t *);
void gfc_trans_array_cobounds (tree, stmtblock_t *, const gfc_symbol *);
/* Build expressions for accessing components of an array descriptor. */
-void gfc_get_descriptor_offsets_for_info (const_tree, tree *, tree *, tree *,
tree *,
- tree *, tree *, tree *, tree *);
+void gfc_get_descriptor_offsets_for_info (const_tree, tree *, tree *, tree *,
+ tree *, tree *, tree *, tree *,
+ tree *, tree *);
/* Shift lower bound of descriptor, updating ubound and offset. */
void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 422e8544397d..7030f0a8d6e9 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -162,16 +162,31 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
Don't forget to #undef these! */
-#define DATA_FIELD 0
-#define OFFSET_FIELD 1
-#define DTYPE_FIELD 2
-#define SPAN_FIELD 3
-#define DIMENSION_FIELD 4
-#define CAF_TOKEN_FIELD 5
+enum descriptor_field
+{
+ DATA_FIELD = 0,
+ OFFSET_FIELD,
+ DTYPE_FIELD,
+ SPAN_FIELD,
+ DIMENSION_FIELD,
+ CAF_TOKEN_FIELD,
+};
-#define STRIDE_SUBFIELD 0
-#define LBOUND_SUBFIELD 1
-#define UBOUND_SUBFIELD 2
+enum dim_subfield
+{
+ STRIDE_SUBFIELD = 0,
+ LBOUND_SUBFIELD,
+ UBOUND_SUBFIELD,
+};
+
+enum dtype_subfield
+{
+ GFC_DTYPE_ELEM_LEN = 0,
+ GFC_DTYPE_VERSION,
+ GFC_DTYPE_RANK,
+ GFC_DTYPE_TYPE,
+ GFC_DTYPE_ATTRIBUTE
+};
static tree
@@ -195,14 +210,15 @@ get_ref_comp (tree ref, unsigned field_idx, tree type =
NULL_TREE)
static tree
-get_descr_comp (tree desc, unsigned field_idx, tree type = NULL_TREE)
+get_descr_comp (tree desc, descriptor_field field, tree type = NULL_TREE)
{
gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)));
- return get_ref_comp (desc, field_idx, type);
+ return get_ref_comp (desc, field, type);
}
-void
+
+static void
set_value (stmtblock_t *block, tree ref, tree value)
{
location_t loc = input_location;
@@ -305,10 +321,10 @@ gfc_conv_descriptor_span_set (stmtblock_t *block, tree
desc, tree value)
static tree
-get_dtype_comp (tree desc, unsigned field_idx, tree type = NULL_TREE)
+get_dtype_comp (tree desc, dtype_subfield field, tree type = NULL_TREE)
{
tree dtype_ref = get_descriptor_dtype (desc);
- return get_ref_comp (dtype_ref, field_idx, type);
+ return get_ref_comp (dtype_ref, field, type);
}
@@ -495,11 +511,11 @@ gfc_conv_descriptor_token_set (stmtblock_t *block, tree
desc, tree value)
static tree
-get_descr_dim_comp (tree desc, tree dim, unsigned field_idx,
+get_descr_dim_comp (tree desc, tree dim, dim_subfield field,
tree type = NULL_TREE)
{
tree tmp = get_descriptor_dimension (desc, dim);
- return get_ref_comp (tmp, field_idx, type);
+ return get_ref_comp (tmp, field, type);
}
static tree
@@ -575,6 +591,124 @@ gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree
desc,
* Array descriptor higher level routines.
*
******************************************************************************/
+/* Return the DTYPE for an array. This describes the type and type parameters
+ of the array. */
+/* TODO: Only call this when the value is actually used, and make all the
+ unknown cases abort. */
+
+tree
+gfc_get_dtype_rank_type (int rank, tree etype)
+{
+ tree ptype;
+ tree size;
+ int n;
+ tree tmp;
+ tree dtype;
+ tree field;
+ vec<constructor_elt, va_gc> *v = NULL;
+
+ ptype = etype;
+ while (TREE_CODE (etype) == POINTER_TYPE
+ || TREE_CODE (etype) == ARRAY_TYPE)
+ {
+ ptype = etype;
+ etype = TREE_TYPE (etype);
+ }
+
+ gcc_assert (etype);
+
+ switch (TREE_CODE (etype))
+ {
+ case INTEGER_TYPE:
+ if (TREE_CODE (ptype) == ARRAY_TYPE
+ && TYPE_STRING_FLAG (ptype))
+ n = BT_CHARACTER;
+ else
+ {
+ if (TYPE_UNSIGNED (etype))
+ n = BT_UNSIGNED;
+ else
+ n = BT_INTEGER;
+ }
+ break;
+
+ case BOOLEAN_TYPE:
+ n = BT_LOGICAL;
+ break;
+
+ case REAL_TYPE:
+ n = BT_REAL;
+ break;
+
+ case COMPLEX_TYPE:
+ n = BT_COMPLEX;
+ break;
+
+ case RECORD_TYPE:
+ if (GFC_CLASS_TYPE_P (etype))
+ n = BT_CLASS;
+ else
+ n = BT_DERIVED;
+ break;
+
+ case FUNCTION_TYPE:
+ case VOID_TYPE:
+ n = BT_VOID;
+ break;
+
+ default:
+ /* TODO: Don't do dtype for temporary descriptorless arrays. */
+ /* We can encounter strange array types for temporary arrays. */
+ gcc_unreachable ();
+ }
+
+ switch (n)
+ {
+ case BT_CHARACTER:
+ gcc_assert (TREE_CODE (ptype) == ARRAY_TYPE);
+ size = gfc_get_character_len_in_bytes (ptype);
+ break;
+ case BT_VOID:
+ gcc_assert (TREE_CODE (ptype) == POINTER_TYPE);
+ size = size_in_bytes (ptype);
+ break;
+ default:
+ size = size_in_bytes (etype);
+ break;
+ }
+
+ tree dtype_type_node = get_dtype_type_node ();
+
+ gcc_assert (size);
+
+ STRIP_NOPS (size);
+ size = fold_convert (size_type_node, size);
+ tmp = get_dtype_type_node ();
+ field = gfc_advance_chain (TYPE_FIELDS (tmp),
+ GFC_DTYPE_ELEM_LEN);
+ CONSTRUCTOR_APPEND_ELT (v, field,
+ fold_convert (TREE_TYPE (field), size));
+ field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
+ GFC_DTYPE_VERSION);
+ CONSTRUCTOR_APPEND_ELT (v, field,
+ build_zero_cst (TREE_TYPE (field)));
+
+ field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
+ GFC_DTYPE_RANK);
+ if (rank >= 0)
+ CONSTRUCTOR_APPEND_ELT (v, field,
+ build_int_cst (TREE_TYPE (field), rank));
+
+ field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
+ GFC_DTYPE_TYPE);
+ CONSTRUCTOR_APPEND_ELT (v, field,
+ build_int_cst (TREE_TYPE (field), n));
+
+ dtype = build_constructor (tmp, v);
+
+ return dtype;
+}
+
/* Build a null array descriptor constructor. */
tree
@@ -600,22 +734,26 @@ gfc_build_null_descriptor (tree type)
void
gfc_get_descriptor_offsets_for_info (const_tree desc_type, tree *data_off,
- tree *dtype_off, tree *span_off,
- tree *dim_off, tree *dim_size,
- tree *stride_suboff, tree *lower_suboff,
- tree *upper_suboff)
+ tree *dtype_off, tree *rank_suboff,
+ tree *span_off, tree *dim_off,
+ tree *dim_size, tree *stride_suboff,
+ tree *lower_suboff, tree *upper_suboff)
{
tree field;
tree type;
type = TYPE_MAIN_VARIANT (desc_type);
- field = gfc_advance_chain (TYPE_FIELDS (type), DATA_FIELD);
+ tree fields = TYPE_FIELDS (type);
+ field = gfc_advance_chain (fields, DATA_FIELD);
*data_off = byte_position (field);
- field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD);
+ field = gfc_advance_chain (fields, DTYPE_FIELD);
*dtype_off = byte_position (field);
- field = gfc_advance_chain (TYPE_FIELDS (type), SPAN_FIELD);
+ type = TREE_TYPE (field);
+ field = gfc_advance_chain (TYPE_FIELDS (type), GFC_DTYPE_RANK);
+ *rank_suboff = byte_position (field);
+ field = gfc_advance_chain (fields, SPAN_FIELD);
*span_off = byte_position (field);
- field = gfc_advance_chain (TYPE_FIELDS (type), DIMENSION_FIELD);
+ field = gfc_advance_chain (fields, DIMENSION_FIELD);
*dim_off = byte_position (field);
type = TREE_TYPE (TREE_TYPE (field));
*dim_size = TYPE_SIZE_UNIT (type);
@@ -628,19 +766,6 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type,
tree *data_off,
}
-/* Cleanup those #defines. */
-
-#undef DATA_FIELD
-#undef OFFSET_FIELD
-#undef DTYPE_FIELD
-#undef SPAN_FIELD
-#undef DIMENSION_FIELD
-#undef CAF_TOKEN_FIELD
-#undef STRIDE_SUBFIELD
-#undef LBOUND_SUBFIELD
-#undef UBOUND_SUBFIELD
-
-
/* For an array descriptor, get the total number of elements. This is just
the product of the extents along from_dim to to_dim. */
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 1754d9821532..6b85fe3da67d 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1689,123 +1689,6 @@ gfc_get_desc_dim_type (void)
}
-/* Return the DTYPE for an array. This describes the type and type parameters
- of the array. */
-/* TODO: Only call this when the value is actually used, and make all the
- unknown cases abort. */
-
-tree
-gfc_get_dtype_rank_type (int rank, tree etype)
-{
- tree ptype;
- tree size;
- int n;
- tree tmp;
- tree dtype;
- tree field;
- vec<constructor_elt, va_gc> *v = NULL;
-
- ptype = etype;
- while (TREE_CODE (etype) == POINTER_TYPE
- || TREE_CODE (etype) == ARRAY_TYPE)
- {
- ptype = etype;
- etype = TREE_TYPE (etype);
- }
-
- gcc_assert (etype);
-
- switch (TREE_CODE (etype))
- {
- case INTEGER_TYPE:
- if (TREE_CODE (ptype) == ARRAY_TYPE
- && TYPE_STRING_FLAG (ptype))
- n = BT_CHARACTER;
- else
- {
- if (TYPE_UNSIGNED (etype))
- n = BT_UNSIGNED;
- else
- n = BT_INTEGER;
- }
- break;
-
- case BOOLEAN_TYPE:
- n = BT_LOGICAL;
- break;
-
- case REAL_TYPE:
- n = BT_REAL;
- break;
-
- case COMPLEX_TYPE:
- n = BT_COMPLEX;
- break;
-
- case RECORD_TYPE:
- if (GFC_CLASS_TYPE_P (etype))
- n = BT_CLASS;
- else
- n = BT_DERIVED;
- break;
-
- case FUNCTION_TYPE:
- case VOID_TYPE:
- n = BT_VOID;
- break;
-
- default:
- /* TODO: Don't do dtype for temporary descriptorless arrays. */
- /* We can encounter strange array types for temporary arrays. */
- gcc_unreachable ();
- }
-
- switch (n)
- {
- case BT_CHARACTER:
- gcc_assert (TREE_CODE (ptype) == ARRAY_TYPE);
- size = gfc_get_character_len_in_bytes (ptype);
- break;
- case BT_VOID:
- gcc_assert (TREE_CODE (ptype) == POINTER_TYPE);
- size = size_in_bytes (ptype);
- break;
- default:
- size = size_in_bytes (etype);
- break;
- }
-
- gcc_assert (size);
-
- STRIP_NOPS (size);
- size = fold_convert (size_type_node, size);
- tmp = get_dtype_type_node ();
- field = gfc_advance_chain (TYPE_FIELDS (tmp),
- GFC_DTYPE_ELEM_LEN);
- CONSTRUCTOR_APPEND_ELT (v, field,
- fold_convert (TREE_TYPE (field), size));
- field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
- GFC_DTYPE_VERSION);
- CONSTRUCTOR_APPEND_ELT (v, field,
- build_zero_cst (TREE_TYPE (field)));
-
- field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
- GFC_DTYPE_RANK);
- if (rank >= 0)
- CONSTRUCTOR_APPEND_ELT (v, field,
- build_int_cst (TREE_TYPE (field), rank));
-
- field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
- GFC_DTYPE_TYPE);
- CONSTRUCTOR_APPEND_ELT (v, field,
- build_int_cst (TREE_TYPE (field), n));
-
- dtype = build_constructor (tmp, v);
-
- return dtype;
-}
-
-
tree
gfc_get_dtype (tree type, int * rank)
{
@@ -3712,9 +3595,9 @@ gfc_get_array_descr_info (const_tree type, struct
array_descr_info *info)
int rank, dim;
bool indirect = false;
tree etype, ptype, t, base_decl;
- tree data_off, span_off, dim_off, dtype_off, dim_size, elem_size;
+ tree data_off, span_off, dim_off, dtype_off, rank_suboff, dim_size,
elem_size;
tree lower_suboff, upper_suboff, stride_suboff;
- tree dtype, field, rank_off;
+ tree dtype;
if (! GFC_DESCRIPTOR_TYPE_P (type))
{
@@ -3767,9 +3650,10 @@ gfc_get_array_descr_info (const_tree type, struct
array_descr_info *info)
if (indirect)
base_decl = build1 (INDIRECT_REF, ptype, base_decl);
- gfc_get_descriptor_offsets_for_info (type, &data_off, &dtype_off, &span_off,
- &dim_off, &dim_size, &stride_suboff,
- &lower_suboff, &upper_suboff);
+ gfc_get_descriptor_offsets_for_info (type, &data_off, &dtype_off,
+ &rank_suboff, &span_off, &dim_off,
+ &dim_size, &stride_suboff, &lower_suboff,
+ &upper_suboff);
t = fold_build_pointer_plus (base_decl, span_off);
elem_size = build1 (INDIRECT_REF, gfc_array_index_type, t);
@@ -3801,12 +3685,13 @@ gfc_get_array_descr_info (const_tree type, struct
array_descr_info *info)
info->ndimensions = 1;
t = fold_build_pointer_plus (base_decl, dtype_off);
dtype = TYPE_MAIN_VARIANT (get_dtype_type_node ());
- field = gfc_advance_chain (TYPE_FIELDS (dtype), GFC_DTYPE_RANK);
- rank_off = byte_position (field);
- t = fold_build_pointer_plus (t, rank_off);
-
- t = build1 (NOP_EXPR, build_pointer_type (TREE_TYPE (field)), t);
- t = build1 (INDIRECT_REF, TREE_TYPE (field), t);
+ t = fold_build_pointer_plus (t, rank_suboff);
+ tree field = TYPE_FIELDS (dtype);
+ while (field && byte_position (field) != rank_suboff)
+ field = DECL_CHAIN (field);
+ tree rank_type = TREE_TYPE (field);
+ t = build1 (NOP_EXPR, build_pointer_type (rank_type), t);
+ t = build1 (INDIRECT_REF, rank_type, t);
info->rank = t;
t = build0 (PLACEHOLDER_EXPR, TREE_TYPE (dim_off));
t = size_binop (MULT_EXPR, t, dim_size);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 55541845a6d6..740c05015d66 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -1004,12 +1004,6 @@ extern GTY(()) tree gfor_fndecl_caf_random_init;
/* gfortran-specific declaration information, the _CONT versions denote
arrays with CONTIGUOUS attribute. */
-#define GFC_DTYPE_ELEM_LEN 0
-#define GFC_DTYPE_VERSION 1
-#define GFC_DTYPE_RANK 2
-#define GFC_DTYPE_TYPE 3
-#define GFC_DTYPE_ATTRIBUTE 4
-
enum gfc_array_kind
{
GFC_ARRAY_UNKNOWN,
