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 --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc
index e5648e0d02798a219b534f46c6ce95ab30eb84ac..f53de0b20e3252926d91326e14f76919e4745a06 100644 (file)
--- 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 80e98dc3c2026f9b9bdc744954a24910bd892f72..c97829fd8a82ef266c14dcf32af4fd3c9bd4b815 100644 (file)
--- 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);