From: Mikael Morin <[email protected]>
Fortran-tested on aarch64-unknown-linux-gnu. OK for mainline?
-- >8 --
In the next patch, a chunk of code using get_scalar_to_descriptor_type will
be moved to trans-descriptor.cc, requiring the function to be visible
outside of trans-expr.cc. Make it public now and move it to trans-types.cc.
PR fortran/122521
gcc/fortran/ChangeLog:
* trans-types.h (gfc_get_scalar_to_descriptor_type): New
declaration.
* trans-types.cc (gfc_get_scalar_to_descriptor_type): New
function, moved from ...
* trans-expr.cc (get_scalar_to_descriptor_type): ... here.
(gfc_conv_scalar_to_descriptor, gfc_conv_derived_to_class,
gfc_conv_class_to_class): Update function name in callers.
---
gcc/fortran/trans-expr.cc | 43 +++++++-------------------------------
gcc/fortran/trans-types.cc | 36 +++++++++++++++++++++++++++++++
gcc/fortran/trans-types.h | 1 +
3 files changed, 44 insertions(+), 36 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 2d1cac72d7e..b12500e48f4 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -84,42 +84,12 @@ gfc_get_character_len_in_bytes (tree type)
}
-/* Convert a scalar to an array descriptor. To be used for assumed-rank
- arrays. */
-
-static tree
-get_scalar_to_descriptor_type (tree scalar_type, symbol_attribute attr)
-{
- enum gfc_array_kind akind;
- tree *lbound = NULL, *ubound = NULL;
- int codim = 0;
-
- if (attr.pointer)
- akind = GFC_ARRAY_POINTER_CONT;
- else if (attr.allocatable)
- akind = GFC_ARRAY_ALLOCATABLE;
- else
- akind = GFC_ARRAY_ASSUMED_SHAPE_CONT;
-
- if (POINTER_TYPE_P (scalar_type))
- scalar_type = TREE_TYPE (scalar_type);
- if (TYPE_LANG_SPECIFIC (scalar_type))
- {
- struct lang_type *lang_specific = TYPE_LANG_SPECIFIC (scalar_type);
- codim = lang_specific->corank;
- lbound = lang_specific->lbound;
- ubound = lang_specific->ubound;
- }
- return gfc_get_array_type_bounds (scalar_type, 0, codim, lbound, ubound, 1,
- akind, !(attr.pointer || attr.target));
-}
-
tree
gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
{
tree desc, type, etype;
- type = get_scalar_to_descriptor_type (TREE_TYPE (scalar), attr);
+ type = gfc_get_scalar_to_descriptor_type (TREE_TYPE (scalar), attr);
etype = TREE_TYPE (scalar);
desc = gfc_create_var (type, "desc");
DECL_ARTIFICIAL (desc) = 1;
@@ -962,9 +932,9 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
/* Scalar to an assumed-rank array. */
if (fsym->ts.u.derived->components->as)
{
- tree type;
- type = get_scalar_to_descriptor_type (TREE_TYPE (parmse->expr),
- gfc_expr_attr (e));
+ tree expr_type = TREE_TYPE (parmse->expr);
+ tree type = gfc_get_scalar_to_descriptor_type (expr_type,
+ gfc_expr_attr (e));
gfc_conv_descriptor_dtype_set (&parmse->pre, ctree,
gfc_get_dtype (type));
copy_coarray_desc_part (&parmse->pre, ctree, parmse->expr);
@@ -1404,8 +1374,9 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e,
gfc_typespec class_ts,
{
if (e->rank == 0)
{
- tree type = get_scalar_to_descriptor_type (TREE_TYPE (parmse->expr),
- gfc_expr_attr (e));
+ tree type;
+ type = gfc_get_scalar_to_descriptor_type (TREE_TYPE (parmse->expr),
+ gfc_expr_attr (e));
gfc_conv_descriptor_dtype_set (&block, ctree,
gfc_get_dtype (type));
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index bb7c1406c5a..ef80cd8feab 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2258,6 +2258,42 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
return fat_type;
}
+
+/* Create and return a zero-rank array descriptor type suitable to hold a
scalar
+ value of type SCALAR_TYPE having attributes ATTR. An array descriptor of
the
+ returned type is to be used as implementation detail when a scalar actual
+ argument of type SCALAR_TYPE and having attributes ATTR is associated with
an
+ assumed-rank dummy. */
+
+tree
+gfc_get_scalar_to_descriptor_type (tree scalar_type, symbol_attribute attr)
+{
+ 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;
+
+ if (POINTER_TYPE_P (scalar_type))
+ scalar_type = TREE_TYPE (scalar_type);
+
+ tree *lbound = NULL, *ubound = NULL;
+ int codim = 0;
+ if (TYPE_LANG_SPECIFIC (scalar_type))
+ {
+ struct lang_type *lang_specific = TYPE_LANG_SPECIFIC (scalar_type);
+ codim = lang_specific->corank;
+ lbound = lang_specific->lbound;
+ ubound = lang_specific->ubound;
+ }
+ return gfc_get_array_type_bounds (scalar_type, 0, codim, lbound, ubound, 1,
+ akind, !(attr.pointer || attr.target));
+}
+
+
/* Build a pointer type. This function is called from gfc_sym_type(). */
static tree
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index a2169e436c8..0d75ecf7252 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -105,6 +105,7 @@ tree gfc_get_element_type (tree);
tree gfc_get_array_type_bounds (tree, int, int, tree *, tree *, int,
enum gfc_array_kind, bool);
tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, gfc_packed, bool);
+tree gfc_get_scalar_to_descriptor_type (tree, symbol_attribute);
/* Add a field of given name and type to a UNION_TYPE or RECORD_TYPE. */
tree gfc_add_field_to_struct (tree, tree, tree, tree **);
--
2.53.0
