https://gcc.gnu.org/g:bf227915607abbe3952859d9dabb885a389fcde0
commit bf227915607abbe3952859d9dabb885a389fcde0
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Sat Jul 19 13:55:28 2025 +0200
Creation gfc_conv_null_array_descriptor, gfc_conv_scalar_null_to_descriptor
Revert "Renommage gfc_clear_descriptor -> gfc_init_descriptor_variable"
This reverts commit 6a87820bffc834c09c5dcf8edb61f55cf6eec34c.
Revert "Correction compilation"
This reverts commit 5131afedc5568d33c68046a098a0143f9ae03eb9.
Revert partiel
Renseignement expression
Renommage
Correction régression null_actual_6
Diff:
---
gcc/fortran/trans-descriptor.cc | 47 +++++++++++++++++++--
gcc/fortran/trans-descriptor.h | 5 ++-
gcc/fortran/trans-expr.cc | 93 +++++++++++++++++++++++++++++++++--------
gcc/fortran/trans-types.cc | 9 +++-
gcc/fortran/trans-types.h | 1 +
gcc/fortran/trans.h | 1 +
6 files changed, 132 insertions(+), 24 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e3762d70bb36..2d48a1834ba1 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -671,7 +671,8 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type,
tree *data_off,
#undef UBOUND_SUBFIELD
void
-gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, gfc_expr
*expr, tree descr)
+gfc_nullify_descriptor (stmtblock_t *block, gfc_symbol *sym, gfc_expr *expr,
+ tree descr, tree string_length)
{
symbol_attribute attr = gfc_symbol_attr (sym);
@@ -705,8 +706,15 @@ gfc_init_descriptor_variable (stmtblock_t *block,
gfc_symbol *sym, gfc_expr *exp
rank = -1;
etype = gfc_get_element_type (TREE_TYPE (descr));
- gfc_conv_descriptor_dtype_set (block, descr,
- gfc_get_dtype_rank_type (rank, etype));
+ tree dtype = gfc_get_dtype_rank_type_slen (rank, etype, string_length);
+ gfc_conv_descriptor_dtype_set (block, descr, dtype);
+}
+
+void
+gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym,
+ gfc_expr *expr, tree descr)
+{
+ return gfc_nullify_descriptor (block, sym, expr, descr, NULL_TREE);
}
@@ -771,3 +779,36 @@ gfc_init_absent_descriptor (stmtblock_t *block, tree descr)
gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
}
+
+void
+gfc_set_scalar_descriptor (stmtblock_t *block, tree descr, tree value)
+{
+ tree etype = TREE_TYPE (value);
+
+ if (POINTER_TYPE_P (etype)
+ && TREE_TYPE (etype)
+ && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE)
+ etype = TREE_TYPE (etype);
+ gfc_conv_descriptor_dtype_set (block, descr,
+ gfc_get_dtype_rank_type (0, etype));
+ gfc_conv_descriptor_data_set (block, descr, value);
+ gfc_conv_descriptor_span_set (block, descr,
+ gfc_conv_descriptor_elem_len_get (descr));
+}
+
+
+void
+gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *expr, tree descr,
+ tree string_length)
+{
+ tree etype = gfc_get_element_type (TREE_TYPE (descr));
+ if (TREE_TYPE (etype) && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE)
+ etype = TREE_TYPE (etype);
+ gfc_conv_descriptor_dtype_set (block, descr,
+ gfc_get_dtype_rank_type_slen (expr->rank,
etype,
+ string_length));
+ gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
+ gfc_conv_descriptor_span_set (block, descr,
+ gfc_conv_descriptor_elem_len_get (descr));
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index de57a8e606e8..92603cde494a 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -19,9 +19,7 @@ along with GCC; see the file COPYING3. If not see
#ifndef GFC_TRANS_DESCRIPTOR_H
#define GFC_TRANS_DESCRIPTOR_H
-/* Build a null array descriptor constructor. */
tree gfc_build_default_class_descriptor (const gfc_typespec &, tree);
-void gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *, tree);
void gfc_set_scalar_null_descriptor (stmtblock_t *block, tree, gfc_symbol *,
gfc_expr *, tree);
void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
gfc_expr *, locus *);
@@ -95,7 +93,10 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type,
tree *data_off,
void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree
descr);
void gfc_init_descriptor_result (stmtblock_t *block, tree descr);
+void gfc_nullify_descriptor (stmtblock_t *block, gfc_symbol *, gfc_expr *,
tree, tree);
void gfc_init_static_descriptor (tree descr);
void gfc_init_absent_descriptor (stmtblock_t *block, tree descr);
+void gfc_set_scalar_descriptor (stmtblock_t *, tree, tree);
+void gfc_nullify_descriptor (stmtblock_t *, gfc_expr *, tree, tree);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 1e345c1ee9f6..a6cb3d7d6240 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -66,7 +66,7 @@ gfc_get_character_len (tree type)
/* Calculate the number of bytes in a string. */
tree
-gfc_get_character_len_in_bytes (tree type)
+gfc_get_character_len_in_bytes (tree type, tree slen)
{
tree tmp, len;
@@ -76,7 +76,7 @@ gfc_get_character_len_in_bytes (tree type)
tmp = TYPE_SIZE_UNIT (TREE_TYPE (type));
tmp = (tmp && !integer_zerop (tmp))
? (fold_convert (gfc_charlen_type_node, tmp)) : (NULL_TREE);
- len = gfc_get_character_len (type);
+ len = slen ? slen : gfc_get_character_len (type);
if (tmp && len && !integer_zerop (len))
len = fold_build2_loc (input_location, MULT_EXPR,
gfc_charlen_type_node, len, tmp);
@@ -84,6 +84,13 @@ gfc_get_character_len_in_bytes (tree type)
}
+tree
+gfc_get_character_len_in_bytes (tree type)
+{
+ return gfc_get_character_len_in_bytes (type, NULL_TREE);
+}
+
+
/* Convert a scalar to an array descriptor. To be used for assumed-rank
arrays. */
@@ -105,6 +112,56 @@ get_scalar_to_descriptor_type (tree scalar,
symbol_attribute attr)
akind, !(attr.pointer || attr.target));
}
+tree
+gfc_conv_scalar_null_to_descriptor (gfc_se *se, gfc_symbol *sym, tree scalar)
+{
+ symbol_attribute attr = sym->attr;
+
+ tree type = get_scalar_to_descriptor_type (scalar, attr);
+ tree desc = gfc_create_var (type, "desc");
+ DECL_ARTIFICIAL (desc) = 1;
+
+ if (CONSTANT_CLASS_P (scalar))
+ {
+ tree tmp;
+ tmp = gfc_create_var (TREE_TYPE (scalar), "scalar");
+ gfc_add_modify (&se->pre, tmp, scalar);
+ scalar = tmp;
+ }
+ if (!POINTER_TYPE_P (TREE_TYPE (scalar)))
+ scalar = gfc_build_addr_expr (NULL_TREE, scalar);
+
+ gfc_set_scalar_descriptor (&se->pre, desc, scalar);
+
+ return desc;
+}
+
+
+tree
+gfc_conv_null_array_descriptor (gfc_se *se, gfc_symbol *sym, gfc_expr *expr)
+{
+ tree lower[GFC_MAX_DIMENSIONS], upper[GFC_MAX_DIMENSIONS];
+
+ for (int i = 0; i < expr->rank; i++)
+ {
+ lower[i] = NULL_TREE;
+ upper[i] = NULL_TREE;
+ }
+
+ 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);
+
+ tree desc = gfc_create_var (desc_type, "desc");
+ DECL_ARTIFICIAL (desc) = 1;
+
+ gfc_nullify_descriptor (&se->pre, expr, desc, se->string_length);
+
+ return desc;
+}
+
+
tree
gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
{
@@ -6631,14 +6688,29 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e,
gfc_symbol * fsym)
if (e->ts.type == BT_CHARACTER
&& e->symtree->n.sym->ts.type == BT_CHARACTER)
{
+ /* Ensure that a usable length is available. */
+ if (parmse->string_length == NULL_TREE)
+ {
+ gfc_typespec *ts = &e->symtree->n.sym->ts;
+
+ if (ts->u.cl->length != NULL
+ && ts->u.cl->length->expr_type == EXPR_CONSTANT)
+ gfc_conv_const_charlen (ts->u.cl);
+
+ if (ts->u.cl->backend_decl)
+ parmse->string_length = ts->u.cl->backend_decl;
+ }
+
/* MOLD is present. Substitute a temporary character NULL pointer.
For an assumed-rank dummy we need a descriptor that passes the
correct rank. */
if (fsym->as && fsym->as->type == AS_ASSUMED_RANK)
{
tree tmp = parmse->expr;
- tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, fsym->attr);
- gfc_conv_descriptor_rank_set (&parmse->pre, tmp, e->rank);
+ if (e->rank == 0)
+ tmp = gfc_conv_scalar_null_to_descriptor (parmse, fsym, tmp);
+ else
+ tmp = gfc_conv_null_array_descriptor (parmse, fsym, e);
parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp);
}
else
@@ -6648,19 +6720,6 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e,
gfc_symbol * fsym)
build_zero_cst (TREE_TYPE (tmp)));
parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp);
}
-
- /* Ensure that a usable length is available. */
- if (parmse->string_length == NULL_TREE)
- {
- gfc_typespec *ts = &e->symtree->n.sym->ts;
-
- if (ts->u.cl->length != NULL
- && ts->u.cl->length->expr_type == EXPR_CONSTANT)
- gfc_conv_const_charlen (ts->u.cl);
-
- if (ts->u.cl->backend_decl)
- parmse->string_length = ts->u.cl->backend_decl;
- }
}
else if (e->ts.type == BT_UNKNOWN && parmse->string_length == NULL_TREE)
{
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 1754d9821532..e324fb9c41ea 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1695,7 +1695,7 @@ gfc_get_desc_dim_type (void)
unknown cases abort. */
tree
-gfc_get_dtype_rank_type (int rank, tree etype)
+gfc_get_dtype_rank_type_slen (int rank, tree etype, tree length)
{
tree ptype;
tree size;
@@ -1764,7 +1764,7 @@ gfc_get_dtype_rank_type (int rank, tree etype)
{
case BT_CHARACTER:
gcc_assert (TREE_CODE (ptype) == ARRAY_TYPE);
- size = gfc_get_character_len_in_bytes (ptype);
+ size = gfc_get_character_len_in_bytes (ptype, length);
break;
case BT_VOID:
gcc_assert (TREE_CODE (ptype) == POINTER_TYPE);
@@ -1805,6 +1805,11 @@ gfc_get_dtype_rank_type (int rank, tree etype)
return dtype;
}
+tree
+gfc_get_dtype_rank_type (int rank, tree etype)
+{
+ return gfc_get_dtype_rank_type_slen (rank, etype, NULL_TREE);
+}
tree
gfc_get_dtype (tree type, int * rank)
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index aba841da9cb5..dc75cd82a841 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -116,6 +116,7 @@ bool gfc_return_by_reference (gfc_symbol *);
bool gfc_is_nodesc_array (gfc_symbol *);
/* Return the DTYPE for an array. */
+tree gfc_get_dtype_rank_type_slen (int, tree, tree);
tree gfc_get_dtype_rank_type (int, tree);
tree gfc_get_dtype (tree, int *rank = NULL);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 798bf0e8a0dc..d6651b31a40f 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -523,6 +523,7 @@ void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree);
/* trans-expr.cc */
tree gfc_get_character_len_in_bytes (tree);
+tree gfc_get_character_len_in_bytes (tree, tree);
tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute);
tree gfc_get_ultimate_alloc_ptr_comps_caf_token (gfc_se *, gfc_expr *);
tree gfc_string_to_single_character (tree len, tree str, int kind);
