On 9/21/20 10:10 AM, Richard Biener wrote:
I see, so you would expect call to alsize to initialize things in
array15_unkonwn type? That would work too.
Yes, that's my expectation. But let's see what fortran folks say.
RFC patch attached; I think the following should work, but I am not
sure whether I missed something.
I wonder what to do about
'!GCC$ NO_ARG_CHECK :: x
but that seems to work fine (creates void* type) and as it only
permits assumed size or scalar variables, the descriptor issue
does not occur.
Thoughts?
Tobias
gcc/fortran/ChangeLog:
* trans-array.c (gfc_conv_expr_descriptor):
(gfc_conv_array_parameter):
* trans-array.h (gfc_conv_expr_descriptor):
gcc/fortran/trans-array.c | 15 +++++++++------
gcc/fortran/trans-array.h | 3 ++-
2 files changed, 11 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 6566c47d4ae..a5d1b477a0a 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7216,7 +7216,7 @@ walk_coarray (gfc_expr *e)
function call. */
void
-gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
+gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr, bool want_assumed_type)
{
gfc_ss *ss;
gfc_ss_type ss_type;
@@ -7611,7 +7611,9 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
else
{
/* Otherwise make a new one. */
- if (expr->ts.type == BT_CHARACTER && expr->ts.deferred)
+ if (want_assumed_type)
+ parmtype = ptr_type_node;
+ else if (expr->ts.type == BT_CHARACTER && expr->ts.deferred)
parmtype = gfc_typenode_for_spec (&expr->ts);
else
parmtype = gfc_get_element_type (TREE_TYPE (desc));
@@ -7950,7 +7952,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
{
if (sym->attr.dummy || sym->attr.result)
{
- gfc_conv_expr_descriptor (se, expr);
+ gfc_conv_expr_descriptor (se, expr,
+ fsym && fsym->ts.type == BT_ASSUMED);
tmp = se->expr;
}
if (size)
@@ -8014,7 +8017,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
if (no_pack || array_constructor || good_allocatable || ultimate_alloc_comp)
{
- gfc_conv_expr_descriptor (se, expr);
+ gfc_conv_expr_descriptor (se, expr, fsym && fsym->ts.type == BT_ASSUMED);
/* Deallocate the allocatable components of structures that are
not variable. */
if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
@@ -8037,7 +8040,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
if (this_array_result)
{
/* Result of the enclosing function. */
- gfc_conv_expr_descriptor (se, expr);
+ gfc_conv_expr_descriptor (se, expr, fsym && fsym->ts.type == BT_ASSUMED);
if (size)
array_parameter_size (se->expr, expr, size);
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
@@ -8053,7 +8056,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
{
/* Every other type of array. */
se->want_pointer = 1;
- gfc_conv_expr_descriptor (se, expr);
+ gfc_conv_expr_descriptor (se, expr, fsym && fsym->ts.type == BT_ASSUMED);
if (size)
array_parameter_size (build_fold_indirect_ref_loc (input_location,
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index e561605aaed..be3b1b79860 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -143,7 +143,8 @@ void gfc_get_dataptr_offset (stmtblock_t*, tree, tree, tree, bool, gfc_expr*);
/* Obtain the span of an array. */
tree gfc_get_array_span (tree, gfc_expr *);
/* Evaluate an array expression. */
-void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *);
+void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *,
+ bool want_assumed_type = false);
/* Convert an array for passing as an actual function parameter. */
void gfc_conv_array_parameter (gfc_se *, gfc_expr *, bool,
const gfc_symbol *, const char *, tree *);
