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.

2 files changed, 34 insertions, 11 deletions

diff --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc
index e5648e0..f53de0b 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 80e98dc..c97829f 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);