Hi all,
I nearly forgot to publish this patch:
When transfering data between two remote images, i.e. a third images asks image
one to read some data and then asks image two to put that data into its memory,
the size of the data to transfer between these two images was miscalculated. The
attached patch fixes this.
Regtested ok on x86_64-pc-linux-gnu / F41. Ok for mainline?
Btw, in theory this should be last patch for this PR.
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 14432031c7f247e2b4d7e76614553b5379d543b2 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Fri, 21 Feb 2025 14:06:28 +0100
Subject: [PATCH 2/2] 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.
---
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 e5648e0d027..f53de0b20e3 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 80e98dc3c20..c97829fd8a8 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);
--
2.48.1
