https://gcc.gnu.org/g:af73228fdb2e61c6354f972987ba2a746c3519f7
commit r15-7694-gaf73228fdb2e61c6354f972987ba2a746c3519f7
Author: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Fri Feb 21 14:06:28 2025 +0100
Fortran: Fix detection of descriptor arrays in coarray [PR107635]
Look at the formal arguments generated type in the function declaration
to figure if an argument is a descriptor arrays. Fix handling of class
types while splitting coarray expressions.
PR fortran/107635
gcc/fortran/ChangeLog:
* coarray.cc (fixup_comp_refs): For class types set correct
component (class) type.
(split_expr_at_caf_ref): Provide location.
* trans-intrinsic.cc (conv_caf_send_to_remote): Look at
generated formal argument and not declared one to detect
descriptor arrays.
(conv_caf_sendget): Same.
Diff:
---
gcc/fortran/coarray.cc | 15 ++++++++++-----
gcc/fortran/trans-intrinsic.cc | 30 ++++++++++++++++++++++++------
2 files changed, 34 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc
index e5648e0d0279..f53de0b20e32 100644
--- a/gcc/fortran/coarray.cc
+++ b/gcc/fortran/coarray.cc
@@ -295,11 +295,12 @@ move_coarray_ref (gfc_ref **from, gfc_expr *expr)
static void
fixup_comp_refs (gfc_expr *expr)
{
- gfc_symbol *type = expr->symtree->n.sym->ts.type == BT_DERIVED
- ? expr->symtree->n.sym->ts.u.derived
- : (expr->symtree->n.sym->ts.type == BT_CLASS
- ? CLASS_DATA (expr->symtree->n.sym)->ts.u.derived
- : nullptr);
+ bool class_ref = expr->symtree->n.sym->ts.type == BT_CLASS;
+ gfc_symbol *type
+ = expr->symtree->n.sym->ts.type == BT_DERIVED
+ ? expr->symtree->n.sym->ts.u.derived
+ : (class_ref ? CLASS_DATA (expr->symtree->n.sym)->ts.u.derived
+ : nullptr);
if (!type)
return;
gfc_ref **pref = &(expr->ref);
@@ -317,6 +318,9 @@ fixup_comp_refs (gfc_expr *expr)
ref = nullptr;
break;
}
+ if (class_ref)
+ /* Link to the class type to allow for derived type resolution. */
+ (*pref)->u.c.sym = ref->u.c.sym;
(*pref)->next = ref->next;
ref->next = NULL;
gfc_free_ref_list (ref);
@@ -372,6 +376,7 @@ split_expr_at_caf_ref (gfc_expr *expr, gfc_namespace *ns,
st->n.sym->attr.dummy = 1;
st->n.sym->attr.intent = INTENT_IN;
st->n.sym->ts = *caf_ts;
+ st->n.sym->declared_at = expr->where;
*post_caf_ref_expr = gfc_get_variable_expr (st);
(*post_caf_ref_expr)->where = expr->where;
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 80e98dc3c202..c97829fd8a82 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1445,8 +1445,14 @@ conv_caf_send_to_remote (gfc_code *code)
NULL_TREE, gfc_trans_force_lval (&block, lhs_se.string_length));
else
opt_lhs_charlen = build_zero_cst (build_pointer_type (size_type_node));
- if (!TYPE_LANG_SPECIFIC (TREE_TYPE (caf_decl))->rank
- || GFC_ARRAY_TYPE_P (TREE_TYPE (caf_decl)))
+ /* Get the third formal argument of the receiver function. (This is the
+ location where to put the data on the remote image.) Need to look at
+ the argument in the function decl, because in the gfc_symbol's formal
+ argument an array may have no descriptor while in the generated
+ function decl it has. */
+ tmp = TREE_VALUE (TREE_CHAIN (TREE_CHAIN (TYPE_ARG_TYPES (
+ TREE_TYPE (receiver_fn_expr->symtree->n.sym->backend_decl)))));
+ if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
opt_lhs_desc = null_pointer_node;
else
opt_lhs_desc
@@ -1635,8 +1641,14 @@ conv_caf_sendget (gfc_code *code)
NULL_TREE, gfc_trans_force_lval (&block, lhs_se.string_length));
else
opt_lhs_charlen = build_zero_cst (build_pointer_type (size_type_node));
- if (!TYPE_LANG_SPECIFIC (TREE_TYPE (lhs_caf_decl))->rank
- || GFC_ARRAY_TYPE_P (TREE_TYPE (lhs_caf_decl)))
+ /* Get the third formal argument of the receiver function. (This is the
+ location where to put the data on the remote image.) Need to look at
+ the argument in the function decl, because in the gfc_symbol's formal
+ argument an array may have no descriptor while in the generated
+ function decl it has. */
+ tmp = TREE_VALUE (TREE_CHAIN (TREE_CHAIN (TYPE_ARG_TYPES (
+ TREE_TYPE (receiver_fn_expr->symtree->n.sym->backend_decl)))));
+ if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
opt_lhs_desc = null_pointer_node;
else
opt_lhs_desc
@@ -1677,8 +1689,14 @@ conv_caf_sendget (gfc_code *code)
rhs_size = gfc_typenode_for_spec (ts)->type_common.size_unit;
}
}
- else if (!TYPE_LANG_SPECIFIC (TREE_TYPE (rhs_caf_decl))->rank
- || GFC_ARRAY_TYPE_P (TREE_TYPE (rhs_caf_decl)))
+ /* Get the fifth formal argument of the getter function. This is the
argument
+ pointing to the data to get on the remote image. Need to look at the
+ argument in the function decl, because in the gfc_symbol's formal argument
+ an array may have no descriptor while in the generated function decl it
+ has. */
+ else if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_VALUE (
+ TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TYPE_ARG_TYPES (
+ TREE_TYPE (sender_fn_expr->symtree->n.sym->backend_decl))))))))))
{
rhs_se.data_not_needed = 1;
gfc_conv_expr_descriptor (&rhs_se, rhs_expr);
