https://gcc.gnu.org/g:4070e0df492d280628ce585fefc7f2d86eef7ed0
commit 4070e0df492d280628ce585fefc7f2d86eef7ed0
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Mon Jun 30 21:41:49 2025 +0200
Correction régression PR97046
Diff:
---
gcc/fortran/trans-decl.cc | 23 ++++++-------------
gcc/fortran/trans-descriptor.cc | 50 ++++++++++++++++++++++++++++++++++++++++-
gcc/fortran/trans-descriptor.h | 3 +++
3 files changed, 59 insertions(+), 17 deletions(-)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index e3e41cc6c12d..69379147d57f 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7283,25 +7283,20 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t
*finally,
ctype = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (ctype),
ctype, build_int_cst (TREE_TYPE (ctype),
CFI_type_mask));
- tree type = gfc_conv_descriptor_type_get (gfc_desc);
/* if (CFI_type_cptr) BT_VOID else BT_UNKNOWN */
/* Note: BT_VOID is could also be CFI_type_funcptr, but assume c_ptr. */
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
build_int_cst (TREE_TYPE (ctype), CFI_type_cptr));
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
- build_int_cst (TREE_TYPE (type), BT_VOID));
- tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
- type,
- build_int_cst (TREE_TYPE (type), BT_UNKNOWN));
+ tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_VOID);
+ tmp2 = gfc_conv_descriptor_type_set (gfc_desc, BT_UNKNOWN);
tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
tmp, tmp2);
/* if (CFI_type_struct) BT_DERIVED else < tmp2 > */
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
build_int_cst (TREE_TYPE (ctype),
CFI_type_struct));
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
- build_int_cst (TREE_TYPE (type), BT_DERIVED));
+ tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_DERIVED);
tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
tmp, tmp2);
/* if (CFI_type_Character) BT_CHARACTER else < tmp2 > */
@@ -7310,8 +7305,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t
*finally,
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
build_int_cst (TREE_TYPE (ctype),
CFI_type_Character));
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
- build_int_cst (TREE_TYPE (type), BT_CHARACTER));
+ tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_CHARACTER);
tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
tmp, tmp2);
/* if (CFI_type_ucs4_char) BT_CHARACTER else < tmp2 > */
@@ -7323,16 +7317,14 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t
*finally,
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, tmp,
build_int_cst (TREE_TYPE (tmp),
CFI_type_ucs4_char));
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
- build_int_cst (TREE_TYPE (type), BT_CHARACTER));
+ tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_CHARACTER);
tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
tmp, tmp2);
/* if (CFI_type_Complex) BT_COMPLEX + cfi->elem_len/2 else < tmp2 > */
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
build_int_cst (TREE_TYPE (ctype),
CFI_type_Complex));
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
- build_int_cst (TREE_TYPE (type), BT_COMPLEX));
+ tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_COMPLEX);
tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
tmp, tmp2);
/* if (CFI_type_Integer || CFI_type_Logical || CFI_type_Real)
@@ -7350,8 +7342,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t
*finally,
CFI_type_Real));
cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node,
cond, tmp);
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
- type, fold_convert (TREE_TYPE (type), ctype));
+ tmp = gfc_conv_descriptor_type_set (gfc_desc, ctype);
tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
tmp, tmp2);
gfc_add_expr_to_block (&block, tmp2);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index a05fc1b4b573..2dc40fbdf3ee 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -163,13 +163,24 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
#define LBOUND_SUBFIELD 1
#define UBOUND_SUBFIELD 2
+
+static tree
+get_type_field (tree type, unsigned field_idx)
+{
+ tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
+ gcc_assert (field != NULL_TREE);
+
+ return field;
+}
+
+
static tree
gfc_get_descriptor_field (tree desc, unsigned field_idx)
{
tree type = TREE_TYPE (desc);
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
- tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
+ tree field = get_type_field (type, field_idx);
gcc_assert (field != NULL_TREE);
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
@@ -376,6 +387,7 @@ gfc_conv_descriptor_elem_len_set (stmtblock_t *block, tree
desc,
gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
}
+
static tree
get_descriptor_type (tree desc)
{
@@ -403,6 +415,42 @@ gfc_conv_descriptor_type_set (stmtblock_t *block, tree
desc, tree value)
gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
}
+void
+gfc_conv_descriptor_type_set (stmtblock_t *block, tree desc, int value)
+{
+ tree type = TREE_TYPE (desc);
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+
+ tree dtype = get_type_field (type, DTYPE_FIELD);
+ gcc_assert (dtype != NULL_TREE);
+
+ tree field = get_type_field (TREE_TYPE (dtype), GFC_DTYPE_TYPE);
+ gcc_assert (field != NULL_TREE);
+
+ tree type_value = build_int_cst (TREE_TYPE (field), value);
+ gfc_conv_descriptor_type_set (block, desc, type_value);
+}
+
+tree
+gfc_conv_descriptor_type_set (tree desc, tree value)
+{
+ stmtblock_t block;
+
+ gfc_init_block (&block);
+ gfc_conv_descriptor_type_set (&block, desc, value);
+ return gfc_finish_block (&block);
+}
+
+tree
+gfc_conv_descriptor_type_set (tree desc, int value)
+{
+ stmtblock_t block;
+
+ gfc_init_block (&block);
+ gfc_conv_descriptor_type_set (&block, desc, value);
+ return gfc_finish_block (&block);
+}
+
tree
gfc_get_descriptor_dimension (tree desc)
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 8e5b9583b9af..0547157bf2af 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -74,6 +74,9 @@ void gfc_conv_descriptor_elem_len_set (stmtblock_t *block,
tree desc, tree value
void gfc_conv_descriptor_version_set (stmtblock_t *block, tree desc, tree
value);
void gfc_conv_descriptor_rank_set (stmtblock_t *block, tree desc, tree value);
void gfc_conv_descriptor_rank_set (stmtblock_t *block, tree desc, int value);
+void gfc_conv_descriptor_type_set (stmtblock_t *block, tree desc, tree value);
+tree gfc_conv_descriptor_type_set (tree desc, tree value);
+tree gfc_conv_descriptor_type_set (tree desc, int value);
void gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value);
void gfc_conv_descriptor_dimension_set (stmtblock_t *block, tree desc, tree
dim, tree value);
void gfc_conv_descriptor_dimension_set (stmtblock_t *block, tree desc, int
dim, tree value);
