https://gcc.gnu.org/g:b202f6b85aa853835ebf67b02ccfb2aca73c2c85
commit b202f6b85aa853835ebf67b02ccfb2aca73c2c85
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Aug 6 22:08:03 2025 +0200
Extraction gfc_conv_null_array_to_descriptor
Correction ICE null_actual_7
Correction exécution null_actual_7
Diff:
---
gcc/fortran/trans-descriptor.cc | 57 +++++++++++++++++++++++++++++++++++++++--
gcc/fortran/trans-descriptor.h | 2 ++
gcc/fortran/trans-expr.cc | 12 ++++-----
gcc/fortran/trans-types.cc | 8 +++---
4 files changed, 67 insertions(+), 12 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 4f781f4976f7..06a65152d39d 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -858,6 +858,58 @@ gfc_nullify_descriptor (stmtblock_t *block, gfc_expr
*expr, tree descr,
}
+tree
+gfc_conv_null_array_to_descriptor (stmtblock_t *block, gfc_symbol *fsym)
+{
+ symbol_attribute attr = gfc_symbol_attr (fsym);
+
+ tree lbound[GFC_MAX_DIMENSIONS], ubound[GFC_MAX_DIMENSIONS];
+ memset (&lbound, 0, sizeof (lbound));
+ memset (&ubound, 0, sizeof (ubound));
+
+ enum gfc_array_kind akind;
+
+ if (attr.pointer)
+ akind = GFC_ARRAY_POINTER_CONT;
+ else if (attr.allocatable)
+ akind = GFC_ARRAY_ALLOCATABLE;
+ else
+ akind = GFC_ARRAY_ASSUMED_SHAPE_CONT;
+
+ tree etype = gfc_typenode_for_spec (&fsym->ts);
+ tree desc_type = gfc_get_array_type_bounds (etype, 1, 0, lbound, ubound, 1,
+ akind, !(attr.pointer || attr.target));
+
+ tree desc = gfc_create_var (desc_type, "desc");
+ DECL_ARTIFICIAL (desc) = 1;
+
+ int rank = fsym->as ? fsym->as->rank : 0;
+ gfc_conv_descriptor_dtype_set (block, desc,
+ gfc_get_dtype_rank_type (rank, etype));
+ gfc_conv_descriptor_data_set (block, desc, null_pointer_node);
+ gfc_conv_descriptor_span_set (block, desc,
+ gfc_conv_descriptor_elem_len_get (desc));
+
+ return desc;
+}
+
+tree
+gfc_conv_null_scalar_to_descriptor (stmtblock_t *block, gfc_symbol *fsym)
+{
+ tree etype = gfc_typenode_for_spec (&fsym->ts);
+ tree type = gfc_get_scalar_to_descriptor_type (etype, fsym->attr);
+ tree desc = gfc_create_var (type, "desc");
+ DECL_ARTIFICIAL (desc) = 1;
+
+ gfc_conv_descriptor_dtype_set (block, desc,
+ gfc_get_dtype_rank_type (0, etype));
+ gfc_conv_descriptor_data_set (block, desc, null_pointer_node);
+ gfc_conv_descriptor_span_set (block, desc,
+ gfc_conv_descriptor_elem_len_get (desc));
+ return desc;
+}
+
+
/* Modify a descriptor such that the lbound of a given dimension is the value
specified. This also updates ubound and offset accordingly. */
@@ -1905,7 +1957,7 @@ void
gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr,
tree scalar, gfc_expr *scalar_expr)
{
- tree type = gfc_get_scalar_to_descriptor_type (scalar,
+ tree type = gfc_get_scalar_to_descriptor_type (TREE_TYPE (scalar),
gfc_expr_attr (scalar_expr));
gfc_conv_descriptor_dtype_set (block, descr,
gfc_get_dtype (type));
@@ -1926,7 +1978,7 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
descr,
if (flag_coarray == GFC_FCOARRAY_LIB && caf_token)
gfc_conv_descriptor_token_set (block, descr, caf_token);
- tree type = gfc_get_scalar_to_descriptor_type (scalar,
+ tree type = gfc_get_scalar_to_descriptor_type (TREE_TYPE (scalar),
gfc_expr_attr (scalar_expr));
gfc_conv_descriptor_dtype_set (block, descr,
gfc_get_dtype (type));
@@ -2713,3 +2765,4 @@ gfc_set_empty_descriptor_bounds (stmtblock_t *block, tree
descr, int rank)
gfc_conv_descriptor_offset_set (block, descr, gfc_index_zero_node);
}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index e9724c052437..89831aec389b 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -96,6 +96,8 @@ void gfc_conv_shift_descriptor (stmtblock_t *, tree, int);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, const gfc_array_ref &);
/* Build a null array descriptor constructor. */
void gfc_nullify_descriptor (stmtblock_t *block, tree);
+tree gfc_conv_null_array_to_descriptor (stmtblock_t *, gfc_symbol *);
+tree gfc_conv_null_scalar_to_descriptor (stmtblock_t *, gfc_symbol *);
void gfc_copy_sequence_descriptor (stmtblock_t *, tree, tree, int);
void gfc_conv_remap_descriptor (stmtblock_t *, tree, int, tree, int,
gfc_array_ref *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 5cd936824452..d5f27021b2c1 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -96,7 +96,7 @@ gfc_conv_scalar_null_to_descriptor (gfc_se *se, gfc_symbol
*sym, tree scalar)
{
symbol_attribute attr = sym->attr;
- tree type = gfc_get_scalar_to_descriptor_type (scalar, attr);
+ tree type = gfc_get_scalar_to_descriptor_type (TREE_TYPE (scalar), attr);
tree desc = gfc_create_var (type, "desc");
DECL_ARTIFICIAL (desc) = 1;
@@ -146,7 +146,7 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar,
symbol_attribute attr)
{
tree desc, type;
- type = gfc_get_scalar_to_descriptor_type (scalar, attr);
+ type = gfc_get_scalar_to_descriptor_type (TREE_TYPE (scalar), attr);
desc = gfc_create_var (type, "desc");
DECL_ARTIFICIAL (desc) = 1;
@@ -6536,11 +6536,11 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e,
gfc_symbol * fsym)
if ((fsym->attr.allocatable || fsym->attr.pointer)
&& fsym->attr.intent == INTENT_UNKNOWN)
fsym->attr.intent = INTENT_IN;
- tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, fsym->attr);
dummy_rank = fsym->as ? fsym->as->rank : 0;
- if (dummy_rank > 0)
- gfc_conv_descriptor_rank_set (&parmse->pre, tmp, dummy_rank);
- gfc_conv_descriptor_data_set (&parmse->pre, tmp, null_pointer_node);
+ if (dummy_rank == 0)
+ tmp = gfc_conv_null_scalar_to_descriptor (&parmse->pre, fsym);
+ else
+ tmp = gfc_conv_null_array_to_descriptor (&parmse->pre, fsym);
parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp);
}
}
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 0c73e276482e..9d4329d97dec 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2289,7 +2289,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
arrays. */
tree
-gfc_get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
+gfc_get_scalar_to_descriptor_type (tree scalar_type, symbol_attribute attr)
{
enum gfc_array_kind akind;
@@ -2300,9 +2300,9 @@ gfc_get_scalar_to_descriptor_type (tree scalar,
symbol_attribute attr)
else
akind = GFC_ARRAY_ASSUMED_SHAPE_CONT;
- 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,
+ if (POINTER_TYPE_P (scalar_type))
+ scalar_type = TREE_TYPE (scalar_type);
+ return gfc_get_array_type_bounds (scalar_type, 0, 0, NULL, NULL, 1,
akind, !(attr.pointer || attr.target));
}
