https://gcc.gnu.org/g:06b745af5140b2db5feb5f4cffdca36dd4e95264
commit 06b745af5140b2db5feb5f4cffdca36dd4e95264
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Sun Jun 29 14:11:50 2025 +0200
Suppression gfc_conv_descriptor_type compil' OK
Correction régression PR97046
Suppression non_lvalue type_get
Ajout location set_type
Diff:
---
gcc/fortran/trans-decl.cc | 23 ++++---------
gcc/fortran/trans-descriptor.cc | 71 +++++++++++++++++++++++++++++++++++++++--
gcc/fortran/trans-descriptor.h | 5 ++-
gcc/fortran/trans-expr.cc | 2 +-
4 files changed, 80 insertions(+), 21 deletions(-)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index fda3f34682ec..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 (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 6b59699c652a..34a635cc90ca 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -172,13 +172,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),
@@ -381,6 +392,7 @@ gfc_conv_descriptor_elem_len_set (stmtblock_t *block, tree
desc, tree value)
fold_convert_loc (loc, TREE_TYPE (t), value));
}
+
tree
gfc_conv_descriptor_attribute (tree desc)
{
@@ -396,8 +408,9 @@ gfc_conv_descriptor_attribute (tree desc)
dtype, tmp, NULL_TREE);
}
-tree
-gfc_conv_descriptor_type (tree desc)
+
+static tree
+get_descriptor_type (tree desc)
{
tree tmp;
tree dtype;
@@ -410,6 +423,58 @@ gfc_conv_descriptor_type (tree desc)
dtype, tmp, NULL_TREE);
}
+tree
+gfc_conv_descriptor_type_get (tree desc)
+{
+ return get_descriptor_type (desc);
+}
+
+void
+gfc_conv_descriptor_type_set (stmtblock_t *block, tree desc, tree value)
+{
+ location_t loc = input_location;
+ tree t = get_descriptor_type (desc);
+ gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, 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 cee711398447..96f66b004ecb 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -49,7 +49,6 @@ tree gfc_get_cfi_dim_sm (tree desc, tree idx);
tree gfc_conv_descriptor_attribute (tree desc);
-tree gfc_conv_descriptor_type (tree desc);
tree gfc_get_descriptor_dimension (tree desc);
tree gfc_conv_descriptor_dimension (tree desc, tree dim);
tree gfc_conv_descriptor_token (tree desc);
@@ -60,6 +59,7 @@ tree gfc_conv_descriptor_dtype_get (tree desc);
tree gfc_conv_descriptor_elem_len_get (tree desc);
tree gfc_conv_descriptor_version_get (tree desc);
tree gfc_conv_descriptor_rank_get (tree desc);
+tree gfc_conv_descriptor_type_get (tree desc);
tree gfc_conv_descriptor_span_get (tree desc);
tree gfc_conv_descriptor_stride_get (tree desc, tree dim);
@@ -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_stride_set (stmtblock_t *block, tree desc, tree dim,
tree value);
void gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc, tree dim,
tree value);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 86372cf28f13..04770378c0fe 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6229,7 +6229,7 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr
*e, gfc_symbol *fsym)
tree cond;
tree ctype = gfc_get_cfi_desc_type (cfi);
tree type = fold_convert (TREE_TYPE (ctype),
- gfc_conv_descriptor_type (gfc));
+ gfc_conv_descriptor_type_get (gfc));
tree kind = fold_convert (TREE_TYPE (ctype),
gfc_conv_descriptor_elem_len_get (gfc));
kind = fold_build2_loc (input_location, LSHIFT_EXPR, TREE_TYPE (type),
